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,175 @@
+#lang racket/base
+
+(require racket/class
+         racket/match
+         "library-factory.rkt"
+         "library-ref.rkt"
+         "base/track.rkt"
+         "../misc/utils.rkt")
+
+(provide track-store?
+         track-store-id
+         track-store-number
+         track-store-title
+         track->store
+         store->track)
+
+(define track-store-version
+  1)
+
+(define (track-store? stored)
+  (match stored
+    ((list 'track
+           (== track-store-version)
+           _
+           number
+           title
+           library-reference
+           track-factory-id
+           _)
+     (and (exact-integer? number)
+          (string? title)
+          (library-ref? library-reference)
+          (symbol? track-factory-id)))
+    (else #f)))
+
+(define (track-store-id stored)
+  (check/c track-store-id stored track-store?)
+  (list-ref stored 2))
+
+(define (track-store-number stored)
+  (check/c track-store-number stored track-store?)
+  (list-ref stored 3))
+
+(define (track-store-title stored)
+  (check/c track-store-title stored track-store?)
+  (list-ref stored 4))
+
+(define (track->store track)
+  (check/c track->store track (is-a?/c track<%>))
+
+  (let ((stored
+         (list 'track
+               track-store-version
+               (send track get-id)
+               (send track get-number)
+               (send track get-title)
+               (send track get-music-library-factory-id)
+               (send track get-track-factory-id)
+               (send track get-track-relive-info))))
+    (check/c track->store stored track-store?)
+    stored))
+
+(define (store->track stored factory)
+  (check/c store->track
+           factory
+           (is-a?/c library-factory%))
+
+  (and
+   (track-store? stored)
+   (with-handlers ((exn:fail?
+                    (lambda (_)
+                      #f)))
+     (let* ((library-reference (list-ref stored 5))
+            (library
+             (send factory
+                   get-library
+                   (library-ref-library-id library-reference)
+                   (library-ref-kind library-reference)
+                   (library-ref-version library-reference)))
+            (root-container
+             (send library get-root-container))
+            (track-reliver
+             (send root-container get-track-reliver))
+            (track
+             (track-reliver
+              (list-ref stored 6)
+              (list-ref stored 7))))
+       (and (object? track)
+            (is-a? track track<%>)
+            track)))))
+
+(module+ test
+  (require rackunit
+           racket/file
+           "libraries-config.rkt"
+           "library-filesystem.rkt"
+           "library-item.rkt")
+
+  (define settings%
+    (class object%
+      (define values
+        (make-hash))
+
+      (define/public (clone _)
+        this)
+
+      (define/public (get key default)
+        (hash-ref values key default))
+
+      (define/public (set! key value)
+        (hash-set! values key value))
+
+      (super-new)))
+
+  (define root
+    (make-temporary-file
+     "rktplayer-track-store-~a"
+     'directory))
+
+  (define file-name
+    "track.mp3")
+
+  (define file
+    (build-path root file-name))
+
+  (dynamic-wind
+    (lambda ()
+      (call-with-output-file file void))
+    (lambda ()
+      (let* ((libraries-config
+              (new libraries-config%
+                   [settings (new settings%)]))
+             (factory
+              (new library-factory%
+                   [libraries-config libraries-config])))
+        (send libraries-config
+              add-library
+              (library-item
+               'test-library
+               "Test library"
+               'filesystem
+               1
+               root
+               #f
+               100
+               #t))
+        (register-library-filesystem! factory)
+
+        (let* ((library
+                (send factory
+                      get-library
+                      'test-library
+                      'filesystem
+                      1))
+               (track
+                (send library
+                      make-track
+                      (list (string->path file-name))))
+               (stored (track->store track))
+               (relived (store->track stored factory)))
+          (check-true (track-store? stored))
+          (check-equal? (track-store-id stored)
+                        (send track get-id))
+          (check-equal? (track-store-number stored)
+                        (send track get-number))
+          (check-equal? (track-store-title stored)
+                        (send track get-title))
+          (check-true (is-a? relived track<%>))
+          (check-equal?
+           (normal-case-path
+            (send (send relived get-resource)
+                  get-file))
+           (normal-case-path file)))))
+    (lambda ()
+      (delete-directory/files root))))