#lang racket (require racket/class "music-library.rkt" racket-sound "utils.rkt" racket-sprintf keystore/class ) (provide track% playlist% ) (define the-displayln displayln) (define list-for-each for-each) (define list-length length) (define next-track-id 0) (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 my-id (begin (set! next-track-id (+ next-track-id 1)) (when (> next-track-id 10000000) (set! next-track-id 1)) next-track-id)) (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) (define/public (get-id) my-id) (define (read-tags) (let* ((f (if (path? file) (path->string file) file)) (tags (id3-tags f)) (tmpfile #f)) (unless (tags-valid? tags) (let ((nfile (make-temporary-file "rktplayer-~a" #:copy-from f))) (set! tags (id3-tags nfile)) (set! tmpfile nfile) )) (unless (eq? tmpfile #f) (delete-file tmpfile)) tags ) ) (define/public (image->file* to-file) #f) (define/public (image->file to-file*) (let ((to-file (format "~a" to-file*)) (tags (read-tags))) (dbg-rktplayer "image->file ~a" to-file) (let ((image-from-tags (λ () (if (tags-valid? tags) (let ((ext (tags-picture->ext tags))) (if (eq? ext #f) #f (let ((path (string-append to-file "." (symbol->string ext)))) (if (tags-picture->file tags path) path #f) ) ) ) #f) ) ) ) (let ((path (image-from-tags))) (dbg-rktplayer "image-from-tags: ~a" path) (if (eq? path #f) (let* ((bd (basedir file)) (files (filter (λ (f) (let ((file (build-path bd f))) (file-exists? file))) (list "cover.jpg" "cover.png" "folder.jpg" "folder.png")))) (if (null? files) #f (let ((file (string-append to-file (bytes->string/utf-8 (path-get-extension (car files)))))) (copy-file (build-path bd (car files)) file #:exists-ok? #t) (dbg-rktplayer "image from basedir: ~a" file) (format "~a" file)) )) path)) ) ) ) (define/public (image->mimetype*) #f) (define/public (image->mimetype) (let ((tags (read-tags))) (if (tags-valid? tags) (tags-picture->mimetype tags) 'no-mimetype))) (super-new) (begin (let ((use-tags #t)) (if use-tags (unless (eq? file #f) (let ((tags (read-tags))) (if (tags-valid? tags) (begin (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)) ) (begin (set! title "invalid tags") (set! artist "invalid tags") (set! album "invalid tags") (set! number number) (set! length -1) ) ) ) ) (unless (eq? file #f) (set! title (format "~a" file)) (set! number 0)) ) ) ) ) ) (define list-len length) (define orig-for-each for-each) (define playlist% (class object% (init-field [start-map #f] [max-tracks 100] [name "Default"] [id #f] [settings #f] ) (define store (new keystore% [file 'rktplayer])) (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))) (orig-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)) ;(displayln (format "Adding ~a" p)) (add-track* p))))) content)) 'no-file-or-dir ) ) ) ) ;(define/public (set-name! n) ; (set! name n)) ;(define/public (set-id! id*) ; (set! id id*)) ;(define/public (get-id) ; id) ;(define/public (get-name) ; name) (define/public (tabs) (map (λ (k) (if (string? k) (string->symbol k) k)) (send store get 'tabs '(tabkey-default))) ) (define/public (tab-count) (list-length (tabs))) (define/public (make-tab-key) (string->symbol (format "tabkey-~a-~a" (current-milliseconds) (random 10000)))) (define/public (get-tab-name idx) (let* ((t (tabs)) (entry (list-ref t idx))) (let ((v (send store get entry (list (format "Playlist-~a" idx) '())))) (car v)))) (define/public (set-tab-name! idx name) (let* ((t (tabs)) (entry (list-ref t idx)) (v (send store get entry (list (format "Playlist-~a" idx) '()))) ) (send store set! entry (list name (cadr v))) ) ) (define/public (tab-id idx) (let ((t (tabs))) (list-ref t idx))) (define/public (tab-index id) (let ((t (tabs))) (letrec ((f (λ (t idx) (if (null? t) #f (if (eq? (car t) id) idx (f (cdr t) (+ idx 1))))))) (f t 0)))) (define/public (drop-tab! idx) (let* ((t (tabs)) (entry (list-ref t idx)) ) (send store set! 'tabs (list-drop! t idx)) (send store drop! entry) )) (define/public (add-tab!) (let* ((t (tabs)) (new-entry (send this make-tab-key))) (send store set! 'tabs (append t (list new-entry))) ) ) (define/public (save-tab!) (let* ((entry id) (idx (send this tab-index entry)) ) (dbg-rktplayer "entry id = ~a, ~a" entry idx) (if (eq? idx #f) (err-rktplayer "Cannot get tab for id ~a" entry) (let ((value (list (send this get-tab-name idx) (map (λ (track) (send track get-file)) tracks)))) (send store set! entry value) ) ) ) ) (define/public (load-tab idx) (let* ((t (tabs)) (entry (list-ref t idx)) ) (dbg-rktplayer "loading ~a" entry) (set! id entry) (set! tracks '()) (let ((value (send store get entry (list "Default" '())))) (set! name (car value)) (list-for-each (λ (file) (send this add-track file #f)) (cadr value)) ) ) #t ) (define/public (read-tracks) (set! tracks '()) (read-tracks-internal start-map) (send this save-tab!) ) (define/public (length) (list-len tracks)) (define/public (add-track file . args) (add-track* file) (when (null? args) (send this save-tab!)) ) (define/public (track i) (list-ref tracks i)) (define/public (display-tracks) (orig-for-each (λ (track) (send track displayln)) tracks)) (define/public (for-each f) (let ((idx 0)) (orig-for-each (λ (track) (f idx track) (set! idx (+ idx 1))) tracks) ) ) (define/public (track-id i) (string->symbol (format "track-~a" (+ i 1)))) (define/public (index id) (- (string->number (substring (symbol->string id) 6)) 1)) (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 (send this track-id i) i) (f (+ i 1) N)) '())))) (let ((rows (f 0 (send this length)))) (mktable rows 'tracks formatter)))) (super-new) (begin (if (eq? start-map #f) (send this load-tab 0) (set! id (send this tab-id id))) ) ) )