Complete refactoring for rktplayer, in order to make it play on DLNA renderers and also use UpNP media server resources.

2026-08-08 14:29:01 +02:00
parent 186b3bb8d7
commit f5fdc38e67
69 changed files with 5953 additions and 1647 deletions
@@ -0,0 +1,113 @@
+#lang racket
+
+(require racket/class
+         racket/list
+         racket-sonos
+         racket-upnp
+         "renderer-sonos.rkt"
+         "renderer-upnp.rkt"
+         "../misc/utils.rkt")
+
+(provide check-dlna-players)
+
+(define running-sem (make-semaphore 1))
+(define running #f)
+
+(define (normalized-device-id device)
+  (let ((id (upnp-device-udn device)))
+    (and id
+         (let ((match
+                (regexp-match
+                 #px"(?i:RINCON_[0-9A-F]+)"
+                 id)))
+           (if match
+               (string-upcase
+                (car match))
+               (regexp-replace
+                #px"(?i:^uuid:)"
+                id
+                ""))))))
+
+(define (represented-by-sonos-group? device member-ids)
+  (let ((id (normalized-device-id device)))
+    (and id
+         (ormap
+          (lambda (member-id)
+            (string-ci=? id member-id))
+          member-ids))))
+
+(define (make-generic-renderers devices preferences
+                                #:excluded-ids [excluded-ids '()])
+  (for/list ((device
+              (in-list
+               (filter media-renderer? devices)))
+             #:unless
+             (represented-by-sonos-group?
+              device
+              excluded-ids))
+    (new renderer-upnp%
+         [upnp-device device]
+         [name
+          (if (sonos-device? device)
+              (sonos-device-name device)
+              #f)]
+         [preferences preferences])))
+
+(define (discover-renderers preferences)
+  (let* ((devices (query-upnp-devices 'all))
+         (groups
+          (with-handlers
+              ((exn:fail?
+                (lambda (e)
+                  (warn-rktplayer
+                   "Could not read Sonos topology; using generic UPnP renderers: ~a"
+                   (exn-message e))
+                  '())))
+            (sonos-groups devices)))
+         (renderers
+          (if (null? groups)
+              (make-generic-renderers
+               devices
+               preferences)
+              (append
+               (make-generic-renderers
+                devices
+                preferences
+                #:excluded-ids
+                (append-map
+                 sonos-group-member-ids
+                 groups))
+               (for/list ((group (in-list groups)))
+                 (new renderer-sonos%
+                      [sonos-group group]
+                      [preferences preferences]))))))
+    (sort renderers
+          string-ci<?
+          #:key
+          (lambda (renderer)
+            (send renderer get-name)))))
+
+(define (check-dlna-players gui preferences)
+  (let ((can-check
+         (begin
+           (semaphore-wait running-sem)
+           (let ((was-running running))
+             (unless was-running
+               (set! running #t))
+             (semaphore-post running-sem)
+             (not was-running)))))
+    (if can-check
+        (void
+         (thread
+          (lambda ()
+            (dynamic-wind
+              void
+              (lambda ()
+                (send gui
+                      set-dlna-renderers!
+                      (discover-renderers preferences)))
+              (lambda ()
+                (semaphore-wait running-sem)
+                (set! running #f)
+                (semaphore-post running-sem))))))
+        (send gui dlna-query-busy))))