playlists and DLNA playback
This commit is contained in:
+258
-371
@@ -10,7 +10,10 @@
|
||||
racket-sonos
|
||||
racket-upnp
|
||||
simple-log
|
||||
"library.rkt")
|
||||
uuid/random
|
||||
"dlna-playback.rkt"
|
||||
"library.rkt"
|
||||
"playlists.rkt")
|
||||
|
||||
(provide make-player
|
||||
player-state->jsexpr
|
||||
@@ -47,16 +50,8 @@
|
||||
(id [name #:mutable] [tracks #:mutable])
|
||||
#:transparent)
|
||||
|
||||
(struct network-playback
|
||||
([current-uri #:mutable]
|
||||
[prepared-uri #:mutable]
|
||||
[prepared-index #:mutable]
|
||||
[playing-seen? #:mutable]
|
||||
[progress-seen? #:mutable]
|
||||
[failure-active? #:mutable]
|
||||
[stop-requested? #:mutable]
|
||||
[stopped-polls #:mutable]
|
||||
[play-request-ms #:mutable])
|
||||
(struct playlist-context
|
||||
([tabs #:mutable] [current-index #:mutable])
|
||||
#:transparent)
|
||||
|
||||
(struct player
|
||||
@@ -86,11 +81,12 @@
|
||||
[error #:mutable]
|
||||
[discovering? #:mutable]
|
||||
[closed? #:mutable]
|
||||
[network-monitor #:mutable]
|
||||
state-lock
|
||||
command-lock
|
||||
local-music-indexes
|
||||
network
|
||||
playlist-store
|
||||
playlist-contexts
|
||||
[active-playlist-user #:mutable]
|
||||
dlna-port)
|
||||
#:transparent)
|
||||
|
||||
@@ -237,6 +233,71 @@
|
||||
(current-tab value)
|
||||
(player-tracks value)))
|
||||
|
||||
(define (normal-playlist-username username)
|
||||
(let ((value (and (string? username)
|
||||
(string-downcase (string-trim username)))))
|
||||
(if (and value (not (string=? value ""))) value "anonymous")))
|
||||
|
||||
(define (new-playlist-context value username)
|
||||
(define stored
|
||||
(load-user-playlists (player-playlist-store value)
|
||||
username
|
||||
(player-libraries value)))
|
||||
(playlist-context
|
||||
(if (pair? stored)
|
||||
(for/list ((tab (in-list stored)))
|
||||
(playlist-tab (persisted-tab-id tab)
|
||||
(persisted-tab-name tab)
|
||||
(persisted-tab-tracks tab)))
|
||||
(list (playlist-tab (uuid-string) "Default" '())))
|
||||
0))
|
||||
|
||||
(define (playlist-context-for! value username)
|
||||
(define normalized (normal-playlist-username username))
|
||||
(hash-ref!
|
||||
(player-playlist-contexts value)
|
||||
normalized
|
||||
(lambda () (new-playlist-context value normalized))))
|
||||
|
||||
(define (activate-playlist-user! value username)
|
||||
(define normalized (normal-playlist-username username))
|
||||
(unless (string=? normalized (player-active-playlist-user value))
|
||||
;; Playback uses the active playlist's track indexes. Stop before another
|
||||
;; user's playlist command replaces that context.
|
||||
(when (and (player-backend value)
|
||||
(not (eq? (player-state value) 'stopped)))
|
||||
(stop-playback! value))
|
||||
(define context (playlist-context-for! value normalized))
|
||||
(with-state-lock
|
||||
value
|
||||
(lambda ()
|
||||
(set-player-tabs! value (playlist-context-tabs context))
|
||||
(set-player-current-tab-index!
|
||||
value
|
||||
(playlist-context-current-index context))
|
||||
(set-player-tracks!
|
||||
value
|
||||
(playlist-tab-tracks
|
||||
(list-ref (playlist-context-tabs context)
|
||||
(playlist-context-current-index context))))
|
||||
(set-player-current-index! value #f)
|
||||
(set-player-active-playlist-user! value normalized)))))
|
||||
|
||||
(define (persist-playlists! value)
|
||||
(define username (player-active-playlist-user value))
|
||||
(define context (playlist-context-for! value username))
|
||||
(set-playlist-context-tabs! context (player-tabs value))
|
||||
(set-playlist-context-current-index!
|
||||
context
|
||||
(player-current-tab-index value))
|
||||
(save-user-playlists!
|
||||
(player-playlist-store value)
|
||||
username
|
||||
(for/list ((tab (in-list (player-tabs value))))
|
||||
(persisted-tab (playlist-tab-id tab)
|
||||
(playlist-tab-name tab)
|
||||
(playlist-tab-tracks tab)))))
|
||||
|
||||
(define (normalize-state state)
|
||||
(cond
|
||||
((eq? state 'playing) 'playing)
|
||||
@@ -261,94 +322,6 @@
|
||||
(set-player-bits! value #f)
|
||||
(set-player-decoder! value #f))
|
||||
|
||||
(define (now-ms)
|
||||
(current-inexact-milliseconds))
|
||||
|
||||
(define (reset-network-playback! value)
|
||||
(define network (player-network value))
|
||||
(set-network-playback-current-uri! network #f)
|
||||
(set-network-playback-prepared-uri! network #f)
|
||||
(set-network-playback-prepared-index! network #f)
|
||||
(set-network-playback-playing-seen?! network #f)
|
||||
(set-network-playback-progress-seen?! network #f)
|
||||
(set-network-playback-failure-active?! network #f)
|
||||
(set-network-playback-stop-requested?! network #f)
|
||||
(set-network-playback-stopped-polls! network 0)
|
||||
(set-network-playback-play-request-ms! network #f))
|
||||
|
||||
(define (same-track-file? first second)
|
||||
(and first
|
||||
second
|
||||
(with-handlers ((exn:fail? (lambda (_) #f)))
|
||||
(equal? (normal-case-path first)
|
||||
(normal-case-path second)))))
|
||||
|
||||
(define (network-info-track-index value info)
|
||||
(define network (player-network value))
|
||||
(define info-track (dlna-info-track info))
|
||||
(define file (and info-track (dlna-track-info-file info-track)))
|
||||
(define uri (dlna-info-uri info))
|
||||
(define prepared-index (network-playback-prepared-index network))
|
||||
(define prepared-uri (network-playback-prepared-uri network))
|
||||
(cond
|
||||
((and (valid-track-index? value prepared-index)
|
||||
(or (same-track-file?
|
||||
file
|
||||
(track-file (list-ref (player-tracks value) prepared-index)))
|
||||
(and (string? uri)
|
||||
(string? prepared-uri)
|
||||
(string=? uri prepared-uri))))
|
||||
prepared-index)
|
||||
(else
|
||||
(for/first ((item (in-list (player-tracks value)))
|
||||
(index (in-naturals))
|
||||
#:when (same-track-file? file (track-file item)))
|
||||
index))))
|
||||
|
||||
(define (prepare-next-network-track! value)
|
||||
(define backend (player-backend value))
|
||||
(define network (player-network value))
|
||||
(when (and backend
|
||||
(member (player-backend-kind value) '(upnp sonos))
|
||||
(valid-track-index? value (player-current-index value)))
|
||||
(define index (next-index value 1))
|
||||
(cond
|
||||
((not index)
|
||||
(set-network-playback-prepared-index! network #f)
|
||||
(set-network-playback-prepared-uri! network #f))
|
||||
((not (equal? index (network-playback-prepared-index network)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(set-network-playback-prepared-index! network #f)
|
||||
(set-network-playback-prepared-uri! network #f)
|
||||
(warn-web-player
|
||||
"Could not prepare next DLNA track: ~a"
|
||||
(exn-message exception)))))
|
||||
(dlna-player-set-next-file!
|
||||
backend
|
||||
(track-file (list-ref (player-tracks value) index)))
|
||||
(define prepared-info (dlna-player-info backend))
|
||||
(set-network-playback-prepared-index! network index)
|
||||
(set-network-playback-prepared-uri!
|
||||
network
|
||||
(dlna-info-next-uri prepared-info)))))))
|
||||
|
||||
;; Result used when a renderer reports stopped after a play request.
|
||||
(define (network-stop-decision stop-requested?
|
||||
playing-seen?
|
||||
progress-seen?
|
||||
elapsed-ms
|
||||
prepared?
|
||||
stopped-polls)
|
||||
(cond
|
||||
(stop-requested? 'requested-stop)
|
||||
((not playing-seen?) 'none)
|
||||
((and (not progress-seen?) (< elapsed-ms 5000)) 'wait-for-start)
|
||||
((not progress-seen?) 'playback-failed)
|
||||
((and prepared? (<= stopped-polls 1)) 'wait-for-next)
|
||||
(else 'advance)))
|
||||
|
||||
(define (local-state-callback value handle state full-state)
|
||||
(with-state-lock
|
||||
value
|
||||
@@ -409,10 +382,38 @@
|
||||
(* 100.0 logical-volume logical-volume)))
|
||||
backend))
|
||||
|
||||
(define (network-state-callback value state index info)
|
||||
(define track-info (dlna-info-track info))
|
||||
(with-state-lock
|
||||
value
|
||||
(lambda ()
|
||||
(when (valid-track-index? value index)
|
||||
(set-player-current-index! value index))
|
||||
(set-player-state! value state)
|
||||
(set-player-position! value (or (dlna-info-position info) 0))
|
||||
(set-player-duration! value (dlna-info-duration info))
|
||||
(set-player-rate!
|
||||
value
|
||||
(and track-info (dlna-track-info-sample-rate track-info)))
|
||||
(set-player-channels!
|
||||
value
|
||||
(and track-info (dlna-track-info-channels track-info)))
|
||||
(set-player-bits! value #f)
|
||||
(set-player-decoder! value 'dlna)
|
||||
(when (number? (dlna-info-volume info))
|
||||
(set-player-volume! value (dlna-info-volume info))))))
|
||||
|
||||
(define (make-network-backend value device)
|
||||
(make-dlna-player device
|
||||
#:port (player-dlna-port value)
|
||||
#:path "/rkt-web-player/"))
|
||||
(define backend
|
||||
(make-dlna-playback
|
||||
device
|
||||
(lambda () (player-tracks value))
|
||||
(lambda (state index info)
|
||||
(network-state-callback value state index info))
|
||||
(lambda (message) (set-error! value message))
|
||||
#:port (player-dlna-port value)))
|
||||
(dlna-playback-repeat! backend (player-repeat value))
|
||||
backend)
|
||||
|
||||
(define (ensure-backend! value)
|
||||
(if (player-backend value)
|
||||
@@ -461,11 +462,10 @@
|
||||
((eq? kind 'agent)
|
||||
(enqueue-agent-command! value backend "stop"))
|
||||
(else
|
||||
(dlna-player-close! backend)))))
|
||||
(dlna-playback-close! backend)))))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(reset-network-playback! value)
|
||||
(set-player-backend! value #f)
|
||||
(set-player-backend-kind! value #f)
|
||||
(set-player-state! value 'stopped)
|
||||
@@ -483,16 +483,7 @@
|
||||
(player-backend value)
|
||||
"stop"))
|
||||
(else
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(define network (player-network value))
|
||||
(set-network-playback-stop-requested?! network #t)
|
||||
(set-network-playback-playing-seen?! network #f)
|
||||
(set-network-playback-progress-seen?! network #f)
|
||||
(set-network-playback-failure-active?! network #f)
|
||||
(set-network-playback-stopped-polls! network 0)))
|
||||
(dlna-player-stop! (player-backend value)))))
|
||||
(dlna-playback-stop! (player-backend value)))))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
@@ -559,24 +550,7 @@
|
||||
(enqueue-agent-command!
|
||||
value backend "prefetch" following-data))))
|
||||
(else
|
||||
(dlna-player-play! backend (track-file item))
|
||||
(let ((info (dlna-player-info backend)))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(define network (player-network value))
|
||||
(set-network-playback-current-uri!
|
||||
network
|
||||
(dlna-info-uri info))
|
||||
(set-network-playback-prepared-uri! network #f)
|
||||
(set-network-playback-prepared-index! network #f)
|
||||
(set-network-playback-playing-seen?! network #t)
|
||||
(set-network-playback-progress-seen?! network #f)
|
||||
(set-network-playback-failure-active?! network #f)
|
||||
(set-network-playback-stop-requested?! network #f)
|
||||
(set-network-playback-stopped-polls! network 0)
|
||||
(set-network-playback-play-request-ms! network (now-ms)))))
|
||||
(prepare-next-network-track! value)))
|
||||
(dlna-playback-play-index! backend index)))
|
||||
(clear-error! value)))
|
||||
|
||||
(define (next-index value direction)
|
||||
@@ -628,140 +602,14 @@
|
||||
(when volume (set-player-volume! value volume)))
|
||||
(set-player-error! value (json-string reported 'error #f))))))
|
||||
|
||||
(define (refresh-dlna-state! value)
|
||||
(define info (dlna-player-info (player-backend value)))
|
||||
(define track-info (dlna-info-track info))
|
||||
(define new-state (normalize-state (dlna-info-state info)))
|
||||
(define position (or (dlna-info-position info) 0))
|
||||
(define prepare-next? #f)
|
||||
(define advance? #f)
|
||||
(define playback-failed? #f)
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(define network (player-network value))
|
||||
(define uri (dlna-info-uri info))
|
||||
(when (and (string? uri)
|
||||
(not (string=? uri ""))
|
||||
(not (equal? uri (network-playback-current-uri network))))
|
||||
(set-network-playback-current-uri! network uri)
|
||||
(set-network-playback-stopped-polls! network 0)
|
||||
(let ((detected-index (network-info-track-index value info)))
|
||||
(when (valid-track-index? value detected-index)
|
||||
(unless (equal? detected-index (player-current-index value))
|
||||
(set-network-playback-progress-seen?! network #f)
|
||||
(set-network-playback-failure-active?! network #f)
|
||||
(set-network-playback-play-request-ms! network (now-ms)))
|
||||
(set-player-current-index! value detected-index)
|
||||
(set-network-playback-prepared-index! network #f)
|
||||
(set-network-playback-prepared-uri! network #f)
|
||||
(set! prepare-next? #t))))
|
||||
|
||||
(when (and (not (network-playback-failure-active? network))
|
||||
(member new-state '(playing starting paused)))
|
||||
(when (eq? new-state 'playing)
|
||||
(set-network-playback-playing-seen?! network #t)
|
||||
(set-network-playback-stopped-polls! network 0))
|
||||
(when (and (number? position) (> position 0))
|
||||
(set-network-playback-progress-seen?! network #t)))
|
||||
|
||||
(let ((requested-at (network-playback-play-request-ms network)))
|
||||
(when (and (network-playback-playing-seen? network)
|
||||
(not (network-playback-progress-seen? network))
|
||||
requested-at
|
||||
(>= (- (now-ms) requested-at) 8000))
|
||||
(set-network-playback-playing-seen?! network #f)
|
||||
(set-network-playback-stopped-polls! network 0)
|
||||
(set-network-playback-failure-active?! network #t)
|
||||
(set-player-error! value "De DLNA-renderer kon de track niet starten")
|
||||
(set! playback-failed? #t)))
|
||||
|
||||
(when (and (eq? new-state 'stopped)
|
||||
(not playback-failed?)
|
||||
(not (network-playback-failure-active? network)))
|
||||
(when (and (network-playback-playing-seen? network)
|
||||
(network-playback-progress-seen? network))
|
||||
(set-network-playback-stopped-polls!
|
||||
network
|
||||
(+ 1 (network-playback-stopped-polls network))))
|
||||
(let* ((requested-at (network-playback-play-request-ms network))
|
||||
(decision
|
||||
(network-stop-decision
|
||||
(network-playback-stop-requested? network)
|
||||
(network-playback-playing-seen? network)
|
||||
(network-playback-progress-seen? network)
|
||||
(if requested-at (- (now-ms) requested-at) 10000)
|
||||
(exact-nonnegative-integer?
|
||||
(network-playback-prepared-index network))
|
||||
(network-playback-stopped-polls network))))
|
||||
(case decision
|
||||
((requested-stop)
|
||||
(set-network-playback-stop-requested?! network #f)
|
||||
(set-network-playback-stopped-polls! network 0))
|
||||
((playback-failed)
|
||||
(set-network-playback-playing-seen?! network #f)
|
||||
(set-network-playback-stopped-polls! network 0)
|
||||
(set-network-playback-failure-active?! network #t)
|
||||
(set-player-error! value "De DLNA-renderer kon de track niet starten"))
|
||||
((advance)
|
||||
(set-network-playback-playing-seen?! network #f)
|
||||
(set-network-playback-stopped-polls! network 0)
|
||||
(set! advance? #t)))))
|
||||
|
||||
(set-player-state!
|
||||
value
|
||||
(cond
|
||||
((or playback-failed?
|
||||
(network-playback-failure-active? network))
|
||||
'stopped)
|
||||
((and (network-playback-playing-seen? network)
|
||||
(not (network-playback-progress-seen? network)))
|
||||
'starting)
|
||||
(else new-state)))
|
||||
(set-player-position! value position)
|
||||
(set-player-duration! value (dlna-info-duration info))
|
||||
(set-player-rate!
|
||||
value
|
||||
(and track-info (dlna-track-info-sample-rate track-info)))
|
||||
(set-player-channels!
|
||||
value
|
||||
(and track-info (dlna-track-info-channels track-info)))
|
||||
(set-player-bits! value #f)
|
||||
(set-player-decoder! value 'dlna)
|
||||
(when (number? (dlna-info-volume info))
|
||||
(set-player-volume! value (dlna-info-volume info)))))
|
||||
(when prepare-next?
|
||||
(prepare-next-network-track! value))
|
||||
(when advance?
|
||||
(let ((index (next-index value 1)))
|
||||
(if index
|
||||
(play-index! value index)
|
||||
(stop-playback! value)))))
|
||||
|
||||
(define (refresh-network-state! value)
|
||||
(call-with-semaphore
|
||||
(player-command-lock value)
|
||||
(λ ()
|
||||
(when (and (player-backend value)
|
||||
(not (eq? (player-backend-kind value) 'local)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(set-error! value (exn-message exception)))))
|
||||
(if (eq? (player-backend-kind value) 'agent)
|
||||
(refresh-agent-state! value)
|
||||
(refresh-dlna-state! value)))))))
|
||||
|
||||
(define (start-network-monitor! value)
|
||||
(set-player-network-monitor!
|
||||
value
|
||||
(thread
|
||||
(λ ()
|
||||
(let loop ()
|
||||
(sleep 1)
|
||||
(unless (player-closed? value)
|
||||
(refresh-network-state! value)
|
||||
(loop)))))))
|
||||
(when (and (player-backend value)
|
||||
(eq? (player-backend-kind value) 'agent))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(set-error! value (exn-message exception)))))
|
||||
(refresh-agent-state! value))))
|
||||
|
||||
(define (entry-by-index value index)
|
||||
(and (exact-nonnegative-integer? index)
|
||||
@@ -812,7 +660,8 @@
|
||||
value
|
||||
(λ ()
|
||||
(set-player-tracks! value combined)
|
||||
(save-current-tab! value)))))
|
||||
(save-current-tab! value)
|
||||
(persist-playlists! value)))))
|
||||
|
||||
(define (replace-tracks! value tracks)
|
||||
(stop-playback! value)
|
||||
@@ -821,7 +670,8 @@
|
||||
(λ ()
|
||||
(set-player-tracks! value tracks)
|
||||
(set-player-current-index! value #f)
|
||||
(save-current-tab! value))))
|
||||
(save-current-tab! value)
|
||||
(persist-playlists! value))))
|
||||
|
||||
(define (drop-track! value index)
|
||||
(unless (valid-track-index? value index)
|
||||
@@ -846,7 +696,8 @@
|
||||
(set-player-current-index!
|
||||
value
|
||||
(- (player-current-index value) 1))))
|
||||
(save-current-tab! value))))
|
||||
(save-current-tab! value)
|
||||
(persist-playlists! value))))
|
||||
|
||||
(define (move-track! value from-index to-index)
|
||||
(unless (and (valid-track-index? value from-index)
|
||||
@@ -881,7 +732,8 @@
|
||||
((and (<= to-index current)
|
||||
(< current from-index))
|
||||
(set-player-current-index! value (+ current 1)))))
|
||||
(save-current-tab! value))))))
|
||||
(save-current-tab! value)
|
||||
(persist-playlists! value))))))
|
||||
|
||||
(define (select-tab! value index)
|
||||
(unless (and (exact-nonnegative-integer? index)
|
||||
@@ -900,7 +752,8 @@
|
||||
(set-player-tracks!
|
||||
value
|
||||
(playlist-tab-tracks (current-tab value)))
|
||||
(set-player-current-index! value #f)))))
|
||||
(set-player-current-index! value #f)
|
||||
(persist-playlists! value)))))
|
||||
|
||||
(define (add-tab! value)
|
||||
(with-state-lock
|
||||
@@ -911,15 +764,14 @@
|
||||
(number (+ (length tabs) 1))
|
||||
(tab
|
||||
(playlist-tab
|
||||
(format "tab-~a-~a"
|
||||
(current-milliseconds)
|
||||
(random 10000))
|
||||
(uuid-string)
|
||||
(format "Playlist ~a" number)
|
||||
'())))
|
||||
(set-player-tabs! value (append tabs (list tab)))
|
||||
(set-player-current-tab-index! value (length tabs))
|
||||
(set-player-tracks! value '())
|
||||
(set-player-current-index! value #f)))))
|
||||
(set-player-current-index! value #f)
|
||||
(persist-playlists! value)))))
|
||||
|
||||
(define (rename-tab! value index name)
|
||||
(unless (and (exact-nonnegative-integer? index)
|
||||
@@ -938,7 +790,8 @@
|
||||
(λ ()
|
||||
(set-playlist-tab-name!
|
||||
(list-ref (player-tabs value) index)
|
||||
trimmed)))))
|
||||
trimmed)
|
||||
(persist-playlists! value)))))
|
||||
|
||||
(define (delete-tab! value index)
|
||||
(when (= (length (player-tabs value)) 1)
|
||||
@@ -967,7 +820,8 @@
|
||||
(set-player-tracks!
|
||||
value
|
||||
(playlist-tab-tracks (list-ref tabs new-index)))
|
||||
(set-player-current-index! value #f)))))
|
||||
(set-player-current-index! value #f)
|
||||
(persist-playlists! value)))))
|
||||
|
||||
(define (track->jsexpr item index)
|
||||
(hasheq 'index index
|
||||
@@ -1153,7 +1007,7 @@
|
||||
((eq? (player-backend-kind value) 'agent)
|
||||
(enqueue-agent-command! value backend "pause"))
|
||||
(else
|
||||
(dlna-player-pause! backend)))))
|
||||
(dlna-playback-pause! backend)))))
|
||||
((string=? command "resume")
|
||||
(let ((backend (ensure-backend! value)))
|
||||
(cond
|
||||
@@ -1162,7 +1016,7 @@
|
||||
((eq? (player-backend-kind value) 'agent)
|
||||
(enqueue-agent-command! value backend "resume"))
|
||||
(else
|
||||
(dlna-player-resume! backend)))))
|
||||
(dlna-playback-resume! backend)))))
|
||||
((string=? command "stop")
|
||||
(stop-playback! value))
|
||||
((string=? command "next")
|
||||
@@ -1189,7 +1043,7 @@
|
||||
value backend "seek"
|
||||
(hasheq 'percentage percentage)))
|
||||
(else
|
||||
(dlna-player-seek-percentage! backend percentage))))))
|
||||
(dlna-playback-seek-percentage! backend percentage))))))
|
||||
((string=? command "volume")
|
||||
(let ((percentage (json-number data 'value #f)))
|
||||
(unless percentage
|
||||
@@ -1209,7 +1063,7 @@
|
||||
value backend "volume"
|
||||
(hasheq 'value clamped)))
|
||||
(else
|
||||
(dlna-player-volume! backend clamped)))
|
||||
(dlna-playback-volume! backend clamped)))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
@@ -1227,10 +1081,7 @@
|
||||
(λ ()
|
||||
(set-player-repeat! value mode)))
|
||||
(when (member (player-backend-kind value) '(upnp sonos))
|
||||
;; Replace the renderer's prepared URI when repeat mode changes.
|
||||
(set-network-playback-prepared-index! (player-network value) #f)
|
||||
(set-network-playback-prepared-uri! (player-network value) #f)
|
||||
(prepare-next-network-track! value))))
|
||||
(dlna-playback-repeat! (player-backend value) mode))))
|
||||
((string=? command "renderer")
|
||||
(let* ((id (json-string data 'id #f))
|
||||
(selected (and id (renderer-by-id value id))))
|
||||
@@ -1263,6 +1114,7 @@
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (make-player libraries
|
||||
#:allowed-agent-ids [allowed-agent-ids '()]
|
||||
#:playlist-keystore [playlist-keystore #f]
|
||||
#:dlna-port [dlna-port 8734])
|
||||
(define normalized-agent-ids
|
||||
(for/list ((app-id (in-list allowed-agent-ids)))
|
||||
@@ -1272,12 +1124,25 @@
|
||||
"64-character hexadecimal playback agent id"
|
||||
app-id))
|
||||
(string-downcase app-id)))
|
||||
(define store (open-playlist-store playlist-keystore))
|
||||
(define stored-tabs
|
||||
(load-user-playlists store "local" libraries))
|
||||
(let* ((library (and (pair? libraries) (car libraries)))
|
||||
(browser-entries
|
||||
(if library
|
||||
(browse-library library '())
|
||||
'()))
|
||||
(tab (playlist-tab "default" "Default" '())))
|
||||
(tabs
|
||||
(if (pair? stored-tabs)
|
||||
(for/list ((tab (in-list stored-tabs)))
|
||||
(playlist-tab (persisted-tab-id tab)
|
||||
(persisted-tab-name tab)
|
||||
(persisted-tab-tracks tab)))
|
||||
(list (playlist-tab (uuid-string) "Default" '()))))
|
||||
(selected-index 0)
|
||||
(contexts (make-hash))
|
||||
(initial-context (playlist-context tabs selected-index)))
|
||||
(hash-set! contexts "local" initial-context)
|
||||
(define value
|
||||
(player libraries
|
||||
(remove-duplicates normalized-agent-ids string=?)
|
||||
@@ -1285,9 +1150,9 @@
|
||||
(and library (music-library-id library))
|
||||
'()
|
||||
browser-entries
|
||||
'()
|
||||
(list tab)
|
||||
0
|
||||
(playlist-tab-tracks (list-ref tabs selected-index))
|
||||
tabs
|
||||
selected-index
|
||||
(list (renderer "local" "Server audio output" 'local #f))
|
||||
"local"
|
||||
#f
|
||||
@@ -1305,13 +1170,13 @@
|
||||
#f
|
||||
#f
|
||||
#f
|
||||
#f
|
||||
(make-semaphore 1)
|
||||
(make-semaphore 1)
|
||||
(make-hash)
|
||||
(network-playback #f #f #f #f #f #f #f 0 #f)
|
||||
store
|
||||
contexts
|
||||
"local"
|
||||
dlna-port))
|
||||
(start-network-monitor! value)
|
||||
value))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
@@ -1320,19 +1185,27 @@
|
||||
; post : Cached DLNA playback information has been incorporated.
|
||||
; result : A JSON-compatible hash.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (player-state->jsexpr value)
|
||||
(prune-stale-agents! value)
|
||||
(refresh-network-state! value)
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(let ((current
|
||||
(and (player-current-index value)
|
||||
(valid-track-index?
|
||||
value
|
||||
(player-current-index value))
|
||||
(list-ref (player-tracks value)
|
||||
(player-current-index value)))))
|
||||
(define (player-state->jsexpr value #:username [username "local"])
|
||||
(define normalized (normal-playlist-username username))
|
||||
(call-with-semaphore
|
||||
(player-command-lock value)
|
||||
(lambda ()
|
||||
(prune-stale-agents! value)
|
||||
(refresh-network-state! value)
|
||||
(define context (playlist-context-for! value normalized))
|
||||
(define tabs (playlist-context-tabs context))
|
||||
(define tab-index (playlist-context-current-index context))
|
||||
(define tracks (playlist-tab-tracks (list-ref tabs tab-index)))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(let ((current
|
||||
(and (player-current-index value)
|
||||
(valid-track-index?
|
||||
value
|
||||
(player-current-index value))
|
||||
(list-ref (player-tracks value)
|
||||
(player-current-index value)))))
|
||||
(hasheq
|
||||
'libraries (map library->jsexpr
|
||||
(player-libraries value))
|
||||
@@ -1346,18 +1219,21 @@
|
||||
(index (in-naturals)))
|
||||
(browser-entry->jsexpr entry index)))
|
||||
'tabs
|
||||
(for/list ((tab (in-list (player-tabs value)))
|
||||
(for/list ((tab (in-list tabs))
|
||||
(index (in-naturals)))
|
||||
(tab->jsexpr tab index))
|
||||
'currentTab (player-current-tab-index value)
|
||||
'currentTab tab-index
|
||||
'tracks
|
||||
(for/list ((item (in-list (player-tracks value)))
|
||||
(for/list ((item (in-list tracks))
|
||||
(index (in-naturals)))
|
||||
(track->jsexpr item index))
|
||||
'renderers (map renderer->jsexpr
|
||||
(player-renderers value))
|
||||
'rendererId (player-selected-id value)
|
||||
'currentIndex (or (player-current-index value) 'null)
|
||||
'currentIndex
|
||||
(if (string=? normalized (player-active-playlist-user value))
|
||||
(or (player-current-index value) 'null)
|
||||
'null)
|
||||
'state (symbol->string (player-state value))
|
||||
'position (player-position value)
|
||||
'duration (or (player-duration value) 'null)
|
||||
@@ -1375,7 +1251,7 @@
|
||||
'volume (player-volume value)
|
||||
'repeat (symbol->string (player-repeat value))
|
||||
'discovering (player-discovering? value)
|
||||
'error (or (player-error value) 'null))))))
|
||||
'error (or (player-error value) 'null))))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Execute one browser player command.
|
||||
@@ -1383,7 +1259,13 @@
|
||||
; post : The command has completed or a concrete exception is raised.
|
||||
; result : The updated JSON-compatible player state.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (player-command! value command data)
|
||||
(define playlist-context-commands
|
||||
'("item-play" "item-add" "track-remove" "track-move"
|
||||
"playlist-clear" "tab-add" "tab-select" "tab-rename"
|
||||
"tab-delete" "play"))
|
||||
|
||||
(define (player-command! value command data #:username [username "local"])
|
||||
(define normalized (normal-playlist-username username))
|
||||
(call-with-semaphore
|
||||
(player-command-lock value)
|
||||
(λ ()
|
||||
@@ -1396,10 +1278,10 @@
|
||||
(λ (exception)
|
||||
(set-error! value (exn-message exception))
|
||||
(raise exception))))
|
||||
(when (member command playlist-context-commands)
|
||||
(activate-playlist-user! value normalized))
|
||||
(perform-command! value command data))))
|
||||
;; State refresh can itself advance a completed network track and therefore
|
||||
;; acquires command-lock. Take the snapshot after releasing this command.
|
||||
(player-state->jsexpr value))
|
||||
(player-state->jsexpr value #:username normalized))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Discover UPnP renderers and logical Sonos groups asynchronously.
|
||||
@@ -1606,15 +1488,24 @@
|
||||
; post : Player state remains unchanged.
|
||||
; result : Artwork bytes and MIME type, or #f when unavailable.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (player-track-artwork value artwork-id)
|
||||
(let ((item
|
||||
(with-state-lock
|
||||
(define (player-track-artwork value artwork-id #:username [username "local"])
|
||||
(define item
|
||||
(call-with-semaphore
|
||||
(player-command-lock value)
|
||||
(lambda ()
|
||||
(define context
|
||||
(playlist-context-for!
|
||||
value
|
||||
(λ ()
|
||||
(findf (λ (candidate)
|
||||
(string=? (track-cache-key candidate) artwork-id))
|
||||
(player-tracks value))))))
|
||||
(and item (track-artwork item))))
|
||||
(normal-playlist-username username)))
|
||||
(define candidates
|
||||
(append
|
||||
(player-tracks value)
|
||||
(append-map playlist-tab-tracks
|
||||
(playlist-context-tabs context))))
|
||||
(findf (lambda (candidate)
|
||||
(string=? (track-cache-key candidate) artwork-id))
|
||||
candidates))))
|
||||
(and item (track-artwork item)))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Stop playback and release all player resources.
|
||||
@@ -1627,38 +1518,16 @@
|
||||
(λ ()
|
||||
(unless (player-closed? value)
|
||||
(close-backend! value)
|
||||
(close-playlist-store! (player-playlist-store value))
|
||||
(with-state-lock
|
||||
value
|
||||
(λ ()
|
||||
(set-player-closed?! value #t))))))
|
||||
(let ((monitor (player-network-monitor value)))
|
||||
(when (and monitor (not (thread-dead? monitor)))
|
||||
(kill-thread monitor))
|
||||
(set-player-network-monitor! value #f)))
|
||||
(set-player-closed?! value #t)))))))
|
||||
|
||||
(module+ test
|
||||
(require rackunit
|
||||
racket/file)
|
||||
|
||||
(check-eq?
|
||||
(network-stop-decision #t #t #t 6000 #f 1)
|
||||
'requested-stop)
|
||||
(check-eq?
|
||||
(network-stop-decision #f #t #f 1000 #f 0)
|
||||
'wait-for-start)
|
||||
(check-eq?
|
||||
(network-stop-decision #f #t #f 6000 #f 0)
|
||||
'playback-failed)
|
||||
(check-eq?
|
||||
(network-stop-decision #f #t #t 6000 #t 1)
|
||||
'wait-for-next)
|
||||
(check-eq?
|
||||
(network-stop-decision #f #t #t 6000 #t 2)
|
||||
'advance)
|
||||
(check-eq?
|
||||
(network-stop-decision #f #t #t 6000 #f 1)
|
||||
'advance)
|
||||
|
||||
(define root
|
||||
(make-temporary-file "rkt-web-player-~a" 'directory))
|
||||
|
||||
@@ -1667,9 +1536,11 @@
|
||||
(λ ()
|
||||
(make-directory (build-path root "Album"))
|
||||
(let* ((libraries (make-music-libraries (list root)))
|
||||
(playlist-keystore (build-path root "playlists.keystore"))
|
||||
(test-agent-id (make-string 64 #\a))
|
||||
(example-player
|
||||
(make-player libraries
|
||||
#:playlist-keystore playlist-keystore
|
||||
#:allowed-agent-ids (list test-agent-id)))
|
||||
(initial-state
|
||||
(player-state->jsexpr example-player)))
|
||||
@@ -1821,29 +1692,12 @@
|
||||
example-player
|
||||
(list (track first-file "First" "Artist" "Album" 60 "audio/flac")
|
||||
(track second-file "Second" "Artist" "Album" 60 "audio/flac")))
|
||||
|
||||
(define test-network (player-network example-player))
|
||||
(set-network-playback-prepared-index! test-network 1)
|
||||
(set-network-playback-prepared-uri!
|
||||
test-network
|
||||
"http://renderer.test/next.flac")
|
||||
(check-equal?
|
||||
(network-info-track-index
|
||||
example-player
|
||||
(dlna-info
|
||||
'playing
|
||||
(dlna-track-info second-file "Second" "Artist" "Album"
|
||||
#f #f #f 60 #f #f #f)
|
||||
"http://renderer.test/current.flac"
|
||||
#f #f 0 60 25 #f #t))
|
||||
1)
|
||||
(check-equal?
|
||||
(network-info-track-index
|
||||
example-player
|
||||
(dlna-info 'playing #f "http://renderer.test/next.flac"
|
||||
#f #f 0 60 25 #f #t))
|
||||
1)
|
||||
(reset-network-playback! example-player)
|
||||
;; Exercise persistence through ordinary playlist mutations while
|
||||
;; restoring the original order for the playback-agent assertions.
|
||||
(player-command!
|
||||
example-player "track-move" (hasheq 'from 0 'to 1))
|
||||
(player-command!
|
||||
example-player "track-move" (hasheq 'from 1 'to 0))
|
||||
|
||||
(player-command! example-player "play" (hasheq 'index 0))
|
||||
(define play-poll
|
||||
@@ -1890,6 +1744,39 @@
|
||||
example-player
|
||||
"unknown"
|
||||
(hasheq))))
|
||||
(player-close! example-player)))
|
||||
|
||||
(define hans-tabs
|
||||
(player-command!
|
||||
example-player
|
||||
"tab-add"
|
||||
(hasheq)
|
||||
#:username "hans"))
|
||||
(check-equal? (length (hash-ref hans-tabs 'tabs)) 2)
|
||||
(player-command!
|
||||
example-player
|
||||
"tab-rename"
|
||||
(hasheq 'index 1 'name "Hans favorieten")
|
||||
#:username "hans")
|
||||
(define local-after-hans
|
||||
(player-state->jsexpr example-player #:username "local"))
|
||||
(check-equal? (length (hash-ref local-after-hans 'tabs)) 1)
|
||||
(check-equal? (length (hash-ref local-after-hans 'tracks)) 2)
|
||||
(player-close! example-player)
|
||||
|
||||
(define restored-player
|
||||
(make-player libraries #:playlist-keystore playlist-keystore))
|
||||
(define restored-state (player-state->jsexpr restored-player))
|
||||
(check-equal? (length (hash-ref restored-state 'tabs)) 1)
|
||||
(check-equal? (length (hash-ref restored-state 'tracks)) 2)
|
||||
(check-equal?
|
||||
(hash-ref (car (hash-ref restored-state 'tracks)) 'source)
|
||||
"01.flac")
|
||||
(define restored-hans
|
||||
(player-state->jsexpr restored-player #:username "hans"))
|
||||
(check-equal? (length (hash-ref restored-hans 'tabs)) 2)
|
||||
(check-equal?
|
||||
(hash-ref (second (hash-ref restored-hans 'tabs)) 'name)
|
||||
"Hans favorieten")
|
||||
(player-close! restored-player)))
|
||||
(λ ()
|
||||
(delete-directory/files root))))
|
||||
|
||||
Reference in New Issue
Block a user