playlists and DLNA playback
This commit is contained in:
@@ -0,0 +1,425 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket-audio-dlna
|
||||
racket/list
|
||||
racket/path
|
||||
racket/string
|
||||
simple-log
|
||||
"library.rkt")
|
||||
|
||||
(provide make-dlna-playback
|
||||
dlna-playback-play-index!
|
||||
dlna-playback-pause!
|
||||
dlna-playback-resume!
|
||||
dlna-playback-stop!
|
||||
dlna-playback-seek-percentage!
|
||||
dlna-playback-volume!
|
||||
dlna-playback-repeat!
|
||||
dlna-playback-close!)
|
||||
|
||||
(sl-def-log web-player-dlna)
|
||||
|
||||
;; This module deliberately contains only playlist orchestration. Transport,
|
||||
;; HTTP publication, metadata, polling and seeking remain the responsibility
|
||||
;; of racket-audio-dlna.
|
||||
(struct dlna-playback
|
||||
(player
|
||||
tracks
|
||||
update
|
||||
error
|
||||
[repeat #:mutable]
|
||||
[current-index #:mutable]
|
||||
[current-uri #:mutable]
|
||||
[prepared-index #:mutable]
|
||||
[playing-seen? #:mutable]
|
||||
[progress-seen? #:mutable]
|
||||
[failure-active? #:mutable]
|
||||
[stop-requested? #:mutable]
|
||||
[stopped-polls #:mutable]
|
||||
[play-request-ms #:mutable]
|
||||
[reachable? #:mutable]
|
||||
[running? #:mutable]
|
||||
[monitor #:mutable]
|
||||
lock)
|
||||
#:transparent)
|
||||
|
||||
(define playback-start-timeout-ms 8000)
|
||||
|
||||
(define (now-ms)
|
||||
(current-inexact-milliseconds))
|
||||
|
||||
(define (normalize-state state)
|
||||
(cond
|
||||
((eq? state 'transitioning) 'starting)
|
||||
((member state '(initialized no-media)) 'stopped)
|
||||
(else state)))
|
||||
|
||||
;; 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))))
|
||||
|
||||
(define (with-lock playback proc)
|
||||
(call-with-semaphore (dlna-playback-lock playback) proc))
|
||||
|
||||
(define (current-tracks playback)
|
||||
((dlna-playback-tracks playback)))
|
||||
|
||||
(define (valid-index? playback index)
|
||||
(and (exact-nonnegative-integer? index)
|
||||
(< index (length (current-tracks playback)))))
|
||||
|
||||
(define (track-at playback index)
|
||||
(and (valid-index? playback index)
|
||||
(list-ref (current-tracks playback) index)))
|
||||
|
||||
(define (normalized-file file)
|
||||
(with-handlers ((exn:fail? (lambda (_) (format "~a" file))))
|
||||
(path->string (path->complete-path file))))
|
||||
|
||||
(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)
|
||||
(else
|
||||
(for/first ((item (in-list (current-tracks playback)))
|
||||
(index (in-naturals))
|
||||
#:when (same-file? file (track-file item)))
|
||||
index))))
|
||||
|
||||
(define (notify! playback state info)
|
||||
((dlna-playback-update playback)
|
||||
state
|
||||
(dlna-playback-current-index playback)
|
||||
info))
|
||||
|
||||
(define (report-failure! playback detail)
|
||||
(set-dlna-playback-playing-seen?! playback #f)
|
||||
(set-dlna-playback-progress-seen?! playback #f)
|
||||
(set-dlna-playback-failure-active?! playback #t)
|
||||
(set-dlna-playback-play-request-ms! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
((dlna-playback-error playback) detail))
|
||||
|
||||
(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?
|
||||
(lambda (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))))))
|
||||
|
||||
(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?
|
||||
(lambda (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)))
|
||||
|
||||
(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)))
|
||||
|
||||
(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))))))
|
||||
|
||||
(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))
|
||||
(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)))))))
|
||||
|
||||
(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))))
|
||||
|
||||
(define (monitor-loop playback poll-seconds)
|
||||
(let loop ()
|
||||
(when (dlna-playback-running? playback)
|
||||
(sleep poll-seconds)
|
||||
(when (dlna-playback-running? playback)
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (exception)
|
||||
(warn-web-player-dlna
|
||||
"Could not update DLNA playback state: ~a"
|
||||
(exn-message exception)))))
|
||||
(with-lock playback (lambda () (poll/locked! playback))))
|
||||
(loop)))))
|
||||
|
||||
(define (make-dlna-playback device
|
||||
tracks
|
||||
update
|
||||
error
|
||||
#:port [port 8734]
|
||||
#:poll-seconds [poll-seconds 1])
|
||||
(define raw
|
||||
(make-dlna-player device
|
||||
#:port port
|
||||
#:path "/rkt-web-player/"))
|
||||
(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 (lambda () (monitor-loop playback poll-seconds))))
|
||||
playback)
|
||||
|
||||
(define (dlna-playback-play-index! playback index)
|
||||
(with-lock playback (lambda () (play-index/locked! playback index))))
|
||||
|
||||
(define (dlna-playback-pause! playback)
|
||||
(with-lock
|
||||
playback
|
||||
(lambda ()
|
||||
(dlna-player-pause! (dlna-playback-player playback))
|
||||
(notify! playback 'paused (dlna-player-info (dlna-playback-player playback))))))
|
||||
|
||||
(define (dlna-playback-resume! playback)
|
||||
(with-lock
|
||||
playback
|
||||
(lambda ()
|
||||
(dlna-player-resume! (dlna-playback-player playback))
|
||||
(notify! playback 'playing (dlna-player-info (dlna-playback-player playback))))))
|
||||
|
||||
(define (dlna-playback-stop! playback)
|
||||
(with-lock
|
||||
playback
|
||||
(lambda ()
|
||||
(set-dlna-playback-stop-requested?! playback #t)
|
||||
(set-dlna-playback-playing-seen?! playback #f)
|
||||
(set-dlna-playback-progress-seen?! playback #f)
|
||||
(set-dlna-playback-failure-active?! playback #f)
|
||||
(set-dlna-playback-play-request-ms! playback #f)
|
||||
(set-dlna-playback-stopped-polls! playback 0)
|
||||
(dlna-player-stop! (dlna-playback-player playback))
|
||||
(notify! playback 'stopped (dlna-player-info (dlna-playback-player playback))))))
|
||||
|
||||
(define (dlna-playback-seek-percentage! playback percentage)
|
||||
(with-lock
|
||||
playback
|
||||
(lambda ()
|
||||
(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))))
|
||||
|
||||
(define (dlna-playback-volume! playback percentage)
|
||||
(with-lock
|
||||
playback
|
||||
(lambda ()
|
||||
(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))))
|
||||
|
||||
(define (dlna-playback-repeat! playback repeat)
|
||||
(with-lock
|
||||
playback
|
||||
(lambda ()
|
||||
(set-dlna-playback-repeat! playback repeat)
|
||||
(set-dlna-playback-prepared-index! playback #f)
|
||||
(prepare-next! playback))))
|
||||
|
||||
(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
|
||||
(lambda ()
|
||||
(dlna-player-close! (dlna-playback-player playback))))))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
(define first
|
||||
(track (build-path "music" "01.flac")
|
||||
"First" "Artist" "Album" 60 "audio/flac"))
|
||||
(define second
|
||||
(track (build-path "music" "02.flac")
|
||||
"Second" "Artist" "Album" 60 "audio/flac"))
|
||||
(define playback
|
||||
(dlna-playback #f (lambda () (list first second)) void void
|
||||
'off 0 #f #f #f #f #f #f 0 #f #t #f #f
|
||||
(make-semaphore 1)))
|
||||
|
||||
(check-equal? (next-index playback 0) 1)
|
||||
(check-false (next-index playback 1))
|
||||
(set-dlna-playback-repeat! playback 'all)
|
||||
(check-equal? (next-index playback 1) 0)
|
||||
(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)
|
||||
(check-eq? (normalize-state 'transitioning) 'starting)
|
||||
(check-eq? (normalize-state 'no-media) 'stopped)
|
||||
(check-true (renderer-confirms-playback? 'playing #f))
|
||||
(check-true (renderer-confirms-playback? 'starting 0))
|
||||
(check-true (renderer-confirms-playback? 'paused #f))
|
||||
(check-true (renderer-confirms-playback? 'unknown 1))
|
||||
(check-false (renderer-confirms-playback? 'stopped 0)))
|
||||
Reference in New Issue
Block a user