148 lines
4.0 KiB
Racket
148 lines
4.0 KiB
Racket
#lang racket
|
|
|
|
(require racket/class
|
|
"music-library.rkt"
|
|
racket-sound
|
|
"utils.rkt"
|
|
racket-sprintf
|
|
)
|
|
|
|
(provide track%
|
|
playlist%
|
|
)
|
|
|
|
(define the-displayln displayln)
|
|
|
|
(define track%
|
|
(class object%
|
|
(init-field
|
|
[file #f]
|
|
[title ""]
|
|
[artist ""]
|
|
[album ""]
|
|
[length 0]
|
|
[number 0]
|
|
)
|
|
|
|
(define/public (displayln)
|
|
(the-displayln (format "~a - ~a - ~a - ~a"
|
|
number
|
|
title
|
|
album
|
|
length)))
|
|
|
|
(define/public (get-file) file)
|
|
(define/public (get-title) title)
|
|
(define/public (get-artist) artist)
|
|
(define/public (get-album) album)
|
|
(define/public (get-number) number)
|
|
(define/public (get-length) length)
|
|
|
|
(super-new)
|
|
(begin
|
|
(unless (eq? file #f)
|
|
(let ((tags (id3-tags (format "~a" file))))
|
|
(set! title (tags-title tags))
|
|
(set! artist (tags-artist tags))
|
|
(set! album (tags-album tags))
|
|
(set! number (tags-track tags))
|
|
(set! length (tags-length tags))
|
|
)
|
|
)
|
|
)
|
|
))
|
|
|
|
(define list-len length)
|
|
|
|
(define playlist%
|
|
(class object%
|
|
(init-field
|
|
[start-map #f]
|
|
[max-tracks 100]
|
|
)
|
|
|
|
(define tracks '())
|
|
|
|
(define (can-add? file)
|
|
(and (<= (list-len tracks) max-tracks)
|
|
(is-music-file? file)))
|
|
|
|
(define (add-track* file)
|
|
(let ((track (new track% [file file])))
|
|
(set! tracks (append tracks (list track)))))
|
|
|
|
(define (read-tracks-internal dir)
|
|
;(displayln (format "dir = ~a" dir))
|
|
(if (> (list-len tracks) max-tracks)
|
|
'done
|
|
(if (file-exists? dir)
|
|
(when (can-add? dir)
|
|
(add-track dir))
|
|
(if (directory-exists? dir)
|
|
(let ((content (directory-list dir)))
|
|
(for-each (λ (entry)
|
|
(let ((p (build-path dir entry)))
|
|
(if (directory-exists? p)
|
|
(read-tracks-internal p)
|
|
(when (and (file-exists? p) (can-add? p))
|
|
(add-track* p)))))
|
|
content))
|
|
'no-file-or-dir
|
|
)
|
|
)
|
|
)
|
|
)
|
|
|
|
(define/public (read-tracks)
|
|
(set! tracks '())
|
|
(read-tracks-internal start-map)
|
|
)
|
|
|
|
(define/public (length)
|
|
(list-len tracks))
|
|
|
|
(define/public (add-track file)
|
|
(add-track* file))
|
|
|
|
(define/public (track i)
|
|
(list-ref tracks i))
|
|
|
|
(define/public (display-tracks)
|
|
(for-each (λ (track)
|
|
(send track displayln))
|
|
tracks))
|
|
|
|
(define/public (to-html)
|
|
(define (formatter row)
|
|
(let* ((track-idx (car row))
|
|
(track (track track-idx)))
|
|
(list
|
|
(list 'td (list (list 'class "number"))
|
|
(format "~a." (send track get-number)))
|
|
(list 'td (list (list 'class "title"))
|
|
(send track get-title))
|
|
(list 'td (list (list 'class "album"))
|
|
(send track get-album))
|
|
(list 'td (list (list 'class "length"))
|
|
(let* ((length-s (send track get-length))
|
|
(hour (quotient length-s 3600))
|
|
(min (quotient (remainder length-s 3600) 60))
|
|
(sec (remainder (remainder length-s 3600) 60)))
|
|
(sprintf "%02d:%02d:%02d" hour min sec)))
|
|
)))
|
|
|
|
(letrec ((f (λ (i N)
|
|
(if (< i N)
|
|
(cons (list (format "track-~a" (+ i 1)) i) (f (+ i 1) N))
|
|
'()))))
|
|
(let ((rows (f 0 (send this length))))
|
|
(mktable rows 'tracks formatter))))
|
|
|
|
(super-new)
|
|
(begin
|
|
(when (eq? start-map #f)
|
|
(error "Initialize playlist% with a starting map"))
|
|
)
|
|
)
|
|
)
|
|
|