dlna

player.rkt

@@ -2,7 +2,9 @@
 
 (require racket/class
          racket-audio
+         racket-upnp
          "utils.rkt"
+         "dlna-player.rkt"
          lru-cache
          )
 
@@ -25,9 +27,11 @@
     (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)
@@ -56,6 +60,7 @@
       ;;  (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))
@@ -64,7 +69,9 @@
               (let ((track-nr (music-id->track-nr music-id)))
                 (if (eq? track-nr #f)
                     (warn-rktplayer "Unexpected: no track-nr for given music-id")
-                    (track-nr-updater track-nr))))
+                    (begin
+                      (set! current-track-nr track-nr)
+                      (track-nr-updater track-nr)))))
             )
           (state-updater st)
           (repeat-updater repeat)
@@ -78,16 +85,63 @@
 
     (define (on-eof-stream-cb handle)
       (when (and (eq? player handle) (not (eq? player #f)))
-        (let ((track-nr (music-id->track-nr music-id)))
-          (send this next))))
+        (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 (eq? player #f)
+      (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)
@@ -98,36 +152,72 @@
         (audio-buf-seconds! player buffer-min-seconds buffer-max-seconds)
         ))
 
-    (define/public (change-player kind #:host [host #f] #:basepaths [basepaths #f])
-      (let ((op player))
-        (unless (eq? player #f)
-          (set! player #f)
-          (audio-quit! op)
-          ;(displayln "Player quit")
-          )
-        ;(displayln "HE!")
-        (set! player-kind kind)
-        (set! player-host host)
-        (set! player-basepaths basepaths)
-        ;(displayln (format "kind: ~a, host: ~a, bp: ~a, player: ~a" player-kind player-host player-basepaths player))
-        ))
+    (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)
-      (audio-volume player))
+      (if (eq? player-kind 'dlna)
+          (send dlna-player volume)
+          (audio-volume player)))
 
     (define/public (set-volume! percentage)
       (check-player)
-      (audio-volume! player percentage))
+      (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 (eq? player #f)
-        (audio-stop! player))
+      (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!)
       )
@@ -141,83 +231,79 @@
       (check-player)
       (when (and (>= nr 0) (< nr (send playlist length)))
         (let ((track (send playlist track nr)))
-          (let ((id (audio-play! player (send track get-file))))
-            (register-music-id&track-nr id 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 (= music-id -1)
-          (warn-rktplayer "No music-id set (yet), so can't play anything next")
-          (let ((track-nr (music-id->track-nr music-id)))
-            (if (eq? track-nr #f)
-                (error "Unexpected: no track-nr for given music-id")
-                (begin
-                  (cond
-                    ((eq? repeat 'repeat-one) (play-track track-nr))
-                    ((eq? repeat 'repeat-all)
-                     (set! track-nr (+ track-nr 1))
-                     (when (>= track-nr (send playlist length))
-                       (set! track-nr 0))
-                     (play-track track-nr))
-                    (else
-                     (set! track-nr (+ track-nr 1))
-                     (if (>= track-nr (send playlist length))
-                         (stop)
-                         (play-track track-nr)))
-                    )
-                  )
-                )
-            )
-          )
-      )
+      (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 (= music-id -1)
-          (warn-rktplayer "No music-id set (yet), so can't play anything previous")
-          (let ((track-nr (music-id->track-nr music-id)))
-            (if (eq? track-nr #f)
-                (error "Unexpected: no track-nr for given music-id")
-                (begin
-                  (cond
-                    ((eq? repeat 'repeat-one) (play-track track-nr))
-                    ((eq? repeat 'repeat-all)
-                     (set! track-nr (- track-nr 1))
-                     (when (< track-nr 0)
-                       (set! track-nr (- (send playlist length) 1)))
-                     (play-track track-nr))
-                    (else
-                     (set! track-nr (- track-nr 1))
-                     (when (< track-nr 0) (set! track-nr 0))
-                     (play-track track-nr))
-                    )
-                  )
-                )
-            )
-          )
-      )
+      (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)
-      (audio-pause! player #t))
+      (if (eq? player-kind 'dlna)
+          (send dlna-player pause!)
+          (audio-pause! player #t)))
 
     (define/public (play!)
       (check-player)
-      (audio-pause! player #f))
+      (if (eq? player-kind 'dlna)
+          (send dlna-player play!)
+          (audio-pause! player #f)))
 
     (define/public (pause-unpause)
       (check-player)
-      (if (audio-paused? player)
-          (send this pause!)
-          (send this play!)))
+      (if (eq? state 'paused)
+          (send this play!)
+          (send this pause!)))
         
     (define/public (stop)
       (check-player)
-      (audio-stop! player))
+      (if (eq? player-kind 'dlna)
+          (send dlna-player stop!)
+          (audio-stop! player)))
 
     (define/public (seek percentage)
       (check-player)
-      (audio-seek! player percentage))
+      (if (eq? player-kind 'dlna)
+          (send dlna-player seek! percentage)
+          (audio-seek! player percentage)))
 
     (define/public (get-repeat)
       (check-player)
@@ -225,11 +311,14 @@
 
     (define/public (repeat! r)
       (check-player)
-      (set! repeat r))
+      (set! repeat r)
+      (repeat-updater repeat)
+      (when (and (eq? player-kind 'dlna)
+                 current-track-nr)
+        (update-dlna-next current-track-nr)))
     
     (define/public (quit)
-      (unless (eq? player #f)
-        (audio-quit! player)))
+      (stop-current-player))
     
     (super-new)