374 lines
12 KiB
Racket
374 lines
12 KiB
Racket
#lang racket
|
|
|
|
(require racket/class
|
|
racket/path
|
|
(prefix-in rad: racket-audio-dlna)
|
|
"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)]
|
|
[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 stop-requested? #f)
|
|
(define stopped-polls 0)
|
|
(define renderer-reachable? #t)
|
|
(define running #t)
|
|
(define poll-thread #f)
|
|
|
|
(define (check-player)
|
|
(when (eq? renderer #f)
|
|
(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
|
|
renderer
|
|
#:listen-ip listen-ip
|
|
#:port server-port
|
|
#:path "/rktplayer/"
|
|
#:poll-seconds poll-seconds
|
|
#:volume-poll-seconds volume-poll-seconds))))
|
|
|
|
(define (normalize-state st)
|
|
(cond
|
|
[(or (eq? st 'playing)
|
|
(eq? st 'transitioning))
|
|
'playing]
|
|
[(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 ((match
|
|
(and file
|
|
(regexp-match
|
|
#px"(?i:[.]([a-z0-9]+))$"
|
|
(path->string file)))))
|
|
(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)
|
|
(send (send playlist track nr) get-file))
|
|
|
|
(define (playlist-track-nr file)
|
|
(and playlist
|
|
(for/first ([nr (in-range (send playlist length))]
|
|
#:when (same-file? file (playlist-track-file nr)))
|
|
nr)))
|
|
|
|
(define (next-track-nr nr)
|
|
(let ((length (send playlist length)))
|
|
(cond
|
|
[(eq? repeat 'repeat-one) nr]
|
|
[(eq? repeat 'repeat-all)
|
|
(if (= (+ nr 1) length) 0 (+ nr 1))]
|
|
[(< (+ nr 1) length) (+ nr 1)]
|
|
[else #f])))
|
|
|
|
(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))
|
|
(with-handlers
|
|
([exn:fail?
|
|
(lambda (e)
|
|
(set! prepared-next-track-nr #f)
|
|
(warn-rktplayer
|
|
"Could not prepare next DLNA track: ~a"
|
|
(exn-message e)))])
|
|
(rad:dlna-player-set-next-file!
|
|
player
|
|
(playlist-track-file 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)))
|
|
(nr (cond
|
|
[(and (exact-nonnegative-integer?
|
|
prepared-next-track-nr)
|
|
(same-file?
|
|
file
|
|
(playlist-track-file prepared-next-track-nr)))
|
|
prepared-next-track-nr]
|
|
[else (playlist-track-nr file)])))
|
|
(when (exact-nonnegative-integer? nr)
|
|
(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"))
|
|
(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)))
|
|
(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 'paused))
|
|
(when (and (number? position)
|
|
(number? duration))
|
|
(time-updater position duration))
|
|
(track-audio-info! (rad:dlna-info-track info)))
|
|
|
|
(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?)
|
|
(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! 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)
|
|
(or (rad:dlna-info-volume
|
|
(rad:dlna-player-info player))
|
|
0))
|
|
|
|
(define/public (set-volume! percentage)
|
|
(check-player)
|
|
(rad:dlna-player-volume! player 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! 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*)
|
|
(send this play-track 0))
|
|
|
|
(define/public (play-track nr)
|
|
(check-player)
|
|
(when (and playlist
|
|
(>= nr 0)
|
|
(< nr (send playlist length)))
|
|
(let ((file (playlist-track-file nr)))
|
|
(rad:dlna-player-play! player file)
|
|
(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! stop-requested? #f)
|
|
(set! stopped-polls 0)
|
|
(track-nr-updater nr)
|
|
(track-audio-info! (rad:dlna-info-track info))
|
|
(set-state! 'playing)
|
|
(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))
|
|
(cond
|
|
[(eq? repeat 'repeat-one)
|
|
(send this play-track nr)]
|
|
[(eq? repeat 'repeat-all)
|
|
(send this play-track
|
|
(if (= nr 0)
|
|
(- (send playlist length) 1)
|
|
(- nr 1)))]
|
|
[else
|
|
(send this play-track (max 0 (- nr 1)))]))))
|
|
|
|
(define/public (pause!)
|
|
(check-player)
|
|
(rad:dlna-player-pause! player)
|
|
(set-state! 'paused))
|
|
|
|
(define/public (play!)
|
|
(check-player)
|
|
(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)
|
|
(check-player)
|
|
(set! stop-requested? #t)
|
|
(set! playing-seen? #f)
|
|
(set! stopped-polls 0)
|
|
(rad:dlna-player-stop! player)
|
|
(set-state! 'stopped))
|
|
|
|
(define/public (seek percentage)
|
|
(check-player)
|
|
(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"))))
|