Complete refactoring for rktplayer, in order to make it play on DLNA renderers and also use UpNP media server resources.
This commit is contained in:
@@ -0,0 +1,588 @@
|
||||
#lang racket
|
||||
|
||||
(require racket/class
|
||||
racket/path
|
||||
(prefix-in rad: racket-audio-dlna)
|
||||
"../library/base/media-resource.rkt"
|
||||
"base/renderer.rkt"
|
||||
"../misc/utils.rkt")
|
||||
|
||||
(provide dlna-player%)
|
||||
|
||||
(define dlna-player%
|
||||
(class object%
|
||||
(init-field [renderer #f]
|
||||
[settings #f]
|
||||
[time-updater (lambda (time-s length-s) #t)]
|
||||
[track-nr-updater (lambda (nr) #t)]
|
||||
[state-updater (lambda (state) #t)]
|
||||
[error-updater
|
||||
(lambda (kind detail) #t)]
|
||||
[repeat-updater (lambda (state) #t)]
|
||||
[audio-info-cb (lambda (rate channels bits kind) #t)]
|
||||
[buffer-max-seconds 10]
|
||||
[buffer-min-seconds 4]
|
||||
[server-url #f]
|
||||
[server-port 8734] ;8080]
|
||||
[listen-ip #f]
|
||||
[poll-seconds 1.0]
|
||||
[volume-poll-seconds 5.0])
|
||||
|
||||
(define player #f)
|
||||
(define playlist #f)
|
||||
(define state 'stopped)
|
||||
(define repeat 'no-repeat)
|
||||
(define current-track-nr #f)
|
||||
(define current-uri #f)
|
||||
(define prepared-next-track-nr #f)
|
||||
(define playing-seen? #f)
|
||||
(define playback-progress-seen? #f)
|
||||
(define playback-failure-active? #f)
|
||||
(define play-request-ms #f)
|
||||
(define stop-requested? #f)
|
||||
(define stopped-polls 0)
|
||||
(define renderer-reachable? #t)
|
||||
(define playback-start-timeout-ms 8000)
|
||||
(define running #t)
|
||||
(define poll-thread #f)
|
||||
|
||||
(define (now-ms)
|
||||
(current-inexact-milliseconds))
|
||||
|
||||
(define (track-title nr)
|
||||
(let ((track
|
||||
(and playlist
|
||||
(exact-nonnegative-integer? nr)
|
||||
(send playlist track nr))))
|
||||
(if track
|
||||
(send track get-title)
|
||||
"")))
|
||||
|
||||
(define (report-playback-failure! detail)
|
||||
(set! playing-seen? #f)
|
||||
(set! playback-progress-seen? #f)
|
||||
(set! playback-failure-active? #t)
|
||||
(set! play-request-ms #f)
|
||||
(set! stopped-polls 0)
|
||||
(error-updater 'playback-failed detail))
|
||||
|
||||
(define (renderer-command! name command)
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (e)
|
||||
(warn-rktplayer
|
||||
"Could not execute DLNA command ~a: ~a"
|
||||
name
|
||||
(exn-message e))
|
||||
(error-updater
|
||||
'renderer-command-failed
|
||||
(send renderer get-name))
|
||||
#f)))
|
||||
(command)
|
||||
#t))
|
||||
|
||||
(define (check-player)
|
||||
(unless (is-a? renderer renderer%)
|
||||
(raise-arguments-error
|
||||
'dlna-player%
|
||||
"no media renderer has been configured"
|
||||
"renderer" renderer))
|
||||
(when (eq? player #f)
|
||||
(unless (eq? server-url #f)
|
||||
(warn-rktplayer
|
||||
"server-url is ignored; racket-audio-dlna determines the server URL"))
|
||||
(set! player
|
||||
(rad:make-dlna-player
|
||||
(send renderer get-device)
|
||||
#:listen-ip listen-ip
|
||||
#:port server-port
|
||||
#:path "/rktplayer/"
|
||||
#:poll-seconds poll-seconds
|
||||
#:volume-poll-seconds volume-poll-seconds))))
|
||||
|
||||
(define (normalize-state st)
|
||||
(cond
|
||||
[(eq? st 'playing) 'playing]
|
||||
[(eq? st 'transitioning) 'starting]
|
||||
[(eq? st 'paused) 'paused]
|
||||
[(or (eq? st 'stopped)
|
||||
(eq? st 'no-media))
|
||||
'stopped]
|
||||
[else st]))
|
||||
|
||||
(define (set-state! st)
|
||||
(unless (eq? state st)
|
||||
(set! state st)
|
||||
(state-updater state))
|
||||
(repeat-updater repeat)
|
||||
(when (or (eq? state 'stopped)
|
||||
(eq? state 'quit))
|
||||
(audio-info-cb 0 0 0 'none)))
|
||||
|
||||
(define (file-format file)
|
||||
(let* ((value
|
||||
(cond
|
||||
((path? file) (path->string file))
|
||||
((string? file) file)
|
||||
(else #f)))
|
||||
(match
|
||||
(and value
|
||||
(regexp-match
|
||||
#px"(?i:[.]([a-z0-9]+)(?:[?#].*)?$)"
|
||||
value))))
|
||||
(if match
|
||||
(string->symbol (string-downcase (cadr match)))
|
||||
'none)))
|
||||
|
||||
(define (track-audio-info! track)
|
||||
(if track
|
||||
(audio-info-cb
|
||||
(or (rad:dlna-track-info-sample-rate track) 0)
|
||||
(or (rad:dlna-track-info-channels track) 0)
|
||||
0
|
||||
(file-format (rad:dlna-track-info-file track)))
|
||||
(audio-info-cb 0 0 0 'none)))
|
||||
|
||||
(define (normalized-file file)
|
||||
(with-handlers ([exn:fail? (lambda (_) (format "~a" file))])
|
||||
(path->string (path->complete-path file))))
|
||||
|
||||
(define (same-file? file1 file2)
|
||||
(and file1
|
||||
file2
|
||||
((if (eq? (system-type 'os) 'windows)
|
||||
string-ci=?
|
||||
string=?)
|
||||
(normalized-file file1)
|
||||
(normalized-file file2))))
|
||||
|
||||
(define (playlist-track-file nr)
|
||||
(let* ((track (send playlist track nr))
|
||||
(resource
|
||||
(and track
|
||||
(send track get-resource))))
|
||||
(and resource
|
||||
(is-a? resource media-resource%)
|
||||
(send resource get-file))))
|
||||
|
||||
(define (playlist-track-uri nr)
|
||||
(let ((track (send playlist track nr)))
|
||||
(and track
|
||||
(send (send track get-resource)
|
||||
get-uri))))
|
||||
|
||||
(define (playlist-track-info nr)
|
||||
(let* ((track (send playlist track nr))
|
||||
(resource (send track get-resource)))
|
||||
(rad:dlna-track-info
|
||||
(or (send resource get-file)
|
||||
(send resource get-uri))
|
||||
(send track get-title)
|
||||
(send track get-artist)
|
||||
(send track get-album)
|
||||
#f
|
||||
#f
|
||||
(send track get-number)
|
||||
(send track get-length)
|
||||
#f
|
||||
#f
|
||||
#f)))
|
||||
|
||||
(define (playlist-track-mime-type nr)
|
||||
(send (send (send playlist track nr)
|
||||
get-resource)
|
||||
get-mime-type))
|
||||
|
||||
(define (playlist-track-protocol-info nr)
|
||||
(send (send (send playlist track nr)
|
||||
get-resource)
|
||||
get-protocol-info))
|
||||
|
||||
(define (playlist-track-nr file uri)
|
||||
(and playlist
|
||||
(for/first ([nr (in-range (send playlist length))]
|
||||
#:when
|
||||
(or (same-file?
|
||||
file
|
||||
(playlist-track-file nr))
|
||||
(and (string? uri)
|
||||
(equal?
|
||||
uri
|
||||
(playlist-track-uri nr)))))
|
||||
nr)))
|
||||
|
||||
(define (next-track-nr nr)
|
||||
(if (eq? repeat 'repeat-one)
|
||||
nr
|
||||
(send playlist
|
||||
next-valid-track-index
|
||||
nr
|
||||
(eq? repeat 'repeat-all))))
|
||||
|
||||
(define (prepare-next-track!)
|
||||
(when (and player
|
||||
playlist
|
||||
(exact-nonnegative-integer? current-track-nr))
|
||||
(let ((nr (next-track-nr current-track-nr)))
|
||||
(cond
|
||||
[(eq? nr #f)
|
||||
(set! prepared-next-track-nr #f)]
|
||||
[(not (equal? nr prepared-next-track-nr))
|
||||
(let ((file (playlist-track-file nr)))
|
||||
(with-handlers
|
||||
([exn:fail?
|
||||
(lambda (e)
|
||||
(set! prepared-next-track-nr #f)
|
||||
(warn-rktplayer
|
||||
"Could not prepare next DLNA track: ~a"
|
||||
(exn-message e)))])
|
||||
(if file
|
||||
(rad:dlna-player-set-next-file!
|
||||
player
|
||||
file)
|
||||
(rad:dlna-player-set-next-uri!
|
||||
player
|
||||
(playlist-track-uri nr)
|
||||
#:mime-type
|
||||
(playlist-track-mime-type nr)
|
||||
#:protocol-info
|
||||
(playlist-track-protocol-info nr)
|
||||
#:track
|
||||
(playlist-track-info nr)))
|
||||
(set! prepared-next-track-nr nr)))]))))
|
||||
|
||||
(define (update-current-track! info)
|
||||
(let* ((track (rad:dlna-info-track info))
|
||||
(file (and track (rad:dlna-track-info-file track)))
|
||||
(uri (rad:dlna-info-uri info))
|
||||
(nr (cond
|
||||
[(and (exact-nonnegative-integer?
|
||||
prepared-next-track-nr)
|
||||
(or
|
||||
(same-file?
|
||||
file
|
||||
(playlist-track-file
|
||||
prepared-next-track-nr))
|
||||
(and (string? uri)
|
||||
(equal?
|
||||
uri
|
||||
(playlist-track-uri
|
||||
prepared-next-track-nr)))))
|
||||
prepared-next-track-nr]
|
||||
[else
|
||||
(playlist-track-nr file uri)])))
|
||||
(when (exact-nonnegative-integer? nr)
|
||||
(unless (equal? nr current-track-nr)
|
||||
(set! playback-progress-seen? #f)
|
||||
(set! play-request-ms (now-ms)))
|
||||
(set! current-track-nr nr)
|
||||
(set! prepared-next-track-nr #f)
|
||||
(track-nr-updater nr)
|
||||
(track-audio-info! track)
|
||||
(prepare-next-track!))))
|
||||
|
||||
(define (poll-renderer)
|
||||
(when player
|
||||
(let ((info (rad:dlna-player-info player)))
|
||||
(if (not (rad:dlna-info-reachable? info))
|
||||
(when renderer-reachable?
|
||||
(set! renderer-reachable? #f)
|
||||
(warn-rktplayer "DLNA renderer is not reachable")
|
||||
(error-updater
|
||||
'renderer-unreachable
|
||||
(send renderer get-name)))
|
||||
(let* ((new-state
|
||||
(normalize-state (rad:dlna-info-state info)))
|
||||
(uri (rad:dlna-info-uri info))
|
||||
(position (rad:dlna-info-position info))
|
||||
(duration (rad:dlna-info-duration info))
|
||||
(playback-failed? #f))
|
||||
(unless renderer-reachable?
|
||||
(dbg-rktplayer "DLNA renderer is reachable again"))
|
||||
(set! renderer-reachable? #t)
|
||||
|
||||
(when (and (string? uri)
|
||||
(not (string=? uri ""))
|
||||
(not (equal? uri current-uri)))
|
||||
(set! current-uri uri)
|
||||
(set! stopped-polls 0)
|
||||
(update-current-track! info))
|
||||
|
||||
(when (or (eq? new-state 'playing)
|
||||
(eq? new-state 'starting)
|
||||
(eq? new-state 'paused))
|
||||
(when (and (number? position)
|
||||
(> position 0))
|
||||
(set! playback-progress-seen? #t))
|
||||
(when (and (number? position)
|
||||
(number? duration))
|
||||
(time-updater position duration))
|
||||
(track-audio-info! (rad:dlna-info-track info)))
|
||||
|
||||
(when (and playing-seen?
|
||||
(not playback-progress-seen?)
|
||||
play-request-ms
|
||||
(>= (- (now-ms)
|
||||
play-request-ms)
|
||||
playback-start-timeout-ms))
|
||||
(set! playback-failed? #t)
|
||||
(report-playback-failure!
|
||||
(track-title current-track-nr)))
|
||||
|
||||
(unless (or playback-failed?
|
||||
playback-failure-active?)
|
||||
(cond
|
||||
[(eq? new-state 'playing)
|
||||
(set! playing-seen? #t)
|
||||
(set! stopped-polls 0)]
|
||||
[(and (eq? new-state 'stopped)
|
||||
stop-requested?)
|
||||
(set! stop-requested? #f)
|
||||
(set! stopped-polls 0)]
|
||||
[(and (eq? new-state 'stopped)
|
||||
playing-seen?)
|
||||
(cond
|
||||
((and
|
||||
(not playback-progress-seen?)
|
||||
play-request-ms
|
||||
(< (- (now-ms)
|
||||
play-request-ms)
|
||||
5000))
|
||||
(void))
|
||||
((not playback-progress-seen?)
|
||||
(report-playback-failure!
|
||||
(track-title current-track-nr)))
|
||||
(else
|
||||
(set! stopped-polls
|
||||
(+ stopped-polls 1))
|
||||
;; Give SetNextAVTransportURI one poll to take over.
|
||||
(when (or
|
||||
(eq? prepared-next-track-nr #f)
|
||||
(> stopped-polls 1))
|
||||
(set! playing-seen? #f)
|
||||
(set! stopped-polls 0)
|
||||
(send this next))))]))
|
||||
|
||||
(set-state!
|
||||
(cond
|
||||
((or playback-failed?
|
||||
playback-failure-active?)
|
||||
'stopped)
|
||||
((and playing-seen?
|
||||
(not playback-progress-seen?))
|
||||
'starting)
|
||||
(else new-state))))))))
|
||||
|
||||
(define (poll)
|
||||
(let loop ()
|
||||
(when running
|
||||
(sleep poll-seconds)
|
||||
(when running
|
||||
(with-handlers
|
||||
([exn:fail?
|
||||
(lambda (e)
|
||||
(warn-rktplayer
|
||||
"Could not update DLNA player state: ~a"
|
||||
(exn-message e)))])
|
||||
(poll-renderer))
|
||||
(loop)))))
|
||||
|
||||
(define/public (change-player kind
|
||||
#:host [host #f]
|
||||
#:basepaths [basepaths #f])
|
||||
(void kind host basepaths)
|
||||
(warn-rktplayer
|
||||
"change-player is not supported by dlna-player%"))
|
||||
|
||||
(define/public (get-volume)
|
||||
(check-player)
|
||||
(send renderer
|
||||
device-volume->logical
|
||||
(or (rad:dlna-info-volume
|
||||
(rad:dlna-player-info player))
|
||||
0)))
|
||||
|
||||
(define/public (set-volume! percentage)
|
||||
(check-player)
|
||||
(renderer-command!
|
||||
'volume
|
||||
(lambda ()
|
||||
(rad:dlna-player-volume!
|
||||
player
|
||||
(send renderer
|
||||
logical-volume->device
|
||||
percentage)))))
|
||||
|
||||
(define/public (set-list! playlist*)
|
||||
(when player
|
||||
(with-handlers ([exn:fail? (lambda (_) (void))])
|
||||
(rad:dlna-player-stop! player)))
|
||||
(set! playlist playlist*)
|
||||
(set! current-track-nr #f)
|
||||
(set! current-uri #f)
|
||||
(set! prepared-next-track-nr #f)
|
||||
(set! playing-seen? #f)
|
||||
(set! playback-progress-seen? #f)
|
||||
(set! playback-failure-active? #f)
|
||||
(set! play-request-ms #f)
|
||||
(set! stop-requested? #f)
|
||||
(set! stopped-polls 0)
|
||||
(set-state! 'stopped))
|
||||
|
||||
(define/public (playlist! playlist*)
|
||||
(check-player)
|
||||
(set-list! playlist*))
|
||||
|
||||
(define/public (play playlist*)
|
||||
(send this playlist! playlist*)
|
||||
(let ((track-nr
|
||||
(send playlist
|
||||
first-valid-track-index)))
|
||||
(when track-nr
|
||||
(send this play-track track-nr))))
|
||||
|
||||
(define/public (play-track nr)
|
||||
(check-player)
|
||||
(when (and playlist
|
||||
(>= nr 0)
|
||||
(< nr (send playlist length)))
|
||||
(with-handlers
|
||||
((exn:fail?
|
||||
(lambda (e)
|
||||
(warn-rktplayer
|
||||
"Could not play DLNA track: ~a"
|
||||
(exn-message e))
|
||||
(report-playback-failure!
|
||||
(track-title nr))
|
||||
(set-state! 'stopped))))
|
||||
(let ((file (playlist-track-file nr)))
|
||||
(if file
|
||||
(rad:dlna-player-play! player file)
|
||||
(rad:dlna-player-play-uri!
|
||||
player
|
||||
(playlist-track-uri nr)
|
||||
#:mime-type
|
||||
(playlist-track-mime-type nr)
|
||||
#:protocol-info
|
||||
(playlist-track-protocol-info nr)
|
||||
#:track
|
||||
(playlist-track-info nr)))
|
||||
(when (or file
|
||||
(playlist-track-uri nr))
|
||||
(let ((info (rad:dlna-player-info player)))
|
||||
(set! current-track-nr nr)
|
||||
(set! current-uri (rad:dlna-info-uri info))
|
||||
(set! prepared-next-track-nr #f)
|
||||
(set! playing-seen? #t)
|
||||
(set! playback-progress-seen? #f)
|
||||
(set! playback-failure-active? #f)
|
||||
(set! play-request-ms (now-ms))
|
||||
(set! stop-requested? #f)
|
||||
(set! stopped-polls 0)
|
||||
(track-nr-updater nr)
|
||||
(track-audio-info! (rad:dlna-info-track info))
|
||||
(set-state! 'starting)
|
||||
(prepare-next-track!)))))))
|
||||
|
||||
(define/public (next)
|
||||
(check-player)
|
||||
(if (eq? current-track-nr #f)
|
||||
(warn-rktplayer
|
||||
"No track-nr set (yet), so can't play anything next")
|
||||
(let ((nr (next-track-nr current-track-nr)))
|
||||
(if (eq? nr #f)
|
||||
(send this stop)
|
||||
(send this play-track nr)))))
|
||||
|
||||
(define/public (previous)
|
||||
(check-player)
|
||||
(if (eq? current-track-nr #f)
|
||||
(warn-rktplayer
|
||||
"No track-nr set (yet), so can't play anything previous")
|
||||
(let ((nr current-track-nr))
|
||||
(if (eq? repeat 'repeat-one)
|
||||
(send this play-track nr)
|
||||
(let ((previous-track-nr
|
||||
(send playlist
|
||||
previous-valid-track-index
|
||||
nr
|
||||
(eq? repeat 'repeat-all))))
|
||||
(send this
|
||||
play-track
|
||||
(or previous-track-nr
|
||||
nr)))))))
|
||||
|
||||
(define/public (pause!)
|
||||
(check-player)
|
||||
(when (renderer-command!
|
||||
'pause
|
||||
(lambda ()
|
||||
(rad:dlna-player-pause! player)))
|
||||
(set-state! 'paused)))
|
||||
|
||||
(define/public (play!)
|
||||
(check-player)
|
||||
(when (renderer-command!
|
||||
'play
|
||||
(lambda ()
|
||||
(rad:dlna-player-resume! player)))
|
||||
(set-state! 'playing)))
|
||||
|
||||
(define/public (pause-unpause)
|
||||
(check-player)
|
||||
(if (eq? state 'paused)
|
||||
(send this play!)
|
||||
(send this pause!)))
|
||||
|
||||
(define/public (stop)
|
||||
(set! stop-requested? #t)
|
||||
(set! playing-seen? #f)
|
||||
(set! playback-progress-seen? #f)
|
||||
(set! playback-failure-active? #f)
|
||||
(set! play-request-ms #f)
|
||||
(set! stopped-polls 0)
|
||||
(unless (eq? player #f)
|
||||
(renderer-command!
|
||||
'stop
|
||||
(lambda ()
|
||||
(rad:dlna-player-stop! player))))
|
||||
(set-state! 'stopped))
|
||||
|
||||
(define/public (seek percentage)
|
||||
(check-player)
|
||||
(renderer-command!
|
||||
'seek
|
||||
(lambda ()
|
||||
(rad:dlna-player-seek-percentage!
|
||||
player
|
||||
percentage))))
|
||||
|
||||
(define/public (get-repeat)
|
||||
(check-player)
|
||||
repeat)
|
||||
|
||||
(define/public (repeat! r)
|
||||
(check-player)
|
||||
(set! repeat r)
|
||||
(repeat-updater repeat)
|
||||
(prepare-next-track!))
|
||||
|
||||
(define/public (quit)
|
||||
(when running
|
||||
(set! running #f)
|
||||
(unless (eq? poll-thread #f)
|
||||
(kill-thread poll-thread)
|
||||
(set! poll-thread #f))
|
||||
(unless (eq? player #f)
|
||||
(rad:dlna-player-close! player)
|
||||
(set! player #f))
|
||||
(set-state! 'quit)))
|
||||
|
||||
(super-new)
|
||||
|
||||
(begin
|
||||
(void settings
|
||||
buffer-max-seconds
|
||||
buffer-min-seconds)
|
||||
(set! poll-thread (thread poll))
|
||||
(dbg-rktplayer "dlna-player% initialized"))))
|
||||
Reference in New Issue
Block a user