refactoring
This commit is contained in:
+320
-212
@@ -43,81 +43,107 @@
|
||||
lock)
|
||||
#:transparent)
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Supporting functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(define playback-start-timeout-ms 8000)
|
||||
|
||||
;;; Returns the current time used to measure renderer start delays.
|
||||
(define (now-ms)
|
||||
(current-inexact-milliseconds))
|
||||
|
||||
;;; Maps renderer-specific transport states to the web player's states.
|
||||
(define (normalize-state state)
|
||||
(cond
|
||||
((eq? state 'transitioning) 'starting)
|
||||
((member state '(initialized no-media)) 'stopped)
|
||||
(else state)))
|
||||
|
||||
;;; Determines whether state or position confirms that playback has started.
|
||||
;; Position reporting is optional and notably unreliable on some Denon
|
||||
;; renderers. PLAYING, TRANSITIONING or PAUSED is itself confirmation that the
|
||||
;; renderer accepted the transport. A positive position remains useful for
|
||||
;; devices whose transport state lags behind their position response.
|
||||
(define (renderer-confirms-playback? state position)
|
||||
(or (and (member state '(playing starting paused)) #t)
|
||||
(and (number? position) (> position 0))))
|
||||
(cond
|
||||
((member state '(playing starting paused)) #t)
|
||||
((and (number? position) (> position 0)) #t)
|
||||
(else #f)))
|
||||
|
||||
;;; Runs a playback operation while holding its synchronization lock.
|
||||
(define (with-lock playback proc)
|
||||
(call-with-semaphore (dlna-playback-lock playback) proc))
|
||||
|
||||
;;; Reads the current playlist through the callback supplied by the owner.
|
||||
(define (current-tracks playback)
|
||||
((dlna-playback-tracks playback)))
|
||||
|
||||
;;; Checks whether index identifies a track in the current playlist.
|
||||
(define (valid-index? playback index)
|
||||
(and (exact-nonnegative-integer? index)
|
||||
(< index (length (current-tracks playback)))))
|
||||
|
||||
;;; Returns the track at index, or #f when the index is invalid.
|
||||
(define (track-at playback index)
|
||||
(and (valid-index? playback index)
|
||||
(list-ref (current-tracks playback) index)))
|
||||
(if (valid-index? playback index)
|
||||
(list-ref (current-tracks playback) index)
|
||||
#f))
|
||||
|
||||
;;; Produces a complete path string for stable renderer file comparison.
|
||||
(define (normalized-file file)
|
||||
(with-handlers ((exn:fail? (λ (_) (format "~a" file))))
|
||||
(path->string (path->complete-path file))))
|
||||
|
||||
;;; Compares two track files using the path rules of the current platform.
|
||||
(define (same-file? first second)
|
||||
(and first
|
||||
second
|
||||
((if (eq? (system-type 'os) 'windows)
|
||||
string-ci=?
|
||||
string=?)
|
||||
(normalized-file first)
|
||||
(normalized-file second))))
|
||||
|
||||
(define (next-index playback index)
|
||||
(define count (length (current-tracks playback)))
|
||||
(cond
|
||||
((zero? count) #f)
|
||||
((eq? (dlna-playback-repeat playback) 'one) index)
|
||||
((< (+ index 1) count) (+ index 1))
|
||||
((eq? (dlna-playback-repeat playback) 'all) 0)
|
||||
(else #f)))
|
||||
|
||||
(define (track-index-for-info playback info)
|
||||
(define info-track (dlna-info-track info))
|
||||
(define file (and info-track (dlna-track-info-file info-track)))
|
||||
(define prepared (dlna-playback-prepared-index playback))
|
||||
(cond
|
||||
((and (valid-index? playback prepared)
|
||||
(same-file? file (track-file (track-at playback prepared))))
|
||||
prepared)
|
||||
((eq? first #f) #f)
|
||||
((eq? second #f) #f)
|
||||
(else
|
||||
(for/first ((item (in-list (current-tracks playback)))
|
||||
(index (in-naturals))
|
||||
#:when (same-file? file (track-file item)))
|
||||
index))))
|
||||
(let ((same-path? (if (eq? (system-type 'os) 'windows)
|
||||
string-ci=?
|
||||
string=?)))
|
||||
(same-path? (normalized-file first)
|
||||
(normalized-file second))))))
|
||||
|
||||
;;; Selects the following playlist index according to the repeat setting.
|
||||
(define (next-index playback index)
|
||||
(let ((count (length (current-tracks playback))))
|
||||
(cond
|
||||
((zero? count) #f)
|
||||
((eq? (dlna-playback-repeat playback) 'one) index)
|
||||
((< (+ index 1) count) (+ index 1))
|
||||
((eq? (dlna-playback-repeat playback) 'all) 0)
|
||||
(else #f))))
|
||||
|
||||
;;; Finds the playlist index represented by renderer metadata.
|
||||
;;; A prepared index is checked first before searching the complete playlist.
|
||||
(define (track-index-for-info playback info)
|
||||
(let* ((info-track (dlna-info-track info))
|
||||
(file (if (eq? info-track #f)
|
||||
#f
|
||||
(dlna-track-info-file info-track)))
|
||||
(prepared (dlna-playback-prepared-index playback)))
|
||||
(if (and (valid-index? playback prepared)
|
||||
(same-file? file (track-file (track-at playback prepared))))
|
||||
prepared
|
||||
(let loop ((remaining (current-tracks playback))
|
||||
(index 0))
|
||||
(cond
|
||||
((null? remaining) #f)
|
||||
((same-file? file (track-file (car remaining))) index)
|
||||
(else
|
||||
(loop (cdr remaining) (add1 index))))))))
|
||||
|
||||
;;; Sends the current playback state and renderer information to the owner.
|
||||
(define (notify! playback state info)
|
||||
((dlna-playback-update playback)
|
||||
state
|
||||
(dlna-playback-current-index playback)
|
||||
info))
|
||||
|
||||
;;; Records a playback failure and forwards its detail to the error callback.
|
||||
(define (report-failure! playback detail)
|
||||
(set-dlna-playback-playing-seen?! playback #f)
|
||||
(set-dlna-playback-progress-seen?! playback #f)
|
||||
@@ -126,159 +152,169 @@
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
((dlna-playback-error playback) detail))
|
||||
|
||||
;;; Prepares the next track on renderers that support gapless continuation.
|
||||
(define (prepare-next! playback)
|
||||
(define current (dlna-playback-current-index playback))
|
||||
(when (valid-index? playback current)
|
||||
(define following (next-index playback current))
|
||||
(cond
|
||||
((not following)
|
||||
(set-dlna-playback-prepared-index! playback #f))
|
||||
((not (equal? following (dlna-playback-prepared-index playback)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(warn-web-player-dlna
|
||||
"Could not prepare next DLNA track: ~a"
|
||||
(exn-message exception)))))
|
||||
(dlna-player-set-next-file!
|
||||
(dlna-playback-player playback)
|
||||
(track-file (track-at playback following)))
|
||||
(set-dlna-playback-prepared-index! playback following))))))
|
||||
(let ((current (dlna-playback-current-index playback)))
|
||||
(when (valid-index? playback current)
|
||||
(let ((following (next-index playback current)))
|
||||
(cond
|
||||
((eq? following #f)
|
||||
(set-dlna-playback-prepared-index! playback #f))
|
||||
((not (equal? following (dlna-playback-prepared-index playback)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(warn-web-player-dlna
|
||||
"Could not prepare next DLNA track: ~a"
|
||||
(exn-message exception)))))
|
||||
(dlna-player-set-next-file!
|
||||
(dlna-playback-player playback)
|
||||
(track-file (track-at playback following)))
|
||||
(set-dlna-playback-prepared-index! playback following))))))))
|
||||
|
||||
;;; Starts one playlist item while the caller holds the playback lock.
|
||||
(define (play-index/locked! playback index)
|
||||
(define item (track-at playback index))
|
||||
(unless item
|
||||
(raise-arguments-error
|
||||
'dlna-playback-play-index!
|
||||
"track index is outside the playlist"
|
||||
"index" index))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(report-failure! playback (exn-message exception))
|
||||
(raise exception))))
|
||||
(dlna-player-play! (dlna-playback-player playback) (track-file item))
|
||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
||||
(set-dlna-playback-current-index! playback index)
|
||||
(set-dlna-playback-current-uri! playback (dlna-info-uri info))
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(set-dlna-playback-playing-seen?! playback #t)
|
||||
(set-dlna-playback-progress-seen?! playback #f)
|
||||
(set-dlna-playback-failure-active?! playback #f)
|
||||
(set-dlna-playback-play-request-ms! playback (now-ms))
|
||||
(set-dlna-playback-stop-requested?! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
(notify! playback 'starting info)
|
||||
(prepare-next! playback)))
|
||||
(let ((item (track-at playback index)))
|
||||
(unless item
|
||||
(raise-arguments-error
|
||||
'dlna-playback-play-index!
|
||||
"track index is outside the playlist"
|
||||
"index" index))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(λ (exception)
|
||||
(report-failure! playback (exn-message exception))
|
||||
(raise exception))))
|
||||
(dlna-player-play! (dlna-playback-player playback) (track-file item))
|
||||
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||
(set-dlna-playback-current-index! playback index)
|
||||
(set-dlna-playback-current-uri! playback (dlna-info-uri info))
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(set-dlna-playback-playing-seen?! playback #t)
|
||||
(set-dlna-playback-progress-seen?! playback #f)
|
||||
(set-dlna-playback-failure-active?! playback #f)
|
||||
(set-dlna-playback-play-request-ms! playback (now-ms))
|
||||
(set-dlna-playback-stop-requested?! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
(notify! playback 'starting info)
|
||||
(prepare-next! playback)))))
|
||||
|
||||
;;; Updates the current index when renderer metadata identifies another track.
|
||||
(define (update-current-track! playback info)
|
||||
(define index (track-index-for-info playback info))
|
||||
(when (valid-index? playback index)
|
||||
(unless (equal? index (dlna-playback-current-index playback))
|
||||
(set-dlna-playback-progress-seen?! playback #f)
|
||||
(set-dlna-playback-play-request-ms! playback (now-ms)))
|
||||
(set-dlna-playback-current-index! playback index)
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(prepare-next! playback)))
|
||||
(let ((index (track-index-for-info playback info)))
|
||||
(when (valid-index? playback index)
|
||||
(unless (equal? index (dlna-playback-current-index playback))
|
||||
(set-dlna-playback-progress-seen?! playback #f)
|
||||
(set-dlna-playback-play-request-ms! playback (now-ms)))
|
||||
(set-dlna-playback-current-index! playback index)
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(prepare-next! playback))))
|
||||
|
||||
;;; Advances to the next track or stops when the playlist has ended.
|
||||
(define (advance! playback)
|
||||
(define current (dlna-playback-current-index playback))
|
||||
(define following (and (valid-index? playback current)
|
||||
(next-index playback current)))
|
||||
(if following
|
||||
(play-index/locked! playback following)
|
||||
(begin
|
||||
(dlna-player-stop! (dlna-playback-player playback))
|
||||
(notify! playback
|
||||
'stopped
|
||||
(dlna-player-info (dlna-playback-player playback))))))
|
||||
(let* ((current (dlna-playback-current-index playback))
|
||||
(following (if (valid-index? playback current)
|
||||
(next-index playback current)
|
||||
#f)))
|
||||
(if (eq? following #f)
|
||||
(begin
|
||||
(dlna-player-stop! (dlna-playback-player playback))
|
||||
(notify! playback
|
||||
'stopped
|
||||
(dlna-player-info (dlna-playback-player playback))))
|
||||
(play-index/locked! playback following))))
|
||||
|
||||
(define (poll/locked! playback)
|
||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
||||
(cond
|
||||
((not (dlna-info-reachable? info))
|
||||
(when (dlna-playback-reachable? playback)
|
||||
(set-dlna-playback-reachable?! playback #f)
|
||||
((dlna-playback-error playback) "De DLNA-renderer is niet bereikbaar")))
|
||||
(else
|
||||
(set-dlna-playback-reachable?! playback #t)
|
||||
(define state (normalize-state (dlna-info-state info)))
|
||||
(define uri (dlna-info-uri info))
|
||||
(define position (dlna-info-position info))
|
||||
(define failed-now? #f)
|
||||
|
||||
(when (and (string? uri)
|
||||
(not (string=? uri ""))
|
||||
(not (equal? uri (dlna-playback-current-uri playback))))
|
||||
(set-dlna-playback-current-uri! playback uri)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
(update-current-track! playback info))
|
||||
|
||||
(when (renderer-confirms-playback? state position)
|
||||
(set-dlna-playback-progress-seen?! playback #t))
|
||||
|
||||
(when (and (dlna-playback-playing-seen? playback)
|
||||
(not (dlna-playback-progress-seen? playback))
|
||||
(dlna-playback-play-request-ms playback)
|
||||
(>= (- (now-ms)
|
||||
(dlna-playback-play-request-ms playback))
|
||||
playback-start-timeout-ms))
|
||||
(set! failed-now? #t)
|
||||
(warn-web-player-dlna
|
||||
"DLNA start was not confirmed: state=~a position=~a uri=~a"
|
||||
state position (or uri ""))
|
||||
(report-failure!
|
||||
playback
|
||||
"De DLNA-renderer bevestigde de start van de track niet"))
|
||||
|
||||
(unless (or failed-now? (dlna-playback-failure-active? playback))
|
||||
;;; Processes one successful renderer poll while the playback lock is held.
|
||||
;;; It updates track identity, start confirmation and end-of-track handling.
|
||||
(define (poll-reachable/locked! playback info)
|
||||
(let ((state (normalize-state (dlna-info-state info)))
|
||||
(uri (dlna-info-uri info))
|
||||
(position (dlna-info-position info)))
|
||||
(set-dlna-playback-reachable?! playback #t)
|
||||
(when (and (string? uri)
|
||||
(not (string=? uri ""))
|
||||
(not (equal? uri (dlna-playback-current-uri playback))))
|
||||
(set-dlna-playback-current-uri! playback uri)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
(update-current-track! playback info))
|
||||
(when (renderer-confirms-playback? state position)
|
||||
(set-dlna-playback-progress-seen?! playback #t))
|
||||
(let* ((request-ms (dlna-playback-play-request-ms playback))
|
||||
(elapsed-ms (if (eq? request-ms #f)
|
||||
#f
|
||||
(- (now-ms) request-ms)))
|
||||
(failed-now?
|
||||
(and (dlna-playback-playing-seen? playback)
|
||||
(not (dlna-playback-progress-seen? playback))
|
||||
elapsed-ms
|
||||
(>= elapsed-ms playback-start-timeout-ms))))
|
||||
;;; Handles a stopped renderer after start and progress checks complete.
|
||||
(define (handle-stopped!)
|
||||
(cond
|
||||
((and (not (dlna-playback-progress-seen? playback))
|
||||
elapsed-ms
|
||||
(< elapsed-ms 5000))
|
||||
(void))
|
||||
((not (dlna-playback-progress-seen? playback))
|
||||
(warn-web-player-dlna
|
||||
"DLNA renderer stopped without confirming playback: position=~a uri=~a"
|
||||
position (or uri ""))
|
||||
(report-failure!
|
||||
playback
|
||||
'dlna-renderer-no-start-of-track-confirmation))
|
||||
(else
|
||||
(set-dlna-playback-stopped-polls!
|
||||
playback
|
||||
(+ 1 (dlna-playback-stopped-polls playback)))
|
||||
;; Give SetNextAVTransportURI one poll to take over. Some renderers
|
||||
;; need the explicit fallback on the next poll.
|
||||
(when (or (eq? (dlna-playback-prepared-index playback) #f)
|
||||
(> (dlna-playback-stopped-polls playback) 1))
|
||||
(set-dlna-playback-playing-seen?! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
(advance! playback)))))
|
||||
(when failed-now?
|
||||
(warn-web-player-dlna
|
||||
"DLNA start was not confirmed: state=~a position=~a uri=~a"
|
||||
state position (or uri ""))
|
||||
(report-failure!
|
||||
playback
|
||||
'dlna-renderer-no-start-of-track-confirmation))
|
||||
(unless (or failed-now? (dlna-playback-failure-active? playback))
|
||||
(cond
|
||||
((eq? state 'playing)
|
||||
(set-dlna-playback-playing-seen?! playback #t)
|
||||
(set-dlna-playback-stopped-polls! playback 0))
|
||||
((and (eq? state 'stopped)
|
||||
(dlna-playback-stop-requested? playback))
|
||||
(set-dlna-playback-stop-requested?! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0))
|
||||
((and (eq? state 'stopped)
|
||||
(dlna-playback-playing-seen? playback))
|
||||
(handle-stopped!))))
|
||||
(notify!
|
||||
playback
|
||||
(cond
|
||||
((eq? state 'playing)
|
||||
(set-dlna-playback-playing-seen?! playback #t)
|
||||
(set-dlna-playback-stopped-polls! playback 0))
|
||||
((and (eq? state 'stopped)
|
||||
(dlna-playback-stop-requested? playback))
|
||||
(set-dlna-playback-stop-requested?! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0))
|
||||
((and (eq? state 'stopped)
|
||||
(dlna-playback-playing-seen? playback))
|
||||
(cond
|
||||
((and (not (dlna-playback-progress-seen? playback))
|
||||
(dlna-playback-play-request-ms playback)
|
||||
(< (- (now-ms)
|
||||
(dlna-playback-play-request-ms playback))
|
||||
5000))
|
||||
(void))
|
||||
((not (dlna-playback-progress-seen? playback))
|
||||
(warn-web-player-dlna
|
||||
"DLNA renderer stopped without confirming playback: position=~a uri=~a"
|
||||
position (or uri ""))
|
||||
(report-failure!
|
||||
playback
|
||||
"De DLNA-renderer bevestigde de start van de track niet"))
|
||||
(else
|
||||
(set-dlna-playback-stopped-polls!
|
||||
playback
|
||||
(+ 1 (dlna-playback-stopped-polls playback)))
|
||||
;; Give SetNextAVTransportURI one poll to take over. Some
|
||||
;; renderers need the explicit fallback on the following poll.
|
||||
(when (or (not (dlna-playback-prepared-index playback))
|
||||
(> (dlna-playback-stopped-polls playback) 1))
|
||||
(set-dlna-playback-playing-seen?! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
(advance! playback)))))))
|
||||
((or failed-now? (dlna-playback-failure-active? playback))
|
||||
'stopped)
|
||||
((and (dlna-playback-playing-seen? playback)
|
||||
(not (dlna-playback-progress-seen? playback)))
|
||||
'starting)
|
||||
(else state))
|
||||
info))))
|
||||
|
||||
(notify!
|
||||
playback
|
||||
(cond
|
||||
((or failed-now? (dlna-playback-failure-active? playback)) 'stopped)
|
||||
((and (dlna-playback-playing-seen? playback)
|
||||
(not (dlna-playback-progress-seen? playback)))
|
||||
'starting)
|
||||
(else state))
|
||||
info))))
|
||||
;;; Polls the renderer and reports a transition to an unreachable state once.
|
||||
(define (poll/locked! playback)
|
||||
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||
(if (dlna-info-reachable? info)
|
||||
(poll-reachable/locked! playback info)
|
||||
(when (dlna-playback-reachable? playback)
|
||||
(set-dlna-playback-reachable?! playback #f)
|
||||
((dlna-playback-error playback)
|
||||
'dlna-renderer-unreachable)))))
|
||||
|
||||
;;; Polls the renderer until playback is closed, logging recoverable failures.
|
||||
(define (monitor-loop playback poll-seconds)
|
||||
(let loop ()
|
||||
(when (dlna-playback-running? playback)
|
||||
@@ -293,12 +329,21 @@
|
||||
(with-lock playback (λ () (poll/locked! playback))))
|
||||
(loop)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Provided functions
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Create playlist-aware playback for one network renderer.
|
||||
; pre : Device is a media renderer, callbacks are procedures, and
|
||||
; media-server is a running shared media-file-server.
|
||||
; post : A DLNA player and its state-monitor thread are running.
|
||||
; result : A playback adapter that publishes through the supplied server.
|
||||
; internals: make-dlna-player creates the renderer interface; monitor-loop polls
|
||||
; it periodically. poll/locked! reconciles URI, transport state and
|
||||
; position with the playlist and reports updates, failures or track
|
||||
; advancement. with-lock orders polls and commands using the
|
||||
; dlna-playback-lock accessor generated for the struct's lock field.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (make-dlna-playback device
|
||||
tracks
|
||||
@@ -306,21 +351,34 @@
|
||||
error
|
||||
#:media-file-server media-server
|
||||
#:poll-seconds [poll-seconds 1])
|
||||
(define raw
|
||||
(make-dlna-player device
|
||||
#:media-file-server media-server))
|
||||
(define playback
|
||||
(dlna-playback raw tracks update error 'off #f #f #f
|
||||
#f #f #f #f 0 #f #t #t #f
|
||||
(make-semaphore 1)))
|
||||
(set-dlna-playback-monitor!
|
||||
playback
|
||||
(thread (λ () (monitor-loop playback poll-seconds))))
|
||||
playback)
|
||||
(let* ((raw (make-dlna-player device
|
||||
#:media-file-server media-server))
|
||||
(playback
|
||||
(dlna-playback raw tracks update error 'off #f #f #f
|
||||
#f #f #f #f 0 #f #t #t #f
|
||||
(make-semaphore 1))))
|
||||
(set-dlna-playback-monitor!
|
||||
playback
|
||||
(thread (λ () (monitor-loop playback poll-seconds))))
|
||||
playback))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Start the track at index in the current playlist.
|
||||
; pre : Playback is open and index identifies an existing track.
|
||||
; post : The renderer starts the track and the next track is prepared.
|
||||
; result : The result of the synchronized playback operation.
|
||||
; internals: Playback state changes and callbacks run while holding the lock.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-play-index! playback index)
|
||||
(with-lock playback (λ () (play-index/locked! playback index))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Pause the current renderer transport.
|
||||
; pre : Playback is open and the renderer accepts pause requests.
|
||||
; post : The renderer is paused and listeners receive the new state.
|
||||
; result : The result of the synchronized playback operation.
|
||||
; internals: The renderer is queried immediately after the pause request.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-pause! playback)
|
||||
(with-lock
|
||||
playback
|
||||
@@ -328,6 +386,13 @@
|
||||
(dlna-player-pause! (dlna-playback-player playback))
|
||||
(notify! playback 'paused (dlna-player-info (dlna-playback-player playback))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Resume the paused renderer transport.
|
||||
; pre : Playback is open and the renderer accepts resume requests.
|
||||
; post : The renderer is playing and listeners receive the new state.
|
||||
; result : The result of the synchronized playback operation.
|
||||
; internals: The renderer is queried immediately after the resume request.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-resume! playback)
|
||||
(with-lock
|
||||
playback
|
||||
@@ -335,6 +400,13 @@
|
||||
(dlna-player-resume! (dlna-playback-player playback))
|
||||
(notify! playback 'playing (dlna-player-info (dlna-playback-player playback))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Stop the current renderer transport.
|
||||
; pre : Playback is open.
|
||||
; post : Pending start and failure state is cleared and listeners see stopped.
|
||||
; result : The result of the synchronized playback operation.
|
||||
; internals: stop-requested? distinguishes this stop from a finished track.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-stop! playback)
|
||||
(with-lock
|
||||
playback
|
||||
@@ -348,6 +420,13 @@
|
||||
(dlna-player-stop! (dlna-playback-player playback))
|
||||
(notify! playback 'stopped (dlna-player-info (dlna-playback-player playback))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Seek to a percentage of the current track.
|
||||
; pre : Playback is open and percentage is accepted by the DLNA player.
|
||||
; post : The renderer position and listener state reflect the requested seek.
|
||||
; result : The result of the synchronized playback operation.
|
||||
; internals: The synchronously refreshed DLNA cache is published immediately.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-seek-percentage! playback percentage)
|
||||
(with-lock
|
||||
playback
|
||||
@@ -355,21 +434,35 @@
|
||||
(dlna-player-seek-percentage! (dlna-playback-player playback) percentage)
|
||||
;; racket-audio-dlna updates its cache synchronously after Seek. Publish
|
||||
;; that value immediately so the web slider does not jump back.
|
||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
||||
(notify! playback
|
||||
(normalize-state (dlna-info-state info))
|
||||
info))))
|
||||
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||
(notify! playback
|
||||
(normalize-state (dlna-info-state info))
|
||||
info)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Set the renderer volume to a percentage.
|
||||
; pre : Playback is open and percentage is accepted by the DLNA player.
|
||||
; post : The renderer volume and listener state reflect the requested value.
|
||||
; result : The result of the synchronized playback operation.
|
||||
; internals: The renderer is queried immediately after changing the volume.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-volume! playback percentage)
|
||||
(with-lock
|
||||
playback
|
||||
(λ ()
|
||||
(dlna-player-volume! (dlna-playback-player playback) percentage)
|
||||
(define info (dlna-player-info (dlna-playback-player playback)))
|
||||
(notify! playback
|
||||
(normalize-state (dlna-info-state info))
|
||||
info))))
|
||||
(let ((info (dlna-player-info (dlna-playback-player playback))))
|
||||
(notify! playback
|
||||
(normalize-state (dlna-info-state info))
|
||||
info)))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Change playlist repeat behavior.
|
||||
; pre : Playback is open and repeat is 'off, 'one or 'all.
|
||||
; post : The next prepared track reflects the new repeat behavior.
|
||||
; result : The result of the synchronized playback operation.
|
||||
; internals: Any previously prepared index is discarded before recalculation.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-repeat! playback repeat)
|
||||
(with-lock
|
||||
playback
|
||||
@@ -378,17 +471,28 @@
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(prepare-next! playback))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
; goal : Close playback and release its renderer resources.
|
||||
; pre : Playback was created by make-dlna-playback.
|
||||
; post : The monitor has stopped and the underlying DLNA player is closed.
|
||||
; result : Void.
|
||||
; internals: The running flag prevents repeated closure of the same player.
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
(define (dlna-playback-close! playback)
|
||||
(when (dlna-playback-running? playback)
|
||||
(set-dlna-playback-running?! playback #f)
|
||||
(define monitor (dlna-playback-monitor playback))
|
||||
(when (and monitor (not (thread-dead? monitor)))
|
||||
(kill-thread monitor))
|
||||
(set-dlna-playback-monitor! playback #f)
|
||||
(with-lock
|
||||
playback
|
||||
(λ ()
|
||||
(dlna-player-close! (dlna-playback-player playback))))))
|
||||
(let ((monitor (dlna-playback-monitor playback)))
|
||||
(when (and monitor (not (thread-dead? monitor)))
|
||||
(kill-thread monitor))
|
||||
(set-dlna-playback-monitor! playback #f)
|
||||
(with-lock
|
||||
playback
|
||||
(λ ()
|
||||
(dlna-player-close! (dlna-playback-player playback)))))))
|
||||
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
;; Tests for module dlna-playback.rkt
|
||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
@@ -411,17 +515,21 @@
|
||||
(set-dlna-playback-repeat! playback 'one)
|
||||
(check-equal? (next-index playback 1) 1)
|
||||
|
||||
(set-dlna-playback-prepared-index! playback 1)
|
||||
(check-equal?
|
||||
(track-index-for-info
|
||||
playback
|
||||
(dlna-info
|
||||
'playing
|
||||
(dlna-track-info (track-file second) "Second" "Artist" "Album"
|
||||
#f #f #f 60 #f #f #f)
|
||||
"http://renderer.test/02.flac"
|
||||
#f #f 1 60 25 #f #t))
|
||||
1)
|
||||
(let ((second-info
|
||||
(dlna-info
|
||||
'playing
|
||||
(dlna-track-info (track-file second) "Second" "Artist" "Album"
|
||||
#f #f #f 60 #f #f #f)
|
||||
"http://renderer.test/02.flac"
|
||||
#f #f 1 60 25 #f #t)))
|
||||
(set-dlna-playback-prepared-index! playback 1)
|
||||
(check-equal? (track-index-for-info playback second-info) 1)
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(check-equal? (track-index-for-info playback second-info) 1)
|
||||
(check-false
|
||||
(track-index-for-info
|
||||
playback
|
||||
(struct-copy dlna-info second-info (track #f)))))
|
||||
(check-eq? (normalize-state 'transitioning) 'starting)
|
||||
(check-eq? (normalize-state 'no-media) 'stopped)
|
||||
(check-true (renderer-confirms-playback? 'playing #f))
|
||||
|
||||
Reference in New Issue
Block a user