#lang racket (require racket/class racket-audio racket-upnp "utils.rkt" "dlna-player.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 dlna-player #f) (define playlist #f) (define state 'stopped) (define repeat 'no-repeat) (define current-track-nr #f) (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))) (set! state st) (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") (begin (set! current-track-nr track-nr) (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))) (send this next))) (define (next-track-nr nr) (cond ((eq? repeat 'repeat-one) nr) ((< (+ nr 1) (send playlist length)) (+ nr 1)) ((eq? repeat 'repeat-all) 0) (else #f))) (define (update-dlna-next nr) (set! current-track-nr nr) (let ((next-nr (next-track-nr nr))) (when (send dlna-player next-uri-supported?) (if next-nr (let ((track (send playlist track next-nr))) (send dlna-player set-next-file! (send track get-file) next-nr)) (send dlna-player clear-next!))))) (define (dlna-track-changed nr) (update-dlna-next nr)) (define (make-dlna-player renderer port) (new dlna-player% [renderer renderer] [port port] [time-updater time-updater] [track-nr-updater (lambda (nr) (set! current-track-nr nr) (track-nr-updater nr))] [state-updater (lambda (new-state) (set! state new-state) (state-updater new-state))] [track-ended (lambda () (send this next))] [track-changed dlna-track-changed])) (define (stop-current-player) (unless (eq? player #f) (let ((old-player player)) (set! player #f) (audio-quit! old-player))) (unless (eq? dlna-player #f) (let ((old-player dlna-player)) (send old-player quit) (set! dlna-player #f)))) ;(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 (and (not (eq? player-kind 'dlna)) (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] #:renderer [renderer #f] #:port [port 8080]) (unless (member kind '(local remote dlna)) (raise-argument-error 'change-player "(or/c 'local 'remote 'dlna)" kind)) (when (and (eq? kind 'dlna) (not renderer)) (raise-arguments-error 'change-player "a media renderer is required for DLNA playback")) (stop-current-player) (set! player-kind kind) (set! player-host host) (set! player-basepaths basepaths) (set! current-track-nr #f) (set! state 'stopped) (state-updater state) (if (eq? player-kind 'dlna) (with-handlers ((exn:fail? (lambda (exception) (set! player-kind 'local) (when dlna-player (send dlna-player quit)) (set! dlna-player #f) (raise exception)))) (set! dlna-player (make-dlna-player renderer port)) (audio-info-cb 0 0 0 'dlna)) (audio-info-cb 0 0 0 'none))) (define/public (kind) player-kind) (define/public (query-dlna-renderers) (query-media-renderers)) (define/public (dlna-renderer-name renderer) (media-renderer-name renderer)) (define/public (get-volume) (check-player) (if (eq? player-kind 'dlna) (send dlna-player volume) (audio-volume player))) (define/public (set-volume! percentage) (check-player) (if (eq? player-kind 'dlna) (send dlna-player set-volume! percentage) (audio-volume! player percentage))) (define/public (set-list! playlist*) ;; if the player exists and is playing, stop it. (unless (and (eq? player #f) (eq? dlna-player #f)) (if (eq? player-kind 'dlna) (send dlna-player stop!) (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) (set! current-track-nr #f) ;; clear lru cache, because the playlist has been reset. (clear-music-ids!) ) (define/public (play playlist*) (check-player) (set-list! playlist*) (send this play-track 0)) (define/public (play-track nr) (check-player) (when (and (>= nr 0) (< nr (send playlist length))) (let ((track (send playlist track nr))) (set! current-track-nr nr) (if (eq? player-kind 'dlna) (let ((next-nr (next-track-nr nr))) (if (and next-nr (send dlna-player next-uri-supported?)) (let ((next-track (send playlist track next-nr))) (send dlna-player play-file! (send track get-file) nr #:next-file (send next-track get-file) #:next-track-nr next-nr)) (send dlna-player play-file! (send track get-file) nr))) (let ((id (audio-play! player (send track get-file)))) (register-music-id&track-nr id nr)))))) (define/public (next) (check-player) (if current-track-nr (let ((nr (next-track-nr current-track-nr))) (if nr (play-track nr) (stop))) (warn-rktplayer "No current track set, so can't play anything next"))) (define/public (previous) (check-player) (if current-track-nr (let ((nr (if (eq? repeat 'repeat-one) current-track-nr (- current-track-nr 1)))) (when (< nr 0) (set! nr (if (eq? repeat 'repeat-all) (- (send playlist length) 1) 0))) (play-track nr)) (warn-rktplayer "No current track set, so can't play anything previous"))) (define/public (pause!) (check-player) (if (eq? player-kind 'dlna) (send dlna-player pause!) (audio-pause! player #t))) (define/public (play!) (check-player) (if (eq? player-kind 'dlna) (send dlna-player play!) (audio-pause! player #f))) (define/public (pause-unpause) (check-player) (if (eq? state 'paused) (send this play!) (send this pause!))) (define/public (stop) (check-player) (if (eq? player-kind 'dlna) (send dlna-player stop!) (audio-stop! player))) (define/public (seek percentage) (check-player) (if (eq? player-kind 'dlna) (send dlna-player seek! percentage) (audio-seek! player percentage))) (define/public (get-repeat) (check-player) repeat) (define/public (repeat! r) (check-player) (set! repeat r) (repeat-updater repeat) (when (and (eq? player-kind 'dlna) current-track-nr) (update-dlna-next current-track-nr))) (define/public (quit) (stop-current-player)) (super-new) (begin (dbg-rktplayer "player% initialized") ) ) )