From 72991f2384497a942f085e285c866402fa4cc002 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Wed, 29 Jul 2026 16:22:04 +0200 Subject: [PATCH] dlna --- README.md | 10 +- dlna-player.rkt | 244 +++++++++++++++++++++++++++++++++++++++++++++++ gui.rkt | 127 ++++++++++++++++++++++-- libraries.rkt | 41 +++++++- player.rkt | 249 ++++++++++++++++++++++++++++++++---------------- translate.rkt | 15 +++ 6 files changed, 591 insertions(+), 95 deletions(-) create mode 100644 dlna-player.rkt diff --git a/README.md b/README.md index aff52a8..f78dbdb 100644 --- a/README.md +++ b/README.md @@ -1,3 +1,11 @@ # rktplayer -Racket Music Player \ No newline at end of file +Racket Music Player + +## DLNA playback + +Install the `racket-upnp` package before starting rktplayer. Choose +**Player > Find DLNA renderers** and then select a renderer from the same menu. +RktPlayer publishes the selected local media files on TCP port 8080 and sends +their URLs to the renderer. The renderer must therefore be able to reach the +computer running rktplayer on that port. diff --git a/dlna-player.rkt b/dlna-player.rkt new file mode 100644 index 0000000..1c56cda --- /dev/null +++ b/dlna-player.rkt @@ -0,0 +1,244 @@ +#lang racket + +(require racket/class + racket/path + racket/udp + racket-upnp + "utils.rkt") + +(provide dlna-player%) + +(define dlna-player% + (class object% + (init-field renderer + [port 8080] + [time-updater (lambda (time-s length-s) #t)] + [track-nr-updater (lambda (nr) #t)] + [state-updater (lambda (state) #t)] + [track-ended (lambda () #t)] + [track-changed (lambda (nr) #t)]) + + (define lock (make-semaphore 1)) + (define server #f) + (define poll-thread #f) + (define stopped #f) + (define requested-stop #t) + (define current-state 'stopped) + (define current-track-nr #f) + (define current-duration 0) + (define uri->track-nr (make-hash)) + + (define (with-renderer f) + (call-with-semaphore lock f)) + + (define (local-address) + (let ((socket (udp-open-socket))) + (dynamic-wind + void + (lambda () + (udp-connect! socket (media-renderer-address renderer) 1900) + (let-values (((address local-port remote-address remote-port) + (udp-addresses socket #t))) + address)) + (lambda () + (udp-close socket))))) + + (define (start-server) + (let ((address (local-address))) + (info-rktplayer + "Starting DLNA media server on ~a:~a for ~a" + address + port + (media-renderer-name renderer)) + (start-media-file-server + (format "http://~a:~a/media/" address port) + #:listen-ip address))) + + (define (file-url file track-nr) + (let* ((extension (path-get-extension file)) + (name (if extension + (format "track-~a~a" track-nr extension) + (format "track-~a" track-nr))) + (uri (media-file-server-publish! server file name))) + (hash-set! uri->track-nr uri track-nr) + uri)) + + (define (renderer-call what f) + (with-handlers + ((exn:fail? + (lambda (exception) + (warn-rktplayer + "Could not ~a on DLNA renderer ~a: ~a" + what + (media-renderer-name renderer) + (exn-message exception)) + #f))) + (with-renderer f))) + + (define (update-track uri) + (let ((nr (and uri (hash-ref uri->track-nr uri #f)))) + (when (and nr + (or (not current-track-nr) + (not (= nr current-track-nr)))) + (set! current-track-nr nr) + (track-nr-updater nr) + (track-changed nr)))) + + (define (poll) + (let ((reported-state + (renderer-call + "read playback state" + (lambda () + (media-renderer-status renderer))))) + (when reported-state + (let ((state (if (eq? reported-state 'no-media) + 'stopped + reported-state))) + (unless (eq? state current-state) + (set! current-state state) + (state-updater state)) + (when (or (eq? state 'playing) + (eq? state 'paused) + (eq? state 'transitioning)) + (let ((position + (renderer-call + "read playback position" + (lambda () + (media-renderer-position renderer))))) + (when position + (let ((seconds (transport-position-seconds position)) + (duration (transport-position-duration position))) + (when (and seconds duration) + (set! current-duration duration) + (time-updater seconds duration)) + (update-track (transport-position-uri position)))))) + (when (and (eq? state 'stopped) + (not requested-stop)) + (set! requested-stop #t) + (track-ended)))))) + + (define (poll-loop) + (let loop () + (unless stopped + (with-handlers + ((exn:fail? + (lambda (exception) + (warn-rktplayer + "DLNA polling failed for ~a: ~a" + (media-renderer-name renderer) + (exn-message exception))))) + (poll)) + (sleep 0.5) + (loop)))) + + (define/public (name) + (media-renderer-name renderer)) + + (define/public (next-uri-supported?) + (and (renderer-call + "inspect supported actions" + (lambda () + (media-renderer-next-uri-supported? renderer))) + #t)) + + (define/public (play-file! file track-nr + #:next-file (next-file #f) + #:next-track-nr (next-track-nr #f)) + (let ((uri (file-url file track-nr)) + (next-uri (and next-file + next-track-nr + (file-url next-file next-track-nr)))) + (set! requested-stop #f) + (set! current-track-nr track-nr) + (track-nr-updater track-nr) + (state-updater 'transitioning) + (if next-uri + (with-renderer + (lambda () + (media-renderer-play-uri! + renderer + uri + #:next-uri next-uri))) + (with-renderer + (lambda () + (media-renderer-play-uri! renderer uri)))))) + + (define/public (set-next-file! file track-nr) + (let ((uri (file-url file track-nr))) + (with-renderer + (lambda () + (media-renderer-set-next-uri! renderer uri))))) + + (define/public (clear-next!) + (with-renderer + (lambda () + (media-renderer-set-next-uri! renderer "")))) + + (define/public (pause!) + (with-renderer + (lambda () + (media-renderer-pause! renderer)))) + + (define/public (play!) + (with-renderer + (lambda () + (media-renderer-play! renderer)))) + + (define/public (stop!) + (set! requested-stop #t) + (with-renderer + (lambda () + (media-renderer-stop! renderer)))) + + (define/public (seek! percentage) + (when (> current-duration 0) + (with-renderer + (lambda () + (media-renderer-seek! + renderer + (* current-duration (/ percentage 100.0))))))) + + (define/public (volume) + (or (renderer-call + "read volume" + (lambda () + (media-renderer-volume renderer))) + 0)) + + (define/public (set-volume! percentage) + (renderer-call + "set volume" + (lambda () + (media-renderer-set-volume! + renderer + (max 0 + (min 100 + (inexact->exact + (round percentage)))))))) + + (define/public (quit) + (set! requested-stop #t) + (set! stopped #t) + (when poll-thread + (kill-thread poll-thread)) + (with-handlers + ((exn:fail? + (lambda (exception) + (dbg-rktplayer + "Could not stop DLNA renderer while quitting: ~a" + (exn-message exception))))) + (with-renderer + (lambda () + (media-renderer-stop! renderer)))) + (when server + (media-file-server-stop! server) + (set! server #f))) + + (super-new) + + (begin + (set! server (start-server)) + (set! poll-thread (thread poll-loop)) + (info-rktplayer + "DLNA player initialized for ~a" + (media-renderer-name renderer))))) diff --git a/gui.rkt b/gui.rkt index 617c7b2..8d576d3 100644 --- a/gui.rkt +++ b/gui.rkt @@ -24,7 +24,7 @@ (define player-menu - (λ () + (λ (player-submenu) (wv-menu 'main-menu (wv-menu-item 'm-file (tr 'file) #:submenu (wv-menu 'file-menu @@ -33,6 +33,9 @@ (wv-menu-item 'm-quit (tr 'quit) #:separator #t) ) ) + (wv-menu-item 'm-player + (tr 'player) + #:submenu player-submenu) ))) (define rktplayer% @@ -82,6 +85,116 @@ (define current-at-seconds 0) (define current-length-seconds 0) + (define dlna-renderers '()) + (define selected-dlna-renderer #f) + (define finding-dlna-renderers #f) + (define dlna-menu-items (make-hash)) + + (define (selected-dlna-renderer? renderer) + (and selected-dlna-renderer + (string=? + (send player dlna-renderer-name renderer) + (send player + dlna-renderer-name + selected-dlna-renderer)))) + + (define (make-player-submenu) + (hash-clear! dlna-menu-items) + (let ((items + (list + (wv-menu-item + 'm-player-local + (if (eq? (send player kind) 'local) + (format "[x] ~a" (tr 'local-player)) + (tr 'local-player))) + (wv-menu-item + 'm-find-dlna + (if finding-dlna-renderers + (tr 'finding-dlna-renderers) + (tr 'find-dlna-renderers)) + #:separator #t)))) + (let ((nr 0)) + (for-each + (lambda (renderer) + (let ((id (string->symbol (format "m-dlna-~a" nr))) + (name (send player dlna-renderer-name renderer))) + (hash-set! dlna-menu-items id renderer) + (set! items + (append + items + (list + (wv-menu-item + id + (if (selected-dlna-renderer? renderer) + (format "[x] ~a" name) + name))))) + (set! nr (+ nr 1)))) + dlna-renderers)) + (apply wv-menu 'player-menu items))) + + (define (install-menu) + (send this set-menu! (player-menu (make-player-submenu))) + (send this connect-menu! 'm-quit (lambda () (send this quit))) + (send this connect-menu! + 'm-select-library-dir + (lambda () (send this select-library))) + (send this connect-menu! + 'm-settings + (lambda () (send this settings-dlg))) + (send this connect-menu! + 'm-player-local + (lambda () + (send player change-player 'local) + (set! selected-dlna-renderer #f) + (install-menu))) + (send this connect-menu! + 'm-find-dlna + (lambda () + (send this find-dlna-renderers))) + (hash-for-each + dlna-menu-items + (lambda (id renderer) + (send this connect-menu! + id + (lambda () + (send this select-dlna-renderer renderer)))))) + + (define/public (find-dlna-renderers) + (unless finding-dlna-renderers + (set! finding-dlna-renderers #t) + (install-menu) + (thread + (lambda () + (let ((renderers + (with-handlers + ((exn:fail? + (lambda (exception) + (warn-rktplayer + "Could not find DLNA renderers: ~a" + (exn-message exception)) + '()))) + (send player query-dlna-renderers)))) + (queue-callback + (lambda () + (set! dlna-renderers renderers) + (set! finding-dlna-renderers #f) + (info-rktplayer + "Found ~a DLNA renderer(s)" + (length dlna-renderers)) + (install-menu)))))))) + + (define/public (select-dlna-renderer renderer) + (with-handlers + ((exn:fail? + (lambda (exception) + (message-box + (tr 'dlna-error) + (exn-message exception) + #f + '(ok stop))))) + (send player change-player 'dlna #:renderer renderer) + (set! selected-dlna-renderer renderer) + (install-menu))) (define/public (update-volume) (let ((el (send this element 'volume-percentage))) @@ -193,7 +306,9 @@ (unless (eq? st state) (dbg-rktplayer "Changing to state ~a" st) (let ((el (send this element 'paused))) - (cond ((or (eq? st 'playing) (eq? st 'play)) + (cond ((or (eq? st 'playing) + (eq? st 'play) + (eq? st 'transitioning)) (set-play-button "buttons/pause.svg") (send el set-innerHTML! (list 'span (tr 'playing)))) ((eq? st 'stopped) @@ -407,11 +522,7 @@ (set! el-channels (send this element 'channels)) (set! el-format (send this element 'format)) - (send this set-menu! (player-menu)) - (send this connect-menu! 'm-quit (λ () (send this quit))) - (send this connect-menu! 'm-select-library-dir (λ () (send this select-library))) - (send this connect-menu! 'm-settings (λ () (send this settings-dlg))) - (send this connect-menu! 'm-add-tab (λ () (send this add-tab))) + (install-menu) (dbg-rktplayer "page-loaded, playlist = ~a" playlist) (send this update-tabs) @@ -735,5 +846,3 @@ ) ) ) - - diff --git a/libraries.rkt b/libraries.rkt index 3121fb4..045f6c8 100644 --- a/libraries.rkt +++ b/libraries.rkt @@ -1,13 +1,14 @@ #lang racket/base -(require racket/class - "utils.rkt" - ) +(require racket/class) (provide libraries% library% ) +(define (new-id) + (string->symbol + (format "id-~a-~a" (current-milliseconds) (random 1000000)))) (define library% (class object% @@ -85,7 +86,7 @@ (define/public (add-library l) (let ((libs (send this libraries))) (send this set-libraries! - (cons (send l ->list) libs)) + (cons l libs)) (set! libs #f) (send l get-id))) @@ -111,4 +112,34 @@ )) (f (send this libraries)))) - )) \ No newline at end of file + )) + +(module+ test + (require rackunit) + + (define settings% + (class object% + (super-new) + (define values (make-hasheq)) + (define/public (clone section) this) + (define/public (get key default) + (hash-ref values key default)) + (define/public (set! key value) + (hash-set! values key value)))) + + (define settings (new settings%)) + (define libraries (new libraries% [settings settings])) + (define library + (new library% + [id 'test-library] + [name "Test library"] + [local-path "/music"] + [host ""] + [prefixes "/music"])) + + (check-eq? (send libraries add-library library) 'test-library) + (check-equal? (send settings get 'libraries #f) + '((test-library "Test library" "/music" "" "/music" #f))) + (check-equal? (send libraries count) 1) + (check-eq? (send libraries get-library 'test-library) + (car (send libraries libraries)))) diff --git a/player.rkt b/player.rkt index 92b8551..0a6ba68 100644 --- a/player.rkt +++ b/player.rkt @@ -2,7 +2,9 @@ (require racket/class racket-audio + racket-upnp "utils.rkt" + "dlna-player.rkt" lru-cache ) @@ -25,9 +27,11 @@ (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) @@ -56,6 +60,7 @@ ;; (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)) @@ -64,7 +69,9 @@ (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)))) + (begin + (set! current-track-nr track-nr) + (track-nr-updater track-nr))))) ) (state-updater st) (repeat-updater repeat) @@ -78,16 +85,63 @@ (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)))) + (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 (eq? player #f) + (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) @@ -98,36 +152,72 @@ (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 (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) - (audio-volume player)) + (if (eq? player-kind 'dlna) + (send dlna-player volume) + (audio-volume player))) (define/public (set-volume! percentage) (check-player) - (audio-volume! player percentage)) + (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 (eq? player #f) - (audio-stop! player)) + (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!) ) @@ -141,83 +231,79 @@ (check-player) (when (and (>= nr 0) (< nr (send playlist length))) (let ((track (send playlist track nr))) - (let ((id (audio-play! player (send track get-file)))) - (register-music-id&track-nr id 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 (= 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") - (begin - (cond - ((eq? repeat 'repeat-one) (play-track track-nr)) - ((eq? repeat 'repeat-all) - (set! track-nr (+ track-nr 1)) - (when (>= track-nr (send playlist length)) - (set! track-nr 0)) - (play-track track-nr)) - (else - (set! track-nr (+ track-nr 1)) - (if (>= track-nr (send playlist length)) - (stop) - (play-track track-nr))) - ) - ) - ) - ) - ) - ) + (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 (= 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") - (begin - (cond - ((eq? repeat 'repeat-one) (play-track track-nr)) - ((eq? repeat 'repeat-all) - (set! track-nr (- track-nr 1)) - (when (< track-nr 0) - (set! track-nr (- (send playlist length) 1))) - (play-track track-nr)) - (else - (set! track-nr (- track-nr 1)) - (when (< track-nr 0) (set! track-nr 0)) - (play-track track-nr)) - ) - ) - ) - ) - ) - ) + (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) - (audio-pause! player #t)) + (if (eq? player-kind 'dlna) + (send dlna-player pause!) + (audio-pause! player #t))) (define/public (play!) (check-player) - (audio-pause! player #f)) + (if (eq? player-kind 'dlna) + (send dlna-player play!) + (audio-pause! player #f))) (define/public (pause-unpause) (check-player) - (if (audio-paused? player) - (send this pause!) - (send this play!))) + (if (eq? state 'paused) + (send this play!) + (send this pause!))) (define/public (stop) (check-player) - (audio-stop! player)) + (if (eq? player-kind 'dlna) + (send dlna-player stop!) + (audio-stop! player))) (define/public (seek percentage) (check-player) - (audio-seek! player percentage)) + (if (eq? player-kind 'dlna) + (send dlna-player seek! percentage) + (audio-seek! player percentage))) (define/public (get-repeat) (check-player) @@ -225,11 +311,14 @@ (define/public (repeat! r) (check-player) - (set! repeat r)) + (set! repeat r) + (repeat-updater repeat) + (when (and (eq? player-kind 'dlna) + current-track-nr) + (update-dlna-next current-track-nr))) (define/public (quit) - (unless (eq? player #f) - (audio-quit! player))) + (stop-current-player)) (super-new) diff --git a/translate.rkt b/translate.rkt index da6276b..fe5bf5d 100644 --- a/translate.rkt +++ b/translate.rkt @@ -139,6 +139,21 @@ ('file ('en "File") ('nl "Bestand")) + ('player + ('en "Player") + ('nl "Speler")) + ('local-player + ('en "Local") + ('nl "Lokaal")) + ('find-dlna-renderers + ('en "Find DLNA renderers") + ('nl "Zoek DLNA-renderers")) + ('finding-dlna-renderers + ('en "Finding DLNA renderers...") + ('nl "DLNA-renderers zoeken...")) + ('dlna-error + ('en "DLNA error") + ('nl "DLNA-fout")) ('playing ('en "playing") ('nl "speelt"))