rktplayer/playlist.rkt

#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"))
      )
    )
  )