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,159 @@
+#lang racket
+
+(require racket-audio
+         "base/booklet-provider.rkt"
+         "base/image-provider.rkt"
+         "base/tag-data-provider.rkt"
+         "track-tag-data.rkt")
+
+(provide tag-source-filesystem%
+         tag-data-provider-filesystem%
+         image-provider-filesystem%
+         booklet-provider-filesystem%)
+
+(define tag-source-filesystem%
+  (class object%
+    (init-field file)
+
+    (define tags
+      #f)
+
+    (define loaded?
+      #f)
+
+    (define/private (read-tags)
+      (if (and file (file-exists? file))
+          (let* ((source-file
+                  (if (path? file)
+                      (path->string file)
+                      file))
+                 (source-tags (id3-tags source-file)))
+            (if (tags-valid? source-tags)
+                source-tags
+                (let ((temporary-file
+                       (make-temporary-file
+                        "rktplayer-~a"
+                        #:copy-from source-file)))
+                  (let ((temporary-tags
+                         (id3-tags temporary-file)))
+                    (delete-file temporary-file)
+                    temporary-tags))))
+          #f))
+
+    (define/public (get-tags)
+      (unless loaded?
+        (set! tags (read-tags))
+        (set! loaded? #t))
+      tags)
+
+    (super-new)))
+
+(define tag-data-provider-filesystem%
+  (class tag-data-provider%
+    (init-field
+     tag-source
+     [fallback-data (track-tag-data "" "" "" 0 0)])
+
+    (define tag-data
+      #f)
+
+    (define/override (get-tag-data)
+      (unless tag-data
+        (let ((tags (send tag-source get-tags)))
+          (set! tag-data
+                (if (and tags (tags-valid? tags))
+                    (track-tag-data
+                     (tags-title tags)
+                     (tags-artist tags)
+                     (tags-album tags)
+                     (tags-track tags)
+                     (tags-length tags))
+                    fallback-data))))
+      tag-data)
+
+    (super-new)))
+
+(define image-provider-filesystem%
+  (class image-provider%
+    (init-field file tag-source)
+
+    (define image-names
+      '("cover.jpg" "cover.png" "folder.jpg" "folder.png"))
+
+    (define/private (image-from-directory)
+      (and file
+           (let ((directory (path-only file)))
+             (for/first ((image-name (in-list image-names))
+                         #:when
+                         (file-exists?
+                          (build-path directory image-name)))
+               (build-path directory image-name)))))
+
+    (define/override (has-image?)
+      (let ((tags (send tag-source get-tags)))
+        (or (and tags
+                 (tags-valid? tags)
+                 (not (eq? (tags-picture->ext tags) #f)))
+            (not (eq? (image-from-directory) #f)))))
+
+    (define/override (image->file target-file)
+      (let* ((target (format "~a" target-file))
+             (tags (send tag-source get-tags))
+             (picture-extension
+              (and tags
+                   (tags-valid? tags)
+                   (tags-picture->ext tags))))
+        (if picture-extension
+            (let ((stored-file
+                   (string-append
+                    target
+                    "."
+                    (symbol->string picture-extension))))
+              (and (tags-picture->file tags stored-file)
+                   stored-file))
+            (let ((source-file (image-from-directory)))
+              (and source-file
+                   (let ((stored-file
+                          (string-append
+                           target
+                           (bytes->string/utf-8
+                            (path-get-extension source-file)))))
+                     (copy-file source-file
+                                stored-file
+                                #:exists-ok? #t)
+                     (format "~a" stored-file)))))))
+
+    (define/override (image->mimetype)
+      (let ((tags (send tag-source get-tags)))
+        (if (and tags
+                 (tags-valid? tags)
+                 (not (eq? (tags-picture->ext tags) #f)))
+            (tags-picture->mimetype tags)
+            (let ((source-file (image-from-directory)))
+              (if source-file
+                  (case (string->symbol
+                         (string-downcase
+                          (bytes->string/utf-8
+                           (path-get-extension source-file))))
+                    ((|.jpg| |.jpeg|) "image/jpeg")
+                    ((|.png|) "image/png")
+                    (else 'no-mimetype))
+                  'no-mimetype)))))
+
+    (super-new)))
+
+(define booklet-provider-filesystem%
+  (class booklet-provider%
+    (init-field file)
+
+    (define/override (booklet-file)
+      (and file
+           (build-path (path-only file)
+                       "booklet.pdf")))
+
+    (define/override (has-booklet?)
+      (let ((booklet (send this booklet-file)))
+        (and booklet
+             (file-exists? booklet))))
+
+    (super-new)))