83 lines
2.4 KiB
Racket
83 lines
2.4 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/class
|
|
racket-audio
|
|
racket/list
|
|
racket/path
|
|
racket/string
|
|
"base/media-container.rkt"
|
|
"../misc/utils.rkt")
|
|
|
|
(provide mc-filesystem%)
|
|
|
|
(define mc-filesystem%
|
|
(class media-container%
|
|
(init-field
|
|
library
|
|
[relative-path '()])
|
|
|
|
(check/c mc-filesystem% relative-path list?)
|
|
|
|
(define/private (full-path)
|
|
(send library resolve-path relative-path))
|
|
|
|
(define/private (music-file-name? path)
|
|
(let ((file-name
|
|
(string-downcase (path->string path))))
|
|
(for/or ((extension
|
|
(in-list (audio-known-exts?))))
|
|
(string-suffix?
|
|
file-name
|
|
(string-append "." extension)))))
|
|
|
|
(define/private (item-kind path)
|
|
(cond
|
|
((directory-exists? path)
|
|
(let ((name
|
|
(path->string
|
|
(file-name-from-path path))))
|
|
(and (not (string-prefix? name "."))
|
|
'container)))
|
|
((music-file-name? path) 'track)
|
|
(else #f)))
|
|
|
|
(define/override (get-title)
|
|
(if (null? relative-path)
|
|
(send (send library get-cfg) get-name)
|
|
(path->string (last relative-path))))
|
|
|
|
(define/override (get-items)
|
|
(let ((path (full-path)))
|
|
(if (directory-exists? path)
|
|
(for*/list ((entry (in-list
|
|
(sort (directory-list path)
|
|
path<?)))
|
|
(entry-path
|
|
(in-value (build-path path entry)))
|
|
(kind
|
|
(in-value (item-kind entry-path)))
|
|
#:when kind)
|
|
(let ((entry-relative-path
|
|
(append relative-path (list entry))))
|
|
(if (eq? kind 'container)
|
|
(send library
|
|
make-container
|
|
entry-relative-path)
|
|
(send library
|
|
make-track
|
|
entry-relative-path))))
|
|
'())))
|
|
|
|
(define/override (get-track-reliver)
|
|
(lambda (track-factory-id track-relive-info)
|
|
(case track-factory-id
|
|
((file)
|
|
(send library
|
|
make-track
|
|
track-relive-info))
|
|
(else #f))))
|
|
|
|
(super-new
|
|
[id (cons (send (send library get-cfg) get-id)
|
|
relative-path)])))
|