#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) (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) (let ((tags (read-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))) (define/public (image->mimetype) (let ((tags (read-tags))) (if (tags-valid? tags) (tags-picture->mimetype tags) 'no-mimetype))) (super-new) (begin (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) ) ) ) ) ) ) ) (define list-len length) (define orig-for-each for-each) (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))) (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 (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) (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 (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 (when (eq? start-map #f) (error "Initialize playlist% with a starting map")) ) ) )