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,97 @@
+#lang racket/base
+
+(require net/url
+         racket/class
+         racket/string
+         "../../misc/utils.rkt")
+
+(provide media-resource%
+         media-resource-file%)
+
+(define media-resource%
+  (class object%
+    (init-field
+     uri
+     mime-type
+     protocol-info
+     seekable?)
+
+    (check/c* media-resource%
+              (uri string?)
+              (mime-type (or/c #f string?))
+              (protocol-info (or/c #f string?))
+              (seekable? boolean?))
+
+    (define/public (get-uri)
+      uri)
+
+    (define/public (get-mime-type)
+      mime-type)
+
+    (define/public (get-protocol-info)
+      protocol-info)
+
+    (define/public (is-seekable?)
+      seekable?)
+
+    (define/public (get-file)
+      #f)
+
+    (super-new)))
+
+(define media-resource-file%
+  (class media-resource%
+    (init
+     file
+     mime-type
+     [seekable? #t])
+
+    (check/c media-resource-file%
+             file
+             (or/c path? string?))
+
+    (define resource-file
+      (normal-case-path
+       (path->complete-path file)))
+
+    (define/override (get-file)
+      resource-file)
+
+    (super-new
+     [uri
+      (url->string
+       (path->url resource-file))]
+     [mime-type mime-type]
+     [protocol-info
+      (and mime-type
+           (format "file:*:~a:*" mime-type))]
+     [seekable? seekable?])))
+
+(module+ test
+  (require rackunit)
+
+  (define resource
+    (new media-resource-file%
+         [file
+          (build-path
+           (find-system-path 'temp-dir)
+           "track.flac")]
+         [mime-type "audio/flac"]))
+
+  (check-true
+   (is-a? resource media-resource%))
+  (check-true
+   (is-a? resource media-resource-file%))
+  (check-true
+   (path? (send resource get-file)))
+  (check-true
+   (string-prefix? (send resource get-uri)
+                   "file:"))
+  (check-equal?
+   (send resource get-mime-type)
+   "audio/flac")
+  (check-equal?
+   (send resource get-protocol-info)
+   "file:*:audio/flac:*")
+  (check-true
+   (send resource is-seekable?)))