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,261 @@
|
||||
#lang racket
|
||||
|
||||
(require racket/class
|
||||
racket-audio
|
||||
"../../misc/utils.rkt"
|
||||
"../../library/base/media-resource.rkt"
|
||||
lru-cache
|
||||
)
|
||||
|
||||
(provide player%)
|
||||
|
||||
(define player%
|
||||
(class object%
|
||||
(init-field [settings #f]
|
||||
[time-updater (λ (time-s length-s) #t)]
|
||||
[track-nr-updater (λ (nr) #t)]
|
||||
[state-updater (λ (state) #t)]
|
||||
[repeat-updater (λ (state) #t)]
|
||||
[audio-info-cb (λ (current-sample rate channels bits kind) #t)]
|
||||
[buffer-max-seconds 10]
|
||||
[buffer-min-seconds 4]
|
||||
)
|
||||
|
||||
(define player-kind 'local)
|
||||
(define player-host #f)
|
||||
(define player-basepaths #f)
|
||||
|
||||
(define player #f)
|
||||
(define playlist #f)
|
||||
(define state 'stopped)
|
||||
(define repeat 'no-repeat)
|
||||
|
||||
(define full-state (make-hash))
|
||||
(define music-id -1)
|
||||
(define track-cache (make-lru 10
|
||||
#:cmp (λ (a b) (= (car a) (car b)))))
|
||||
|
||||
|
||||
(define (music-id->track-nr id)
|
||||
(let ((item (lru-use track-cache (list music-id) #f)))
|
||||
(if (eq? item #f)
|
||||
#f
|
||||
(cadr item))))
|
||||
|
||||
(define (register-music-id&track-nr id track-nr)
|
||||
(lru-add! track-cache (list id track-nr)))
|
||||
|
||||
(define (clear-music-ids!)
|
||||
(lru-clear track-cache))
|
||||
|
||||
|
||||
;;(define x 0)
|
||||
(define (audio-state-cb handle player-state st*)
|
||||
(set! full-state st*)
|
||||
;;(when (< x 5)
|
||||
;; (displayln st*)
|
||||
;; (set! x (+ x 1)))
|
||||
(unless (or (not (eq? player handle)) (eq? player #f))
|
||||
(let ((st (audio-state player)))
|
||||
(when (or (eq? st 'paused) (eq? st 'playing))
|
||||
(time-updater (audio-at-second player)
|
||||
(audio-duration player))
|
||||
(when (not (= music-id (audio-music-id player)))
|
||||
(set! music-id (audio-music-id player))
|
||||
(let ((track-nr (music-id->track-nr music-id)))
|
||||
(if (eq? track-nr #f)
|
||||
(warn-rktplayer "Unexpected: no track-nr for given music-id")
|
||||
(track-nr-updater track-nr))))
|
||||
)
|
||||
(state-updater st)
|
||||
(repeat-updater repeat)
|
||||
(if (or (eq? player-state 'quit) (eq? player-state 'stopped))
|
||||
(audio-info-cb 0 0 0 'none)
|
||||
(audio-info-cb (audio-rate player) (audio-channels player)
|
||||
(audio-bits player) (audio-decoder player)))
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define (on-eof-stream-cb handle)
|
||||
(when (and (eq? player handle) (not (eq? player #f)))
|
||||
(let ((track-nr (music-id->track-nr music-id)))
|
||||
(send this next))))
|
||||
|
||||
|
||||
;(define ap (make-audio-player audio-player-state audio-player-eof
|
||||
; #:remote-host "hans@mahler.thuis.local"
|
||||
; #:replace-base-paths '(("\\\\panderleou\\music" . "/muziek"))))
|
||||
(define (check-player)
|
||||
;(displayln "check-player called")
|
||||
(when (eq? player #f)
|
||||
(set! player
|
||||
(if (eq? player-kind 'local)
|
||||
(make-audio-player audio-state-cb on-eof-stream-cb)
|
||||
(make-audio-player audio-state-cb on-eof-stream-cb
|
||||
#:remote-host player-host
|
||||
#:replace-base-paths player-basepaths)))
|
||||
(audio-ao-buf-ms! player 500)
|
||||
(audio-buf-seconds! player buffer-min-seconds buffer-max-seconds)
|
||||
))
|
||||
|
||||
(define/public (change-player kind #:host [host #f] #:basepaths [basepaths #f])
|
||||
(let ((op player))
|
||||
(unless (eq? player #f)
|
||||
(set! player #f)
|
||||
(audio-quit! op)
|
||||
;(displayln "Player quit")
|
||||
)
|
||||
;(displayln "HE!")
|
||||
(set! player-kind kind)
|
||||
(set! player-host host)
|
||||
(set! player-basepaths basepaths)
|
||||
;(displayln (format "kind: ~a, host: ~a, bp: ~a, player: ~a" player-kind player-host player-basepaths player))
|
||||
))
|
||||
|
||||
(define/public (get-volume)
|
||||
(check-player)
|
||||
(* 100.0
|
||||
(sqrt
|
||||
(/ (min 100.0
|
||||
(max 0.0
|
||||
(audio-volume player)))
|
||||
100.0))))
|
||||
|
||||
(define/public (set-volume! percentage)
|
||||
(check-player)
|
||||
(let ((value
|
||||
(/ (min 100.0
|
||||
(max 0.0 percentage))
|
||||
100.0)))
|
||||
(audio-volume! player
|
||||
(* 100.0
|
||||
value
|
||||
value))))
|
||||
|
||||
(define/public (set-list! playlist*)
|
||||
;; if the player exists and is playing, stop it.
|
||||
(unless (eq? player #f)
|
||||
(audio-stop! player))
|
||||
;; Set the playlist to the new one.
|
||||
(set! playlist playlist*)
|
||||
;; reset music-id to -1, because the playlist has been reset.
|
||||
(set! music-id -1)
|
||||
;; clear lru cache, because the playlist has been reset.
|
||||
(clear-music-ids!)
|
||||
)
|
||||
|
||||
(define/public (playlist! playlist*)
|
||||
(check-player)
|
||||
(set-list! playlist*))
|
||||
|
||||
(define/public (play playlist*)
|
||||
(send this playlist! playlist*)
|
||||
(let ((track-nr
|
||||
(send playlist
|
||||
first-available-track-index)))
|
||||
(when track-nr
|
||||
(send this play-track track-nr))))
|
||||
|
||||
(define/public (play-track nr)
|
||||
(check-player)
|
||||
(when (and (>= nr 0) (< nr (send playlist length)))
|
||||
(let ((track (send playlist track nr)))
|
||||
(when track
|
||||
(let ((file
|
||||
(send playlist track-file nr)))
|
||||
(if file
|
||||
(let ((id (audio-play! player file)))
|
||||
(register-music-id&track-nr id nr))
|
||||
(warn-rktplayer
|
||||
"Track is not locally available: ~a"
|
||||
(send track get-title))))))))
|
||||
|
||||
(define/public (next)
|
||||
(check-player)
|
||||
(if (= music-id -1)
|
||||
(warn-rktplayer "No music-id set (yet), so can't play anything next")
|
||||
(let ((track-nr (music-id->track-nr music-id)))
|
||||
(if (eq? track-nr #f)
|
||||
(error "Unexpected: no track-nr for given music-id")
|
||||
(if (eq? repeat 'repeat-one)
|
||||
(send this play-track track-nr)
|
||||
(let ((next-track-nr
|
||||
(send playlist
|
||||
next-available-track-index
|
||||
track-nr
|
||||
(eq? repeat 'repeat-all))))
|
||||
(if next-track-nr
|
||||
(send this
|
||||
play-track
|
||||
next-track-nr)
|
||||
(send this stop))))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define/public (previous)
|
||||
(check-player)
|
||||
(if (= music-id -1)
|
||||
(warn-rktplayer "No music-id set (yet), so can't play anything previous")
|
||||
(let ((track-nr (music-id->track-nr music-id)))
|
||||
(if (eq? track-nr #f)
|
||||
(error "Unexpected: no track-nr for given music-id")
|
||||
(if (eq? repeat 'repeat-one)
|
||||
(send this play-track track-nr)
|
||||
(let ((previous-track-nr
|
||||
(send playlist
|
||||
previous-available-track-index
|
||||
track-nr
|
||||
(eq? repeat 'repeat-all))))
|
||||
(send this
|
||||
play-track
|
||||
(or previous-track-nr
|
||||
track-nr))))
|
||||
)
|
||||
)
|
||||
)
|
||||
)
|
||||
|
||||
(define/public (pause!)
|
||||
(check-player)
|
||||
(audio-pause! player #t))
|
||||
|
||||
(define/public (play!)
|
||||
(check-player)
|
||||
(audio-pause! player #f))
|
||||
|
||||
(define/public (pause-unpause)
|
||||
(check-player)
|
||||
(if (audio-paused? player)
|
||||
(send this pause!)
|
||||
(send this play!)))
|
||||
|
||||
(define/public (stop)
|
||||
(unless (eq? player #f)
|
||||
(audio-stop! player)))
|
||||
|
||||
(define/public (seek percentage)
|
||||
(check-player)
|
||||
(audio-seek! player percentage))
|
||||
|
||||
(define/public (get-repeat)
|
||||
(check-player)
|
||||
repeat)
|
||||
|
||||
(define/public (repeat! r)
|
||||
(check-player)
|
||||
(set! repeat r))
|
||||
|
||||
(define/public (quit)
|
||||
(unless (eq? player #f)
|
||||
(audio-quit! player)))
|
||||
|
||||
(super-new)
|
||||
|
||||
(begin
|
||||
(dbg-rktplayer "player% initialized")
|
||||
)
|
||||
)
|
||||
)
|
||||
@@ -0,0 +1,163 @@
|
||||
#lang racket/base
|
||||
|
||||
(require racket/class
|
||||
racket/list
|
||||
"../../misc/utils.rkt")
|
||||
|
||||
(provide renderer%
|
||||
renderer-preferences%)
|
||||
|
||||
(define renderer-preferences%
|
||||
(class object%
|
||||
(init-field settings)
|
||||
|
||||
(define cfg
|
||||
(send settings clone 'renderers))
|
||||
|
||||
(define/private (stored)
|
||||
(send cfg get
|
||||
'volume-curves
|
||||
'()))
|
||||
|
||||
(define/public (get-volume-curve id)
|
||||
(let ((entry
|
||||
(assoc id
|
||||
(stored)
|
||||
equal?)))
|
||||
(if entry
|
||||
(cadr entry)
|
||||
'linear)))
|
||||
|
||||
(define/public (set-volume-curve! id curve)
|
||||
(check/c renderer-preferences%
|
||||
set-volume-curve!
|
||||
curve
|
||||
(or/c 'linear
|
||||
'logarithmic))
|
||||
(let ((without-id
|
||||
(filter
|
||||
(lambda (entry)
|
||||
(not
|
||||
(equal? (car entry)
|
||||
id)))
|
||||
(stored))))
|
||||
(send cfg
|
||||
set!
|
||||
'volume-curves
|
||||
(cons (list id curve)
|
||||
without-id))))
|
||||
|
||||
(super-new)))
|
||||
|
||||
(module+ test
|
||||
(require rackunit)
|
||||
|
||||
(define values (make-hash))
|
||||
(define test-settings%
|
||||
(class object%
|
||||
(define/public (clone name)
|
||||
(void name)
|
||||
this)
|
||||
(define/public (get name default)
|
||||
(hash-ref values name default))
|
||||
(define/public (set! name value)
|
||||
(hash-set! values name value))
|
||||
(super-new)))
|
||||
|
||||
(define preferences
|
||||
(new renderer-preferences%
|
||||
[settings (new test-settings%)]))
|
||||
(define renderer
|
||||
(new renderer%
|
||||
[id "renderer-id"]
|
||||
[name "Renderer"]
|
||||
[kind 'test]
|
||||
[device 'device]
|
||||
[preferences preferences]))
|
||||
|
||||
(check-= (send renderer
|
||||
logical-volume->device
|
||||
25)
|
||||
25
|
||||
0.001)
|
||||
(send renderer
|
||||
set-volume-curve!
|
||||
'logarithmic)
|
||||
(check-eq? (send renderer get-volume-curve)
|
||||
'logarithmic)
|
||||
(check-= (send renderer
|
||||
logical-volume->device
|
||||
50)
|
||||
25
|
||||
0.001)
|
||||
(check-= (send renderer
|
||||
device-volume->logical
|
||||
25)
|
||||
50
|
||||
0.001))
|
||||
|
||||
(define renderer%
|
||||
(class object%
|
||||
(init-field
|
||||
id
|
||||
name
|
||||
kind
|
||||
device
|
||||
preferences)
|
||||
|
||||
(check/c* renderer%
|
||||
(id string?)
|
||||
(name string?)
|
||||
(kind symbol?)
|
||||
(preferences
|
||||
(is-a?/c renderer-preferences%)))
|
||||
|
||||
(define/public (get-id)
|
||||
id)
|
||||
|
||||
(define/public (get-name)
|
||||
name)
|
||||
|
||||
(define/public (get-kind)
|
||||
kind)
|
||||
|
||||
(define/public (get-device)
|
||||
device)
|
||||
|
||||
(define/public (get-volume-curve)
|
||||
(send preferences
|
||||
get-volume-curve
|
||||
id))
|
||||
|
||||
(define/public (set-volume-curve! curve)
|
||||
(send preferences
|
||||
set-volume-curve!
|
||||
id
|
||||
curve))
|
||||
|
||||
(define/private (clamp percentage)
|
||||
(min 100.0
|
||||
(max 0.0
|
||||
percentage)))
|
||||
|
||||
(define/public (logical-volume->device percentage)
|
||||
(let ((value
|
||||
(/ (clamp percentage)
|
||||
100.0)))
|
||||
(* 100.0
|
||||
(case (send this get-volume-curve)
|
||||
((logarithmic)
|
||||
(* value value))
|
||||
(else value)))))
|
||||
|
||||
(define/public (device-volume->logical percentage)
|
||||
(let ((value
|
||||
(/ (clamp percentage)
|
||||
100.0)))
|
||||
(* 100.0
|
||||
(case (send this get-volume-curve)
|
||||
((logarithmic)
|
||||
(sqrt value))
|
||||
(else value)))))
|
||||
|
||||
(super-new)))
|
||||
Reference in New Issue
Block a user