opus conversie

2026-06-09 08:41:01 +02:00
parent 92c8e40518
commit ce5c4d6de5
18 changed files with 1202 additions and 86 deletions
@@ -0,0 +1,55 @@
+#lang racket/base
+
+(require racket/file
+         racket/list
+         racket/path
+         racket/string)
+
+(provide sidecar-cover-path
+         ensure-flac-sidecar-picture!)
+
+(define cover-names '("cover.jpg" "folder.jpg" "cover.png" "folder.png"))
+
+(define (path-name-ci=? p s)
+  (define-values (_base name _dir?) (split-path p))
+  (and (path? name) (string-ci=? (path->string name) s)))
+
+(define (sidecar-cover-path audio-path)
+  (define-values (dir _name _dir?) (split-path audio-path))
+  (and (path? dir)
+       (for/or ([wanted (in-list cover-names)])
+         (or (let ([candidate (build-path dir wanted)])
+               (and (file-exists? candidate) candidate))
+             (for/or ([p (in-list (with-handlers ([exn:fail? (lambda (_) '())])
+                                    (directory-list dir #:build? #t)))])
+               (and (file-exists? p) (path-name-ci=? p wanted) p))))))
+
+(define (cover-mimetype path)
+  (define ext (let-values ([(base name dir?) (split-path path)])
+                (and (path? name) (path-get-extension name))))
+  (cond [(and ext (member (string-downcase (bytes->string/utf-8 ext)) '(".jpg" ".jpeg"))) "image/jpeg"]
+        [(and ext (string-ci=? (bytes->string/utf-8 ext) ".png")) "image/png"]
+        [else (error 'cover-mimetype "unsupported cover image extension: ~a" path)]))
+
+(define (ensure-flac-sidecar-picture! flac-path)
+  (define cover (sidecar-cover-path flac-path))
+  (and cover
+       (let ()
+         (define call-with-id3-tags (dynamic-require 'racket-audio/taglib 'call-with-id3-tags))
+         (define tags-valid? (dynamic-require 'racket-audio/taglib 'tags-valid?))
+         (define tags-picture (dynamic-require 'racket-audio/taglib 'tags-picture))
+         (define tags-picture! (dynamic-require 'racket-audio/taglib 'tags-picture!))
+         (define tags-save! (dynamic-require 'racket-audio/taglib 'tags-save!))
+         (define make-tags-picture (dynamic-require 'racket-audio/taglib 'make-tags-picture))
+         (call-with-id3-tags
+          flac-path
+          (lambda (tags)
+            (cond [(not (tags-valid? tags)) #f]
+                  [(tags-picture tags) #f]
+                  [else
+                   (define picture (make-tags-picture (cover-mimetype cover) 3 (file->bytes cover)
+                                                      #:description "Front cover"))
+                   (tags-picture! tags picture)
+                   (tags-save! tags)
+                   cover]))
+          #:mode 'read-write))))