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,66 @@
+#lang racket/base
+
+(require racket/class
+         "mc-filesystem.rkt"
+         "library-factory.rkt"
+         "base/media-library.rkt"
+         "track-filesystem.rkt"
+         "../misc/utils.rkt")
+
+(provide library-filesystem%
+         register-library-filesystem!)
+
+(define library-filesystem-kind
+  'filesystem)
+
+(define library-filesystem-version
+  1)
+
+(define (register-library-filesystem! factory)
+  (check/c register-library-filesystem!
+           factory
+           (is-a?/c library-factory%))
+
+  (send factory
+        register-library-maker!
+        library-filesystem-kind
+        library-filesystem-version
+        (lambda (cfg)
+          (new library-filesystem%
+               [cfg cfg]))))
+
+(define library-filesystem%
+  (class media-library%
+    (init
+     cfg)
+
+    (define/override (make-root-container)
+      (new mc-filesystem%
+           [library this]
+           [relative-path '()]))
+
+    (define/public (make-container relative-path)
+      (new mc-filesystem%
+           [library this]
+           [relative-path relative-path]))
+
+    (define/public (make-track relative-path)
+      (new track-filesystem%
+           [library this]
+           [relative-path relative-path]))
+
+    (define/public (resolve-path relative-path)
+      (check/c library-filesystem% resolve-path
+               relative-path
+               list?)
+
+      (let ((root
+             (normal-case-path
+              (send (send this get-cfg)
+                    get-root))))
+        (if (null? relative-path)
+            root
+            (apply build-path root relative-path))))
+
+    (super-new
+     [cfg cfg])))