1623 lines
55 KiB
Racket
1623 lines
55 KiB
Racket
#lang racket/base
|
|
|
|
(require racket-audio
|
|
racket-audio-dlna
|
|
file/sha1
|
|
racket/list
|
|
racket/path
|
|
racket/random
|
|
racket/string
|
|
racket-sonos
|
|
racket-upnp
|
|
simple-log
|
|
"library.rkt")
|
|
|
|
(provide make-player
|
|
player-state->jsexpr
|
|
player-command!
|
|
player-discover!
|
|
player-agent-register!
|
|
player-agent-poll!
|
|
player-agent-media
|
|
player-track-artwork
|
|
exn:fail:agent-denied?
|
|
player-close!)
|
|
|
|
(sl-def-log web-player)
|
|
|
|
(struct renderer
|
|
(id [name #:mutable] kind device)
|
|
#:transparent)
|
|
|
|
(struct playback-agent
|
|
(app-id
|
|
[name #:mutable]
|
|
[last-seen #:mutable]
|
|
[reported-state #:mutable]
|
|
[commands #:mutable]
|
|
[next-command-id #:mutable]
|
|
media
|
|
[ended-counter #:mutable])
|
|
#:transparent)
|
|
|
|
(struct exn:fail:agent-denied exn:fail ()
|
|
#:transparent)
|
|
|
|
(struct playlist-tab
|
|
(id [name #:mutable] [tracks #:mutable])
|
|
#:transparent)
|
|
|
|
(struct player
|
|
(libraries
|
|
allowed-agent-ids
|
|
[agents #:mutable]
|
|
[current-library-id #:mutable]
|
|
[browser-path #:mutable]
|
|
[browser-entries #:mutable]
|
|
[tracks #:mutable]
|
|
[tabs #:mutable]
|
|
[current-tab-index #:mutable]
|
|
[renderers #:mutable]
|
|
[selected-id #:mutable]
|
|
[backend #:mutable]
|
|
[backend-kind #:mutable]
|
|
[current-index #:mutable]
|
|
[state #:mutable]
|
|
[position #:mutable]
|
|
[duration #:mutable]
|
|
[rate #:mutable]
|
|
[channels #:mutable]
|
|
[bits #:mutable]
|
|
[decoder #:mutable]
|
|
[volume #:mutable]
|
|
[repeat #:mutable]
|
|
[error #:mutable]
|
|
[discovering? #:mutable]
|
|
[closed? #:mutable]
|
|
state-lock
|
|
command-lock
|
|
local-music-indexes
|
|
dlna-port)
|
|
#:transparent)
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Internal state / functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (with-state-lock value proc)
|
|
(call-with-semaphore (player-state-lock value) proc))
|
|
|
|
(define (renderer-by-id value id)
|
|
(findf (λ (item)
|
|
(string=? (renderer-id item) id))
|
|
(player-renderers value)))
|
|
|
|
(define (agent-renderer-id app-id)
|
|
(string-append "agent:" app-id))
|
|
|
|
(define (agent-by-id value app-id)
|
|
(findf (λ (agent)
|
|
(string=? (playback-agent-app-id agent) app-id))
|
|
(player-agents value)))
|
|
|
|
(define (agent-renderer value agent)
|
|
(renderer-by-id value
|
|
(agent-renderer-id
|
|
(playback-agent-app-id agent))))
|
|
|
|
(define (valid-agent-id? value)
|
|
(and (string? value)
|
|
(regexp-match? #px"^[0-9a-fA-F]{64}$" value)))
|
|
|
|
(define (normal-agent-id value)
|
|
(and (valid-agent-id? value)
|
|
(string-downcase value)))
|
|
|
|
(define (authorized-agent-id? value app-id)
|
|
(and (normal-agent-id app-id)
|
|
(member (normal-agent-id app-id)
|
|
(player-allowed-agent-ids value))
|
|
#t))
|
|
|
|
(define (require-authorized-agent! value app-id)
|
|
(unless (authorized-agent-id? value app-id)
|
|
(raise
|
|
(exn:fail:agent-denied
|
|
(format
|
|
"Playback agent ~a is niet toegestaan; voeg het applicatie-ID eerst toe aan [playback-agents] in de server-INI"
|
|
(or app-id "(ontbreekt)"))
|
|
(current-continuation-marks)))))
|
|
|
|
(define (fresh-media-token)
|
|
(bytes->hex-string (crypto-random-bytes 32)))
|
|
|
|
(define (track-cache-key item)
|
|
(sha1
|
|
(open-input-string
|
|
(path->string (track-file item)))))
|
|
|
|
(define (agent-track-data item index token)
|
|
(hasheq 'playlistIndex index
|
|
'trackNumber (+ index 1)
|
|
'cacheKey (track-cache-key item)
|
|
'mediaToken token
|
|
'filename
|
|
(path->string
|
|
(or (file-name-from-path (track-file item))
|
|
(track-file item)))
|
|
'title (track-title item)
|
|
'artist (track-artist item)
|
|
'album (track-album item)
|
|
'duration (or (track-duration item) 'null)))
|
|
|
|
(define (enqueue-agent-command! value agent action [data (hasheq)])
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(let* ((id (playback-agent-next-command-id agent))
|
|
(command (hasheq 'id id
|
|
'action action
|
|
'data data)))
|
|
(set-playback-agent-next-command-id! agent (+ id 1))
|
|
(set-playback-agent-commands!
|
|
agent
|
|
(append (playback-agent-commands agent)
|
|
(list command)))
|
|
command))))
|
|
|
|
(define agent-heartbeat-timeout-seconds 10)
|
|
|
|
(define (prune-stale-agents! value)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(let* ((cutoff (- (current-seconds)
|
|
agent-heartbeat-timeout-seconds))
|
|
(stale
|
|
(filter (λ (agent)
|
|
(< (playback-agent-last-seen agent) cutoff))
|
|
(player-agents value)))
|
|
(stale-ids
|
|
(map (λ (agent)
|
|
(agent-renderer-id
|
|
(playback-agent-app-id agent)))
|
|
stale)))
|
|
(unless (null? stale)
|
|
(set-player-agents!
|
|
value
|
|
(filter (λ (agent)
|
|
(not (member (agent-renderer-id
|
|
(playback-agent-app-id agent))
|
|
stale-ids)))
|
|
(player-agents value)))
|
|
(set-player-renderers!
|
|
value
|
|
(filter (λ (item)
|
|
(not (member (renderer-id item) stale-ids)))
|
|
(player-renderers value)))
|
|
(when (member (player-selected-id value) stale-ids)
|
|
(set-player-selected-id! value "local")
|
|
(set-player-backend! value #f)
|
|
(set-player-backend-kind! value #f)
|
|
(set-player-state! value 'stopped)
|
|
(set-player-position! value 0)
|
|
(set-player-duration! value #f)
|
|
(reset-audio-info! value)))))))
|
|
|
|
(define (library-by-id value id)
|
|
(findf (λ (library)
|
|
(string=? (music-library-id library) id))
|
|
(player-libraries value)))
|
|
|
|
(define (current-library value)
|
|
(and (player-current-library-id value)
|
|
(library-by-id value
|
|
(player-current-library-id value))))
|
|
|
|
(define (current-tab value)
|
|
(list-ref (player-tabs value)
|
|
(player-current-tab-index value)))
|
|
|
|
(define (save-current-tab! value)
|
|
(set-playlist-tab-tracks!
|
|
(current-tab value)
|
|
(player-tracks value)))
|
|
|
|
(define (normalize-state state)
|
|
(cond
|
|
((eq? state 'playing) 'playing)
|
|
((eq? state 'paused) 'paused)
|
|
((eq? state 'transitioning) 'starting)
|
|
((eq? state 'initialized) 'stopped)
|
|
((eq? state 'no-media) 'stopped)
|
|
(else state)))
|
|
|
|
(define (set-error! value message)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-error! value message))))
|
|
|
|
(define (clear-error! value)
|
|
(set-error! value #f))
|
|
|
|
(define (reset-audio-info! value)
|
|
(set-player-rate! value #f)
|
|
(set-player-channels! value #f)
|
|
(set-player-bits! value #f)
|
|
(set-player-decoder! value #f))
|
|
|
|
(define (local-state-callback value handle state full-state)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(when (eq? handle (player-backend value))
|
|
(let* ((music-id (hash-ref full-state 'at-music-id #f))
|
|
(audible-index
|
|
(and (number? music-id)
|
|
(hash-ref (player-local-music-indexes value)
|
|
music-id
|
|
#f))))
|
|
(when (exact-nonnegative-integer? audible-index)
|
|
(set-player-current-index! value audible-index)))
|
|
(set-player-state! value (normalize-state state))
|
|
(set-player-position!
|
|
value
|
|
(or (hash-ref full-state 'at-second #f) 0))
|
|
(set-player-duration!
|
|
value
|
|
(hash-ref full-state 'duration #f))
|
|
(set-player-rate! value
|
|
(hash-ref full-state 'rate #f))
|
|
(set-player-channels! value
|
|
(hash-ref full-state 'channels #f))
|
|
(set-player-bits! value
|
|
(hash-ref full-state 'bits #f))
|
|
(set-player-decoder! value
|
|
(hash-ref full-state 'decoder #f))))))
|
|
|
|
(define (local-end-callback value handle)
|
|
(when (eq? handle (player-backend value))
|
|
(with-handlers
|
|
((exn:fail?
|
|
(λ (exception)
|
|
(set-error! value (exn-message exception)))))
|
|
(call-with-semaphore
|
|
(player-command-lock value)
|
|
(λ ()
|
|
(let ((index (next-index value 1)))
|
|
;; Queue immediately at decoder EOF, but keep the old track selected
|
|
;; until libao reports the new music id as actually audible.
|
|
(when index
|
|
(play-index! value index #t))))))))
|
|
|
|
(define (make-local-backend value)
|
|
(let ((backend
|
|
(make-audio-player
|
|
(λ (handle state full-state)
|
|
(local-state-callback value handle state full-state))
|
|
(λ (handle)
|
|
(local-end-callback value handle)))))
|
|
(audio-ao-buf-ms! backend 500)
|
|
(audio-buf-seconds! backend 4 10)
|
|
(let ((logical-volume
|
|
(/ (player-volume value) 100.0)))
|
|
(audio-volume!
|
|
backend
|
|
(* 100.0 logical-volume logical-volume)))
|
|
backend))
|
|
|
|
(define (make-network-backend value device)
|
|
(make-dlna-player device
|
|
#:port (player-dlna-port value)
|
|
#:path "/rkt-web-player/"))
|
|
|
|
(define (ensure-backend! value)
|
|
(if (player-backend value)
|
|
(player-backend value)
|
|
(let* ((selected
|
|
(renderer-by-id value
|
|
(player-selected-id value)))
|
|
(kind (and selected (renderer-kind selected)))
|
|
(backend
|
|
(cond
|
|
((eq? kind 'local)
|
|
(make-local-backend value))
|
|
((or (eq? kind 'upnp)
|
|
(eq? kind 'sonos))
|
|
(make-network-backend
|
|
value
|
|
(renderer-device selected)))
|
|
((eq? kind 'agent)
|
|
(renderer-device selected))
|
|
(else
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"selected renderer is unavailable"
|
|
"renderer" (player-selected-id value))))))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-backend! value backend)
|
|
(set-player-backend-kind! value kind)))
|
|
backend)))
|
|
|
|
(define (close-backend! value)
|
|
(let ((backend (player-backend value))
|
|
(kind (player-backend-kind value)))
|
|
(when backend
|
|
(with-handlers
|
|
((exn:fail?
|
|
(λ (exception)
|
|
(warn-web-player
|
|
"Could not close ~a player: ~a"
|
|
kind
|
|
(exn-message exception)))))
|
|
(cond
|
|
((eq? kind 'local)
|
|
(audio-quit! backend))
|
|
((eq? kind 'agent)
|
|
(enqueue-agent-command! value backend "stop"))
|
|
(else
|
|
(dlna-player-close! backend)))))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-backend! value #f)
|
|
(set-player-backend-kind! value #f)
|
|
(set-player-state! value 'stopped)
|
|
(set-player-position! value 0)
|
|
(set-player-duration! value #f)
|
|
(reset-audio-info! value)))))
|
|
|
|
(define (stop-playback! value)
|
|
(when (player-backend value)
|
|
(cond
|
|
((eq? (player-backend-kind value) 'local)
|
|
(audio-stop! (player-backend value)))
|
|
((eq? (player-backend-kind value) 'agent)
|
|
(enqueue-agent-command! value
|
|
(player-backend value)
|
|
"stop"))
|
|
(else
|
|
(dlna-player-stop! (player-backend value)))))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-state! value 'stopped)
|
|
(set-player-position! value 0)
|
|
(reset-audio-info! value))))
|
|
|
|
(define (valid-track-index? value index)
|
|
(and (exact-nonnegative-integer? index)
|
|
(< index (length (player-tracks value)))))
|
|
|
|
(define (play-index! value index [defer-current-index? #f])
|
|
(unless (valid-track-index? value index)
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"track index is outside the playlist"
|
|
"index" index))
|
|
(let* ((item (list-ref (player-tracks value) index))
|
|
(backend (ensure-backend! value))
|
|
(kind (player-backend-kind value)))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(unless defer-current-index?
|
|
(set-player-current-index! value index)
|
|
(set-player-state! value 'starting)
|
|
(set-player-position! value 0)
|
|
(set-player-duration! value (track-duration item)))))
|
|
(cond
|
|
((eq? kind 'local)
|
|
(let ((music-id (audio-play! backend (track-file item))))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(hash-set! (player-local-music-indexes value)
|
|
music-id
|
|
index)))))
|
|
((eq? kind 'agent)
|
|
(let* ((token (fresh-media-token))
|
|
(data (agent-track-data item index token))
|
|
(following-index (next-index value 1))
|
|
(following-item
|
|
(and following-index
|
|
(list-ref (player-tracks value) following-index)))
|
|
(following-token
|
|
(and following-item (fresh-media-token)))
|
|
(following-data
|
|
(and following-item
|
|
(agent-track-data following-item
|
|
following-index
|
|
following-token))))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(hash-set! (playback-agent-media backend)
|
|
token
|
|
(track-file item))
|
|
(when following-item
|
|
(hash-set! (playback-agent-media backend)
|
|
following-token
|
|
(track-file following-item)))))
|
|
(enqueue-agent-command! value backend "play" data)
|
|
(when following-data
|
|
(enqueue-agent-command!
|
|
value backend "prefetch" following-data))))
|
|
(else
|
|
(dlna-player-play! backend (track-file item))))
|
|
(clear-error! value)))
|
|
|
|
(define (next-index value direction)
|
|
(let ((count (length (player-tracks value)))
|
|
(current (player-current-index value))
|
|
(repeat (player-repeat value)))
|
|
(cond
|
|
((zero? count) #f)
|
|
((eq? repeat 'one) current)
|
|
((eq? current #f)
|
|
(if (positive? direction) 0 (- count 1)))
|
|
(else
|
|
(let ((candidate (+ current direction)))
|
|
(cond
|
|
((and (>= candidate 0) (< candidate count)) candidate)
|
|
((eq? repeat 'all)
|
|
(if (positive? direction) 0 (- count 1)))
|
|
(else #f)))))))
|
|
|
|
(define (refresh-network-state! 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)
|
|
(let ((reported
|
|
(playback-agent-reported-state
|
|
(player-backend value))))
|
|
;; Keep the server's optimistic command state visible until the
|
|
;; agent acknowledges playback-changing work. Prefetching does not
|
|
;; change playback state and may continue in the background.
|
|
(when (and (hash? reported)
|
|
(andmap
|
|
(λ (command)
|
|
(string=? (hash-ref command 'action "")
|
|
"prefetch"))
|
|
(playback-agent-commands
|
|
(player-backend value))))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(let ((state (hash-ref reported 'state #f)))
|
|
(when (string? state)
|
|
(set-player-state!
|
|
value
|
|
(normalize-state (string->symbol state)))))
|
|
(set-player-position!
|
|
value
|
|
(or (json-number reported 'position #f) 0))
|
|
(set-player-duration!
|
|
value
|
|
(json-number reported 'duration #f))
|
|
(set-player-rate!
|
|
value
|
|
(json-number reported 'rate #f))
|
|
(set-player-channels!
|
|
value
|
|
(json-number reported 'channels #f))
|
|
(set-player-bits!
|
|
value
|
|
(json-number reported 'bits #f))
|
|
(let ((decoder (json-string reported 'format #f)))
|
|
(set-player-decoder!
|
|
value
|
|
(and decoder (string->symbol decoder))))
|
|
(let ((volume (json-number reported 'volume #f)))
|
|
(when volume
|
|
(set-player-volume! value volume)))
|
|
(let ((error (json-string reported 'error #f)))
|
|
(set-player-error! value error))))))
|
|
(let* ((info (dlna-player-info (player-backend value)))
|
|
(track-info (dlna-info-track info)))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-state!
|
|
value
|
|
(normalize-state (dlna-info-state info)))
|
|
(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 (entry-by-index value index)
|
|
(and (exact-nonnegative-integer? index)
|
|
(< index (length (player-browser-entries value)))
|
|
(list-ref (player-browser-entries value) index)))
|
|
|
|
(define (refresh-browser! value library relative-path)
|
|
(let ((entries (browse-library library relative-path)))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-current-library-id!
|
|
value
|
|
(music-library-id library))
|
|
(set-player-browser-path! value relative-path)
|
|
(set-player-browser-entries! value entries)))))
|
|
|
|
(define (selected-entry-tracks value index)
|
|
(let ((entry (entry-by-index value index))
|
|
(library (current-library value)))
|
|
(unless entry
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"library entry does not exist"
|
|
"index" index))
|
|
(unless library
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"no music library is selected"))
|
|
(browser-entry->tracks library entry)))
|
|
|
|
(define (same-track? first second)
|
|
(equal? (normal-case-path (track-file first))
|
|
(normal-case-path (track-file second))))
|
|
|
|
(define (append-tracks! value tracks)
|
|
(let ((combined
|
|
(foldl
|
|
(λ (item result)
|
|
(if (findf (λ (existing)
|
|
(same-track? item existing))
|
|
result)
|
|
result
|
|
(append result (list item))))
|
|
(player-tracks value)
|
|
tracks)))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-tracks! value combined)
|
|
(save-current-tab! value)))))
|
|
|
|
(define (replace-tracks! value tracks)
|
|
(stop-playback! value)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-tracks! value tracks)
|
|
(set-player-current-index! value #f)
|
|
(save-current-tab! value))))
|
|
|
|
(define (drop-track! value index)
|
|
(unless (valid-track-index? value index)
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"track index is outside the playlist"
|
|
"index" index))
|
|
(when (equal? index (player-current-index value))
|
|
(stop-playback! value))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-tracks!
|
|
value
|
|
(append (take (player-tracks value) index)
|
|
(drop (player-tracks value) (+ index 1))))
|
|
(cond
|
|
((equal? index (player-current-index value))
|
|
(set-player-current-index! value #f))
|
|
((and (player-current-index value)
|
|
(< index (player-current-index value)))
|
|
(set-player-current-index!
|
|
value
|
|
(- (player-current-index value) 1))))
|
|
(save-current-tab! value))))
|
|
|
|
(define (move-track! value from-index to-index)
|
|
(unless (and (valid-track-index? value from-index)
|
|
(valid-track-index? value to-index))
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"track move indexes are outside the playlist"
|
|
"from" from-index
|
|
"to" to-index))
|
|
(unless (= from-index to-index)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(let* ((tracks (player-tracks value))
|
|
(item (list-ref tracks from-index))
|
|
(without
|
|
(append (take tracks from-index)
|
|
(drop tracks (+ from-index 1))))
|
|
(moved
|
|
(append (take without to-index)
|
|
(list item)
|
|
(drop without to-index)))
|
|
(current (player-current-index value)))
|
|
(set-player-tracks! value moved)
|
|
(when current
|
|
(cond
|
|
((= current from-index)
|
|
(set-player-current-index! value to-index))
|
|
((and (< from-index current)
|
|
(<= current to-index))
|
|
(set-player-current-index! value (- current 1)))
|
|
((and (<= to-index current)
|
|
(< current from-index))
|
|
(set-player-current-index! value (+ current 1)))))
|
|
(save-current-tab! value))))))
|
|
|
|
(define (select-tab! value index)
|
|
(unless (and (exact-nonnegative-integer? index)
|
|
(< index (length (player-tabs value))))
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"playlist tab does not exist"
|
|
"index" index))
|
|
(unless (= index (player-current-tab-index value))
|
|
(stop-playback! value)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(save-current-tab! value)
|
|
(set-player-current-tab-index! value index)
|
|
(set-player-tracks!
|
|
value
|
|
(playlist-tab-tracks (current-tab value)))
|
|
(set-player-current-index! value #f)))))
|
|
|
|
(define (add-tab! value)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(save-current-tab! value)
|
|
(let* ((tabs (player-tabs value))
|
|
(number (+ (length tabs) 1))
|
|
(tab
|
|
(playlist-tab
|
|
(format "tab-~a-~a"
|
|
(current-milliseconds)
|
|
(random 10000))
|
|
(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)))))
|
|
|
|
(define (rename-tab! value index name)
|
|
(unless (and (exact-nonnegative-integer? index)
|
|
(< index (length (player-tabs value))))
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"playlist tab does not exist"
|
|
"index" index))
|
|
(let ((trimmed (string-trim name)))
|
|
(when (string=? trimmed "")
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"playlist name cannot be empty"))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-playlist-tab-name!
|
|
(list-ref (player-tabs value) index)
|
|
trimmed)))))
|
|
|
|
(define (delete-tab! value index)
|
|
(when (= (length (player-tabs value)) 1)
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"the last playlist tab cannot be removed"))
|
|
(unless (and (exact-nonnegative-integer? index)
|
|
(< index (length (player-tabs value))))
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"playlist tab does not exist"
|
|
"index" index))
|
|
(stop-playback! value)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(save-current-tab! value)
|
|
(let* ((tabs
|
|
(append (take (player-tabs value) index)
|
|
(drop (player-tabs value) (+ index 1))))
|
|
(new-index
|
|
(min (player-current-tab-index value)
|
|
(- (length tabs) 1))))
|
|
(set-player-tabs! value tabs)
|
|
(set-player-current-tab-index! value new-index)
|
|
(set-player-tracks!
|
|
value
|
|
(playlist-tab-tracks (list-ref tabs new-index)))
|
|
(set-player-current-index! value #f)))))
|
|
|
|
(define (track->jsexpr item index)
|
|
(hasheq 'index index
|
|
'title (track-title item)
|
|
'artist (track-artist item)
|
|
'album (track-album item)
|
|
'duration (or (track-duration item) 'null)
|
|
'mimeType (track-mime-type item)
|
|
'artworkId (track-cache-key item)
|
|
'source (path->string
|
|
(or (file-name-from-path (track-file item))
|
|
(track-file item)))))
|
|
|
|
(define (renderer->jsexpr item)
|
|
(hasheq 'id (renderer-id item)
|
|
'name (renderer-name item)
|
|
'kind (symbol->string (renderer-kind item))))
|
|
|
|
(define (library->jsexpr library)
|
|
(hasheq 'id (music-library-id library)
|
|
'name (music-library-name library)))
|
|
|
|
(define (browser-entry->jsexpr entry index)
|
|
(hasheq 'index index
|
|
'name (browser-entry-name entry)
|
|
'kind (symbol->string (browser-entry-kind entry))))
|
|
|
|
(define (tab->jsexpr tab index)
|
|
(hasheq 'index index
|
|
'id (playlist-tab-id tab)
|
|
'name (playlist-tab-name tab)
|
|
'count (length (playlist-tab-tracks tab))))
|
|
|
|
(define (normal-device-id device)
|
|
(let ((id (upnp-device-udn device)))
|
|
(and id
|
|
(let ((match
|
|
(regexp-match
|
|
#px"(?i:RINCON_[0-9A-F]+)"
|
|
id)))
|
|
(if match
|
|
(string-upcase (car match))
|
|
(regexp-replace #px"(?i:^uuid:)" id ""))))))
|
|
|
|
(define (sonos-member? device member-ids)
|
|
(let ((id (normal-device-id device)))
|
|
(and id
|
|
(ormap (λ (member-id)
|
|
(string-ci=? id member-id))
|
|
member-ids))))
|
|
|
|
(define (discover-renderers)
|
|
(let* ((devices (query-upnp-devices 'all))
|
|
(media-renderers (filter media-renderer? devices))
|
|
(groups
|
|
(with-handlers
|
|
((exn:fail?
|
|
(λ (exception)
|
|
(warn-web-player
|
|
"Could not read Sonos topology: ~a"
|
|
(exn-message exception))
|
|
'())))
|
|
(sonos-groups devices)))
|
|
(member-ids
|
|
(append-map sonos-group-member-ids groups))
|
|
(upnp-renderers
|
|
(for/list ((device (in-list media-renderers))
|
|
#:unless (sonos-member? device member-ids))
|
|
(renderer
|
|
(format "upnp:~a"
|
|
(or (upnp-device-udn device)
|
|
(media-renderer-address device)))
|
|
(if (sonos-device? device)
|
|
(sonos-device-name device)
|
|
(media-renderer-name device))
|
|
'upnp
|
|
device)))
|
|
(sonos-renderers
|
|
(for/list ((group (in-list groups)))
|
|
(renderer
|
|
(format "sonos:~a" (sonos-group-id group))
|
|
(sonos-group-name group)
|
|
'sonos
|
|
(sonos-group-renderer group)))))
|
|
(sort (append upnp-renderers sonos-renderers)
|
|
string-ci<?
|
|
#:key renderer-name)))
|
|
|
|
(define (json-number data key [default #f])
|
|
(let ((value (hash-ref data key default)))
|
|
(if (number? value) value default)))
|
|
|
|
(define (json-string data key [default #f])
|
|
(let ((value (hash-ref data key default)))
|
|
(if (string? value) value default)))
|
|
|
|
(define (perform-library-command! value command data)
|
|
(let ((index (json-number data 'index #f)))
|
|
(cond
|
|
((string=? command "library")
|
|
(let* ((id (json-string data 'id #f))
|
|
(library (and id (library-by-id value id))))
|
|
(unless library
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"music library does not exist"
|
|
"id" id))
|
|
(refresh-browser! value library '())))
|
|
((string=? command "browse")
|
|
(let ((entry (entry-by-index value index)))
|
|
(unless (and entry
|
|
(eq? (browser-entry-kind entry) 'container))
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"library entry is not a directory"
|
|
"index" index))
|
|
(refresh-browser!
|
|
value
|
|
(current-library value)
|
|
(browser-entry-relative-path entry))))
|
|
((string=? command "up")
|
|
(unless (null? (player-browser-path value))
|
|
(refresh-browser!
|
|
value
|
|
(current-library value)
|
|
(drop-right (player-browser-path value) 1))))
|
|
((string=? command "item-play")
|
|
(let ((tracks (selected-entry-tracks value index)))
|
|
(when (null? tracks)
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"selected item contains no supported audio"))
|
|
(replace-tracks! value tracks)
|
|
(play-index! value 0)))
|
|
((string=? command "item-add")
|
|
(append-tracks!
|
|
value
|
|
(selected-entry-tracks value index))))))
|
|
|
|
(define (perform-playlist-command! value command data)
|
|
(let ((index (json-number data 'index #f)))
|
|
(cond
|
|
((string=? command "track-remove")
|
|
(drop-track! value index))
|
|
((string=? command "track-move")
|
|
(move-track! value
|
|
(json-number data 'from #f)
|
|
(json-number data 'to #f)))
|
|
((string=? command "playlist-clear")
|
|
(replace-tracks! value '()))
|
|
((string=? command "tab-add")
|
|
(stop-playback! value)
|
|
(add-tab! value))
|
|
((string=? command "tab-select")
|
|
(select-tab! value index))
|
|
((string=? command "tab-rename")
|
|
(rename-tab! value index
|
|
(or (json-string data 'name #f) "")))
|
|
((string=? command "tab-delete")
|
|
(delete-tab! value index)))))
|
|
|
|
(define (perform-command! value command data)
|
|
(cond
|
|
((member command '("library" "browse" "up"
|
|
"item-play" "item-add"))
|
|
(perform-library-command! value command data))
|
|
((member command '("track-remove" "track-move"
|
|
"playlist-clear" "tab-add"
|
|
"tab-select" "tab-rename"
|
|
"tab-delete"))
|
|
(perform-playlist-command! value command data))
|
|
((string=? command "play")
|
|
(play-index!
|
|
value
|
|
(or (json-number data 'index #f)
|
|
(player-current-index value)
|
|
0)))
|
|
((string=? command "pause")
|
|
(let ((backend (ensure-backend! value)))
|
|
(cond
|
|
((eq? (player-backend-kind value) 'local)
|
|
(audio-pause! backend #t))
|
|
((eq? (player-backend-kind value) 'agent)
|
|
(enqueue-agent-command! value backend "pause"))
|
|
(else
|
|
(dlna-player-pause! backend)))))
|
|
((string=? command "resume")
|
|
(let ((backend (ensure-backend! value)))
|
|
(cond
|
|
((eq? (player-backend-kind value) 'local)
|
|
(audio-pause! backend #f))
|
|
((eq? (player-backend-kind value) 'agent)
|
|
(enqueue-agent-command! value backend "resume"))
|
|
(else
|
|
(dlna-player-resume! backend)))))
|
|
((string=? command "stop")
|
|
(stop-playback! value))
|
|
((string=? command "next")
|
|
(let ((index (next-index value 1)))
|
|
(if index
|
|
(play-index! value index)
|
|
(stop-playback! value))))
|
|
((string=? command "previous")
|
|
(let ((index (next-index value -1)))
|
|
(when index
|
|
(play-index! value index))))
|
|
((string=? command "seek")
|
|
(let ((percentage (json-number data 'percentage #f)))
|
|
(unless percentage
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"seek requires a numeric percentage"))
|
|
(let ((backend (ensure-backend! value)))
|
|
(cond
|
|
((eq? (player-backend-kind value) 'local)
|
|
(audio-seek! backend percentage))
|
|
((eq? (player-backend-kind value) 'agent)
|
|
(enqueue-agent-command!
|
|
value backend "seek"
|
|
(hasheq 'percentage percentage)))
|
|
(else
|
|
(dlna-player-seek-percentage! backend percentage))))))
|
|
((string=? command "volume")
|
|
(let ((percentage (json-number data 'value #f)))
|
|
(unless percentage
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"volume requires a numeric value"))
|
|
(let* ((clamped (min 100 (max 0 percentage)))
|
|
(backend (ensure-backend! value)))
|
|
(cond
|
|
((eq? (player-backend-kind value) 'local)
|
|
(let ((logical-volume (/ clamped 100.0)))
|
|
(audio-volume!
|
|
backend
|
|
(* 100.0 logical-volume logical-volume))))
|
|
((eq? (player-backend-kind value) 'agent)
|
|
(enqueue-agent-command!
|
|
value backend "volume"
|
|
(hasheq 'value clamped)))
|
|
(else
|
|
(dlna-player-volume! backend clamped)))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-volume! value clamped))))))
|
|
((string=? command "repeat")
|
|
(let* ((name (json-string data 'mode "off"))
|
|
(mode (string->symbol name)))
|
|
(unless (member mode '(off all one))
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"repeat mode must be off, all, or one"
|
|
"mode" name))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-repeat! value mode)))))
|
|
((string=? command "renderer")
|
|
(let* ((id (json-string data 'id #f))
|
|
(selected (and id (renderer-by-id value id))))
|
|
(unless selected
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"renderer does not exist"
|
|
"id" id))
|
|
(unless (string=? id (player-selected-id value))
|
|
(close-backend! value)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-selected-id! value id))))))
|
|
(else
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"unknown player command"
|
|
"command" command))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Provided functions
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Create a player for lazily browsed music libraries.
|
|
; pre : Libraries are valid; allowed agent IDs are 256-bit hex strings.
|
|
; post : Only the selected root directory has been listed; no backend exists.
|
|
; result : A player that initially selects local playback.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (make-player libraries
|
|
#:allowed-agent-ids [allowed-agent-ids '()]
|
|
#:dlna-port [dlna-port 8734])
|
|
(define normalized-agent-ids
|
|
(for/list ((app-id (in-list allowed-agent-ids)))
|
|
(unless (valid-agent-id? app-id)
|
|
(raise-argument-error
|
|
'make-player
|
|
"64-character hexadecimal playback agent id"
|
|
app-id))
|
|
(string-downcase app-id)))
|
|
(let* ((library (and (pair? libraries) (car libraries)))
|
|
(browser-entries
|
|
(if library
|
|
(browse-library library '())
|
|
'()))
|
|
(tab (playlist-tab "default" "Default" '())))
|
|
(player libraries
|
|
(remove-duplicates normalized-agent-ids string=?)
|
|
'()
|
|
(and library (music-library-id library))
|
|
'()
|
|
browser-entries
|
|
'()
|
|
(list tab)
|
|
0
|
|
(list (renderer "local" "Server audio output" 'local #f))
|
|
"local"
|
|
#f
|
|
#f
|
|
#f
|
|
'stopped
|
|
0
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
#f
|
|
50
|
|
'off
|
|
#f
|
|
#f
|
|
#f
|
|
(make-semaphore 1)
|
|
(make-semaphore 1)
|
|
(make-hash)
|
|
dlna-port)))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Return the complete browser-visible player state.
|
|
; pre : Value was created with make-player.
|
|
; 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)))))
|
|
(hasheq
|
|
'libraries (map library->jsexpr
|
|
(player-libraries value))
|
|
'libraryId (or (player-current-library-id value) 'null)
|
|
'browser
|
|
(hasheq
|
|
'path (map path->string (player-browser-path value))
|
|
'canGoUp (not (null? (player-browser-path value)))
|
|
'entries
|
|
(for/list ((entry (in-list (player-browser-entries value)))
|
|
(index (in-naturals)))
|
|
(browser-entry->jsexpr entry index)))
|
|
'tabs
|
|
(for/list ((tab (in-list (player-tabs value)))
|
|
(index (in-naturals)))
|
|
(tab->jsexpr tab index))
|
|
'currentTab (player-current-tab-index value)
|
|
'tracks
|
|
(for/list ((item (in-list (player-tracks value)))
|
|
(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)
|
|
'state (symbol->string (player-state value))
|
|
'position (player-position value)
|
|
'duration (or (player-duration value) 'null)
|
|
'rate (or (player-rate value) 'null)
|
|
'channels (or (player-channels value) 'null)
|
|
'bits (or (player-bits value) 'null)
|
|
'format (if (player-decoder value)
|
|
(format "~a" (player-decoder value))
|
|
"")
|
|
'source (if current
|
|
(path->string
|
|
(or (file-name-from-path (track-file current))
|
|
(track-file current)))
|
|
"")
|
|
'volume (player-volume value)
|
|
'repeat (symbol->string (player-repeat value))
|
|
'discovering (player-discovering? value)
|
|
'error (or (player-error value) 'null))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Execute one browser player command.
|
|
; pre : Command is a string and data is a JSON object hash.
|
|
; post : The command has completed or a concrete exception is raised.
|
|
; result : The updated JSON-compatible player state.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (player-command! value command data)
|
|
(call-with-semaphore
|
|
(player-command-lock value)
|
|
(λ ()
|
|
(when (player-closed? value)
|
|
(raise-arguments-error
|
|
'player-command!
|
|
"player has been closed"))
|
|
(with-handlers
|
|
((exn:fail?
|
|
(λ (exception)
|
|
(set-error! value (exn-message exception))
|
|
(raise exception))))
|
|
(perform-command! value command data))
|
|
(player-state->jsexpr value))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Discover UPnP renderers and logical Sonos groups asynchronously.
|
|
; pre : Value was created with make-player.
|
|
; post : The renderer list is updated when discovery finishes.
|
|
; result : #t when discovery started, #f when it was already running.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (player-discover! value)
|
|
(let ((can-start?
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(if (player-discovering? value)
|
|
#f
|
|
(begin
|
|
(set-player-discovering?! value #t)
|
|
#t))))))
|
|
(when can-start?
|
|
(thread
|
|
(λ ()
|
|
(with-handlers
|
|
((exn:fail?
|
|
(λ (exception)
|
|
(set-error! value (exn-message exception)))))
|
|
(let ((found (discover-renderers)))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-renderers!
|
|
value
|
|
(append
|
|
(list (renderer "local"
|
|
"Server audio output"
|
|
'local
|
|
#f))
|
|
found
|
|
(filter (λ (item)
|
|
(eq? (renderer-kind item) 'agent))
|
|
(player-renderers value))))
|
|
(set-player-error! value #f)))))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-discovering?! value #f))))))
|
|
can-start?))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Register or refresh one polling playback agent.
|
|
; pre : Data contains an allowlisted 256-bit hexadecimal application id.
|
|
; post : The agent is available as a renderer under its advertised name.
|
|
; result : Agent configuration for the polling client.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (player-agent-register! value data)
|
|
(let* ((supplied-app-id (json-string data 'appId #f))
|
|
(app-id (normal-agent-id supplied-app-id))
|
|
(suggested-name
|
|
(string-trim
|
|
(or (json-string data 'name #f)
|
|
"RKT playback agent")))
|
|
(advertised-name
|
|
(if (string=? suggested-name "")
|
|
"RKT playback agent"
|
|
suggested-name)))
|
|
(unless app-id
|
|
(raise-arguments-error
|
|
'player-agent-register!
|
|
"appId must contain exactly 64 hexadecimal characters"
|
|
"appId" supplied-app-id))
|
|
(require-authorized-agent! value app-id)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(let ((existing (agent-by-id value app-id)))
|
|
(if existing
|
|
(begin
|
|
(set-playback-agent-name! existing advertised-name)
|
|
(let ((agent-output (agent-renderer value existing)))
|
|
(when agent-output
|
|
(set-renderer-name! agent-output advertised-name)))
|
|
(set-playback-agent-last-seen!
|
|
existing
|
|
(current-seconds))
|
|
(hasheq 'name (playback-agent-name existing)
|
|
'pollIntervalMs 1000))
|
|
(let* ((name advertised-name)
|
|
(agent
|
|
(playback-agent
|
|
app-id name (current-seconds)
|
|
(hasheq 'state "stopped"
|
|
'position 0
|
|
'volume 50)
|
|
'() 1 (make-hash) 0)))
|
|
(set-player-agents!
|
|
value
|
|
(append (player-agents value) (list agent)))
|
|
(set-player-renderers!
|
|
value
|
|
(append
|
|
(player-renderers value)
|
|
(list (renderer (agent-renderer-id app-id)
|
|
name
|
|
'agent
|
|
agent))))
|
|
(hasheq 'name name
|
|
'pollIntervalMs 1000))))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Accept agent state and return its oldest unacknowledged command.
|
|
; pre : The agent was registered with player-agent-register!.
|
|
; post : State, heartbeat, acknowledgements and end-of-track are incorporated.
|
|
; result : Poll response containing the current agent name and optional command.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (player-agent-poll! value data)
|
|
(let* ((supplied-app-id (json-string data 'appId #f))
|
|
(app-id (normal-agent-id supplied-app-id))
|
|
(name (json-string data 'name #f)))
|
|
(unless app-id
|
|
(raise-arguments-error
|
|
'player-agent-poll!
|
|
"appId must contain exactly 64 hexadecimal characters"
|
|
"appId" supplied-app-id))
|
|
(require-authorized-agent! value app-id)
|
|
(call-with-semaphore
|
|
(player-command-lock value)
|
|
(λ ()
|
|
(let ((agent (agent-by-id value app-id)))
|
|
(unless agent
|
|
(raise-arguments-error
|
|
'player-agent-poll!
|
|
"playback agent is not registered"
|
|
"appId" app-id))
|
|
(let* ((ack (json-number data 'ack #f))
|
|
(reported (hash-ref data 'state #f))
|
|
(ended (json-number data 'endedCounter 0))
|
|
(previous-ended
|
|
(playback-agent-ended-counter agent)))
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-playback-agent-last-seen! agent (current-seconds))
|
|
(when (and name
|
|
(not (string=? (string-trim name) "")))
|
|
(let ((trimmed (string-trim name))
|
|
(agent-output (agent-renderer value agent)))
|
|
(set-playback-agent-name! agent trimmed)
|
|
(when agent-output
|
|
(set-renderer-name! agent-output trimmed))))
|
|
(when (hash? reported)
|
|
(set-playback-agent-reported-state! agent reported))
|
|
(when (exact-nonnegative-integer? ack)
|
|
(for ((command (in-list (playback-agent-commands agent)))
|
|
#:when (<= (hash-ref command 'id) ack))
|
|
(let* ((command-data
|
|
(hash-ref command 'data (hasheq)))
|
|
(media-token
|
|
(hash-ref command-data 'mediaToken #f)))
|
|
(when (string? media-token)
|
|
(hash-remove! (playback-agent-media agent)
|
|
media-token))))
|
|
(set-playback-agent-commands!
|
|
agent
|
|
(filter
|
|
(λ (command)
|
|
(> (hash-ref command 'id) ack))
|
|
(playback-agent-commands agent))))
|
|
(when (exact-nonnegative-integer? ended)
|
|
(set-playback-agent-ended-counter! agent ended))))
|
|
(when (and (> ended previous-ended)
|
|
(string=? (player-selected-id value)
|
|
(agent-renderer-id app-id))
|
|
(eq? (player-backend value) agent))
|
|
(let ((index (next-index value 1)))
|
|
(if index
|
|
(play-index! value index)
|
|
(stop-playback! value))))
|
|
(hasheq
|
|
'name (playback-agent-name agent)
|
|
'command
|
|
(if (null? (playback-agent-commands agent))
|
|
'null
|
|
(car (playback-agent-commands agent))))))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Resolve the current opaque media token for one playback agent.
|
|
; pre : App id and token came from a play command returned by agent polling.
|
|
; post : No state changes.
|
|
; result : The local track path, or #f when the token is invalid or expired.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (player-agent-media value app-id token)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(let* ((normalized (normal-agent-id app-id))
|
|
(agent (and normalized
|
|
(authorized-agent-id? value normalized)
|
|
(agent-by-id value normalized))))
|
|
(and agent
|
|
(string? token)
|
|
(hash-ref (playback-agent-media agent) token #f))))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Resolve an opaque playlist artwork id.
|
|
; pre : Artwork id came from player-state->jsexpr.
|
|
; 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
|
|
value
|
|
(λ ()
|
|
(findf (λ (candidate)
|
|
(string=? (track-cache-key candidate) artwork-id))
|
|
(player-tracks value))))))
|
|
(and item (track-artwork item))))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
; goal : Stop playback and release all player resources.
|
|
; pre : Value was created with make-player.
|
|
; post : The active backend is closed; repeated calls are harmless.
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
(define (player-close! value)
|
|
(call-with-semaphore
|
|
(player-command-lock value)
|
|
(λ ()
|
|
(unless (player-closed? value)
|
|
(close-backend! value)
|
|
(with-state-lock
|
|
value
|
|
(λ ()
|
|
(set-player-closed?! value #t)))))))
|
|
|
|
(module+ test
|
|
(require rackunit
|
|
racket/file)
|
|
|
|
(define root
|
|
(make-temporary-file "rkt-web-player-~a" 'directory))
|
|
|
|
(dynamic-wind
|
|
void
|
|
(λ ()
|
|
(make-directory (build-path root "Album"))
|
|
(let* ((libraries (make-music-libraries (list root)))
|
|
(test-agent-id (make-string 64 #\a))
|
|
(example-player
|
|
(make-player libraries
|
|
#:allowed-agent-ids (list test-agent-id)))
|
|
(initial-state
|
|
(player-state->jsexpr example-player)))
|
|
(check-equal? (hash-ref initial-state 'state) "stopped")
|
|
(check-equal? (hash-ref initial-state 'rendererId) "local")
|
|
(check-equal? (length (hash-ref initial-state 'libraries)) 1)
|
|
(check-equal?
|
|
(length (hash-ref (hash-ref initial-state 'browser) 'entries))
|
|
1)
|
|
(check-equal? (length (hash-ref initial-state 'tracks)) 0)
|
|
|
|
(define browsed-state
|
|
(player-command!
|
|
example-player
|
|
"browse"
|
|
(hasheq 'index 0)))
|
|
|
|
(check-equal?
|
|
(hash-ref (hash-ref browsed-state 'browser) 'path)
|
|
'("Album"))
|
|
(check-true
|
|
(hash-ref (hash-ref browsed-state 'browser) 'canGoUp))
|
|
|
|
(define root-state
|
|
(player-command! example-player "up" (hasheq)))
|
|
|
|
(check-equal?
|
|
(hash-ref (hash-ref root-state 'browser) 'path)
|
|
'())
|
|
|
|
(define repeat-state
|
|
(player-command!
|
|
example-player
|
|
"repeat"
|
|
(hasheq 'mode "all")))
|
|
|
|
(check-equal? (hash-ref repeat-state 'repeat) "all")
|
|
|
|
(define tab-state
|
|
(player-command!
|
|
example-player
|
|
"tab-add"
|
|
(hasheq)))
|
|
|
|
(check-equal? (length (hash-ref tab-state 'tabs)) 2)
|
|
(check-equal? (hash-ref tab-state 'currentTab) 1)
|
|
|
|
(define renamed-state
|
|
(player-command!
|
|
example-player
|
|
"tab-rename"
|
|
(hasheq 'index 1 'name "Favorieten")))
|
|
|
|
(check-equal?
|
|
(hash-ref (list-ref (hash-ref renamed-state 'tabs) 1) 'name)
|
|
"Favorieten")
|
|
|
|
(define deleted-state
|
|
(player-command!
|
|
example-player
|
|
"tab-delete"
|
|
(hasheq 'index 1)))
|
|
|
|
(check-equal? (length (hash-ref deleted-state 'tabs)) 1)
|
|
|
|
(define registration
|
|
(player-agent-register!
|
|
example-player
|
|
(hasheq 'appId test-agent-id
|
|
'name "Test laptop")))
|
|
|
|
(check-equal? (hash-ref registration 'name) "Test laptop")
|
|
(check-exn
|
|
exn:fail:agent-denied?
|
|
(λ ()
|
|
(player-agent-register!
|
|
example-player
|
|
(hasheq 'appId (make-string 64 #\b)
|
|
'name "Unknown laptop"))))
|
|
|
|
(define agent-renderer-state
|
|
(player-command!
|
|
example-player
|
|
"renderer"
|
|
(hasheq 'id (agent-renderer-id test-agent-id))))
|
|
|
|
(check-equal?
|
|
(hash-ref agent-renderer-state 'rendererId)
|
|
(agent-renderer-id test-agent-id))
|
|
|
|
(player-command!
|
|
example-player
|
|
"volume"
|
|
(hasheq 'value 25))
|
|
|
|
(define first-poll
|
|
(player-agent-poll!
|
|
example-player
|
|
(hasheq 'appId test-agent-id
|
|
'ack 0
|
|
'endedCounter 0
|
|
'state
|
|
(hasheq 'state "stopped"
|
|
'position 0
|
|
'volume 25))))
|
|
|
|
(check-equal?
|
|
(hash-ref (hash-ref first-poll 'command) 'action)
|
|
"volume")
|
|
|
|
(define first-command-id
|
|
(hash-ref (hash-ref first-poll 'command) 'id))
|
|
|
|
(define acknowledged-poll
|
|
(player-agent-poll!
|
|
example-player
|
|
(hasheq 'appId test-agent-id
|
|
'ack first-command-id
|
|
'endedCounter 0
|
|
'state
|
|
(hasheq 'state "stopped"
|
|
'position 0
|
|
'volume 25))))
|
|
|
|
(check-eq? (hash-ref acknowledged-poll 'command) 'null)
|
|
|
|
(check-equal?
|
|
(hash-ref
|
|
(player-agent-register!
|
|
example-player
|
|
(hasheq 'appId test-agent-id
|
|
'name "Office laptop"))
|
|
'name)
|
|
"Office laptop")
|
|
(check-equal?
|
|
(renderer-name
|
|
(findf
|
|
(λ (item)
|
|
(string=? (renderer-id item)
|
|
(agent-renderer-id test-agent-id)))
|
|
(player-renderers example-player)))
|
|
"Office laptop")
|
|
|
|
(define first-file (build-path root "Album" "01.flac"))
|
|
(define second-file (build-path root "Album" "02.flac"))
|
|
(call-with-output-file first-file void #:exists 'truncate/replace)
|
|
(call-with-output-file second-file void #:exists 'truncate/replace)
|
|
(set-player-tracks!
|
|
example-player
|
|
(list (track first-file "First" "Artist" "Album" 60 "audio/flac")
|
|
(track second-file "Second" "Artist" "Album" 60 "audio/flac")))
|
|
|
|
(player-command! example-player "play" (hasheq 'index 0))
|
|
(define play-poll
|
|
(player-agent-poll!
|
|
example-player
|
|
(hasheq 'appId test-agent-id
|
|
'ack first-command-id
|
|
'endedCounter 0
|
|
'state (hasheq 'state "starting" 'position 0))))
|
|
(define play-command (hash-ref play-poll 'command))
|
|
(check-equal? (hash-ref play-command 'action) "play")
|
|
(check-equal?
|
|
(hash-ref (hash-ref play-command 'data) 'trackNumber)
|
|
1)
|
|
(check-equal?
|
|
(player-agent-media
|
|
example-player
|
|
test-agent-id
|
|
(hash-ref (hash-ref play-command 'data) 'mediaToken))
|
|
first-file)
|
|
|
|
(define prefetch-poll
|
|
(player-agent-poll!
|
|
example-player
|
|
(hasheq 'appId test-agent-id
|
|
'ack (hash-ref play-command 'id)
|
|
'endedCounter 0
|
|
'state (hasheq 'state "playing" 'position 1))))
|
|
(define prefetch-command (hash-ref prefetch-poll 'command))
|
|
(check-equal? (hash-ref prefetch-command 'action) "prefetch")
|
|
(check-equal?
|
|
(hash-ref (hash-ref prefetch-command 'data) 'trackNumber)
|
|
2)
|
|
(check-equal?
|
|
(player-agent-media
|
|
example-player
|
|
test-agent-id
|
|
(hash-ref (hash-ref prefetch-command 'data) 'mediaToken))
|
|
second-file)
|
|
|
|
(check-exn exn:fail?
|
|
(λ ()
|
|
(player-command!
|
|
example-player
|
|
"unknown"
|
|
(hasheq))))
|
|
(player-close! example-player)))
|
|
(λ ()
|
|
(delete-directory/files root))))
|