67 lines
1.6 KiB
Racket
67 lines
1.6 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
"mc-filesystem.rkt"
|
|
"library-factory.rkt"
|
|
"base/media-library.rkt"
|
|
"track-filesystem.rkt"
|
|
"../misc/utils.rkt")
|
|
|
|
(provide library-filesystem%
|
|
register-library-filesystem!)
|
|
|
|
(define library-filesystem-kind
|
|
'filesystem)
|
|
|
|
(define library-filesystem-version
|
|
1)
|
|
|
|
(define (register-library-filesystem! factory)
|
|
(check/c register-library-filesystem!
|
|
factory
|
|
(is-a?/c library-factory%))
|
|
|
|
(send factory
|
|
register-library-maker!
|
|
library-filesystem-kind
|
|
library-filesystem-version
|
|
(lambda (cfg)
|
|
(new library-filesystem%
|
|
[cfg cfg]))))
|
|
|
|
(define library-filesystem%
|
|
(class media-library%
|
|
(init
|
|
cfg)
|
|
|
|
(define/override (make-root-container)
|
|
(new mc-filesystem%
|
|
[library this]
|
|
[relative-path '()]))
|
|
|
|
(define/public (make-container relative-path)
|
|
(new mc-filesystem%
|
|
[library this]
|
|
[relative-path relative-path]))
|
|
|
|
(define/public (make-track relative-path)
|
|
(new track-filesystem%
|
|
[library this]
|
|
[relative-path relative-path]))
|
|
|
|
(define/public (resolve-path relative-path)
|
|
(check/c library-filesystem% resolve-path
|
|
relative-path
|
|
list?)
|
|
|
|
(let ((root
|
|
(normal-case-path
|
|
(send (send this get-cfg)
|
|
get-root))))
|
|
(if (null? relative-path)
|
|
root
|
|
(apply build-path root relative-path))))
|
|
|
|
(super-new
|
|
[cfg cfg])))
|