rktplayer/player.rkt

#lang racket

(require racket/class
         racket-audio
         racket-upnp
         "utils.rkt"
         "dlna-player.rkt"
         lru-cache
         )

(provide player%)

(define player%
  (class object%
    (init-field [settings #f]
                [time-updater (λ (time-s length-s) #t)]
                [track-nr-updater (λ (nr) #t)]
                [state-updater (λ (state) #t)]
                [repeat-updater (λ (state) #t)]
                [audio-info-cb (λ (current-sample rate channels bits kind) #t)]
                [buffer-max-seconds 10]
                [buffer-min-seconds 4]
                )

    (define player-kind  'local)
    (define player-host  #f)
    (define player-basepaths #f)
    
    (define player       #f)
    (define dlna-player  #f)
    (define playlist     #f)
    (define state        'stopped)
    (define repeat       'no-repeat)
    (define current-track-nr #f)

    (define full-state   (make-hash))
    (define music-id     -1)
    (define track-cache (make-lru 10
                                   #:cmp (λ (a b) (= (car a) (car b)))))


    (define (music-id->track-nr id)
      (let ((item (lru-use track-cache (list music-id) #f)))
        (if (eq? item #f)
            #f
            (cadr item))))

    (define (register-music-id&track-nr id track-nr)
      (lru-add! track-cache (list id track-nr)))

    (define (clear-music-ids!)
      (lru-clear track-cache))


    ;;(define x 0)
    (define (audio-state-cb handle player-state st*)
      (set! full-state st*)
      ;;(when (< x 5)
      ;;  (displayln st*)
      ;;  (set! x (+ x 1)))
      (unless (or (not (eq? player handle)) (eq? player #f))
        (let ((st (audio-state player)))
          (set! state st)
          (when (or (eq? st 'paused) (eq? st 'playing))
            (time-updater (audio-at-second player)
                          (audio-duration player))
            (when (not (= music-id (audio-music-id player)))
              (set! music-id (audio-music-id player))
              (let ((track-nr (music-id->track-nr music-id)))
                (if (eq? track-nr #f)
                    (warn-rktplayer "Unexpected: no track-nr for given music-id")
                    (begin
                      (set! current-track-nr track-nr)
                      (track-nr-updater track-nr)))))
            )
          (state-updater st)
          (repeat-updater repeat)
          (if (or (eq? player-state 'quit) (eq? player-state 'stopped))
              (audio-info-cb 0 0 0 'none)
              (audio-info-cb (audio-rate player) (audio-channels player)
                             (audio-bits player) (audio-decoder player)))
          )
        )
      )

    (define (on-eof-stream-cb handle)
      (when (and (eq? player handle) (not (eq? player #f)))
        (send this next)))

    (define (next-track-nr nr)
      (cond
        ((eq? repeat 'repeat-one) nr)
        ((< (+ nr 1) (send playlist length)) (+ nr 1))
        ((eq? repeat 'repeat-all) 0)
        (else #f)))

    (define (update-dlna-next nr)
      (set! current-track-nr nr)
      (let ((next-nr (next-track-nr nr)))
        (when (send dlna-player next-uri-supported?)
          (if next-nr
              (let ((track (send playlist track next-nr)))
                (send dlna-player
                      set-next-file!
                      (send track get-file)
                      next-nr))
              (send dlna-player clear-next!)))))

    (define (dlna-track-changed nr)
      (update-dlna-next nr))

    (define (make-dlna-player renderer port)
      (new dlna-player%
           [renderer renderer]
           [port port]
           [time-updater time-updater]
           [track-nr-updater
            (lambda (nr)
              (set! current-track-nr nr)
              (track-nr-updater nr))]
           [state-updater
            (lambda (new-state)
              (set! state new-state)
              (state-updater new-state))]
           [track-ended (lambda () (send this next))]
           [track-changed dlna-track-changed]))

    (define (stop-current-player)
      (unless (eq? player #f)
        (let ((old-player player))
          (set! player #f)
          (audio-quit! old-player)))
      (unless (eq? dlna-player #f)
        (let ((old-player dlna-player))
          (send old-player quit)
          (set! dlna-player #f))))

    ;(define ap (make-audio-player audio-player-state audio-player-eof
    ;  #:remote-host "hans@mahler.thuis.local"
    ;  #:replace-base-paths '(("\\\\panderleou\\music" . "/muziek"))))
    (define (check-player)
      ;(displayln "check-player called")
      (when (and (not (eq? player-kind 'dlna))
                 (eq? player #f))
        (set! player
              (if (eq? player-kind 'local)
                  (make-audio-player audio-state-cb on-eof-stream-cb)
                  (make-audio-player audio-state-cb on-eof-stream-cb
                                     #:remote-host player-host
                                     #:replace-base-paths player-basepaths)))
        (audio-ao-buf-ms! player 500)
        (audio-buf-seconds! player buffer-min-seconds buffer-max-seconds)
        ))

    (define/public (change-player kind
                                  #:host [host #f]
                                  #:basepaths [basepaths #f]
                                  #:renderer [renderer #f]
                                  #:port [port 8080])
      (unless (member kind '(local remote dlna))
        (raise-argument-error
         'change-player
         "(or/c 'local 'remote 'dlna)"
         kind))
      (when (and (eq? kind 'dlna) (not renderer))
        (raise-arguments-error
         'change-player
         "a media renderer is required for DLNA playback"))
      (stop-current-player)
      (set! player-kind kind)
      (set! player-host host)
      (set! player-basepaths basepaths)
      (set! current-track-nr #f)
      (set! state 'stopped)
      (state-updater state)
      (if (eq? player-kind 'dlna)
          (with-handlers
            ((exn:fail?
              (lambda (exception)
                (set! player-kind 'local)
                (when dlna-player
                  (send dlna-player quit))
                (set! dlna-player #f)
                (raise exception))))
            (set! dlna-player (make-dlna-player renderer port))
            (audio-info-cb 0 0 0 'dlna))
          (audio-info-cb 0 0 0 'none)))

    (define/public (kind)
      player-kind)

    (define/public (query-dlna-renderers)
      (query-media-renderers))

    (define/public (dlna-renderer-name renderer)
      (media-renderer-name renderer))

    (define/public (get-volume)
      (check-player)
      (if (eq? player-kind 'dlna)
          (send dlna-player volume)
          (audio-volume player)))

    (define/public (set-volume! percentage)
      (check-player)
      (if (eq? player-kind 'dlna)
          (send dlna-player set-volume! percentage)
          (audio-volume! player percentage)))

    (define/public (set-list! playlist*)
      ;; if the player exists and is playing, stop it.
      (unless (and (eq? player #f) (eq? dlna-player #f))
        (if (eq? player-kind 'dlna)
            (send dlna-player stop!)
            (audio-stop! player)))
      ;; Set the playlist to the new one. 
      (set! playlist playlist*)
      ;; reset music-id to -1, because the playlist has been reset.
      (set! music-id -1)
      (set! current-track-nr #f)
      ;; clear lru cache, because the playlist has been reset.
      (clear-music-ids!)
      )

    (define/public (play playlist*)
      (check-player)
      (set-list! playlist*)
      (send this play-track 0))

    (define/public (play-track nr)
      (check-player)
      (when (and (>= nr 0) (< nr (send playlist length)))
        (let ((track (send playlist track nr)))
          (set! current-track-nr nr)
          (if (eq? player-kind 'dlna)
              (let ((next-nr (next-track-nr nr)))
                (if (and next-nr
                         (send dlna-player next-uri-supported?))
                    (let ((next-track (send playlist track next-nr)))
                      (send dlna-player
                            play-file!
                            (send track get-file)
                            nr
                            #:next-file (send next-track get-file)
                            #:next-track-nr next-nr))
                    (send dlna-player
                          play-file!
                          (send track get-file)
                          nr)))
              (let ((id (audio-play! player (send track get-file))))
                (register-music-id&track-nr id nr))))))

    (define/public (next)
      (check-player)
      (if current-track-nr
          (let ((nr (next-track-nr current-track-nr)))
            (if nr
                (play-track nr)
                (stop)))
          (warn-rktplayer
           "No current track set, so can't play anything next")))

    (define/public (previous)
      (check-player)
      (if current-track-nr
          (let ((nr (if (eq? repeat 'repeat-one)
                        current-track-nr
                        (- current-track-nr 1))))
            (when (< nr 0)
              (set! nr
                    (if (eq? repeat 'repeat-all)
                        (- (send playlist length) 1)
                        0)))
            (play-track nr))
          (warn-rktplayer
           "No current track set, so can't play anything previous")))

    (define/public (pause!)
      (check-player)
      (if (eq? player-kind 'dlna)
          (send dlna-player pause!)
          (audio-pause! player #t)))

    (define/public (play!)
      (check-player)
      (if (eq? player-kind 'dlna)
          (send dlna-player play!)
          (audio-pause! player #f)))

    (define/public (pause-unpause)
      (check-player)
      (if (eq? state 'paused)
          (send this play!)
          (send this pause!)))
        
    (define/public (stop)
      (check-player)
      (if (eq? player-kind 'dlna)
          (send dlna-player stop!)
          (audio-stop! player)))

    (define/public (seek percentage)
      (check-player)
      (if (eq? player-kind 'dlna)
          (send dlna-player seek! percentage)
          (audio-seek! player percentage)))

    (define/public (get-repeat)
      (check-player)
      repeat)

    (define/public (repeat! r)
      (check-player)
      (set! repeat r)
      (repeat-updater repeat)
      (when (and (eq? player-kind 'dlna)
                 current-track-nr)
        (update-dlna-next current-track-nr)))
    
    (define/public (quit)
      (stop-current-player))
    
    (super-new)

    (begin
      (dbg-rktplayer "player% initialized")
      )
    )
  )