589 lines
19 KiB
Racket
589 lines
19 KiB
Racket
#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"))))
|