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,86 @@
+#lang racket/base
+
+(require racket/class
+         racket/list
+         racket/string
+         (prefix-in upnp: racket-upnp)
+         "base/media-container.rkt"
+         "../misc/utils.rkt")
+
+(provide mc-media-server%)
+
+(define mc-media-server%
+  (class media-container%
+    (init-field
+     library
+     container-id
+     title)
+
+    (check/c* mc-media-server%
+              (library object?)
+              (container-id string?)
+              (title string?))
+
+    (define/private (audio-item? entry)
+      (and
+       (upnp:media-item? entry)
+       (string? (upnp:media-entry-id entry))
+       (string? (upnp:media-entry-parent-id entry))
+       (not
+        (null?
+         (upnp:media-item-resources entry)))
+       (or
+        (let ((class
+               (upnp:media-entry-class entry)))
+          (and class
+               (string-prefix?
+                class
+                "object.item.audioItem")))
+        (for/or
+            ((resource
+              (in-list
+               (upnp:media-item-resources entry))))
+          (let ((content-type
+                 (upnp:media-resource-content-type
+                  resource)))
+            (and content-type
+                 (string-prefix?
+                  content-type
+                  "audio/")))))))
+
+    (define/override (get-title)
+      title)
+
+    (define/override (get-items)
+      (filter-map
+       (lambda (entry)
+         (cond
+           ((and (upnp:media-container? entry)
+                 (string?
+                  (upnp:media-entry-id entry)))
+            (send library
+                  make-container
+                  entry))
+           ((audio-item? entry)
+            (send library
+                  make-track
+                  entry))
+           (else #f)))
+       (send library
+             browse-container
+             container-id)))
+
+    (define/override (get-track-reliver)
+      (lambda (track-factory-id
+               track-relive-info)
+        (send library
+              relive-track
+              track-factory-id
+              track-relive-info)))
+
+    (super-new
+     [id
+      (cons
+       (send (send library get-cfg)
+             get-id)
+       container-id)])))