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,82 @@
+#lang racket/base
+
+(require racket/class
+         "base/media-container.rkt"
+         "base/media-library.rkt"
+         "../misc/utils.rkt")
+
+(provide library-browser%)
+
+(define library-browser%
+  (class object%
+    (init-field media-library)
+
+    (check/c library-browser%
+             media-library
+             (is-a?/c media-library%))
+
+    (define current-container
+      #f)
+
+    (define parent-containers
+      '())
+
+    (define cfg-revision
+      -1)
+
+    (define/private (reset-if-needed!)
+      (let ((current-revision
+             (send (send media-library get-cfg)
+                   get-revision)))
+        (unless (= cfg-revision current-revision)
+          (set! cfg-revision current-revision)
+          (send this reset!))))
+
+    (define/public (get-media-library)
+      media-library)
+
+    (define/public (get-current-container)
+      (reset-if-needed!)
+      current-container)
+
+    (define/public (get-items)
+      (send (send this get-current-container)
+            get-items))
+
+    (define/public (can-go-up?)
+      (reset-if-needed!)
+      (not (null? parent-containers)))
+
+    (define/public (open-container! container)
+      (check/c library-browser% open-container!
+               container
+               (is-a?/c media-container%))
+
+      (reset-if-needed!)
+      (set! parent-containers
+            (cons current-container
+                  parent-containers))
+      (set! current-container container)
+      (void))
+
+    (define/public (go-up!)
+      (reset-if-needed!)
+      (unless (null? parent-containers)
+        (set! current-container
+              (car parent-containers))
+        (set! parent-containers
+              (cdr parent-containers)))
+      (void))
+
+    (define/public (reset!)
+      (set! cfg-revision
+            (send (send media-library get-cfg)
+                  get-revision))
+      (set! current-container
+            (send media-library get-root-container))
+      (set! parent-containers '())
+      (void))
+
+    (super-new)
+
+    (send this reset!)))