generic audio decoder framework implemented

2026-04-21 18:01:33 +02:00
parent fd124f594a
commit 630a0423a0
3 changed files with 182 additions and 14 deletions
@@ -0,0 +1,159 @@
+(module audio-decoder racket/base
+
+  (require "flac-decoder.rkt"
+           racket/contract
+           racket/string
+           racket/path
+           )
+
+  (provide audio-open
+           audio-read
+           audio-stop
+           audio-seek
+           audio-kind
+           audio-valid-ext?
+           audio-file-valid?
+           audio-known-exts?
+           audio-register-reader!
+           make-audio-reader
+           audio-handle?
+           )
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Audio readers
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  
+  (define-struct audio-reader
+    (exts open reader seeker stopper))
+
+  ;; audiotype, audio-reader
+  (define audio-readers (make-hash))
+  
+  (hash-set! audio-readers
+             'flac
+             (make-audio-reader '("flac")
+                                flac-open
+                                flac-read
+                                flac-seek
+                                flac-stop))
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Known extensions
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define known-extensions
+    '("flac"))
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Register audio reader
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define/contract (audio-register-reader! type reader)
+    (-> symbol? audio-reader? void?)
+    (set! known-extensions (append known-extensions (audio-reader-exts reader)))
+    (hash-set! audio-readers type reader))
+  
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Generic audio reader
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define-struct audio-handle
+    ((kind #:mutable)
+     (cb-stream-info #:mutable)
+     (cb-audio #:mutable)
+     (driver #:mutable)
+     (driver-handle #:mutable)
+     )
+    )
+
+  (define (audio-known-exts?)
+    known-extensions)
+
+  (define/contract (audio-kind handle)
+    (-> audio-handle? symbol?)
+    (audio-handle-kind handle))
+
+  (define (audio-valid-ext? ext)
+    (set! ext (format "~a" ext))
+    (when (string-prefix? ext ".")
+      (set! ext (substring ext 1)))
+    (not (null? (filter (λ (e) (string-ci=? ext e)) known-extensions)))
+    )
+
+  (define/contract (audio-file-valid? file)
+    (-> (or/c string? path?) boolean?)
+    (let ((f (build-path file)))
+      (let ((e (format "~a" (path-get-extension f))))
+        (audio-valid-ext? e))))
+
+  (define/contract (audio-open audio-file cb-stream-info cb-audio)
+    (-> (or/c string? path?) procedure? procedure? audio-handle?)
+    (let ((file (if (path? audio-file)
+                    (path->string audio-file)
+                    audio-file)))
+      (unless (audio-file-valid? audio-file)
+        (error (format "Not a valid audio file '~a'" audio-file)))
+      (unless (file-exists? audio-file)
+        (error (format "File '~a' does not exist" audio-file)))
+      (let ((reader* (find-reader audio-file)))
+        (when (eq? reader* #f)
+          (error (format "Cannot find reader for '~a'" audio-file)))
+        (let* ((reader-type (car reader*))
+               (reader (cadr reader*))
+               (handle (make-audio-handle reader-type cb-stream-info cb-audio reader #f))
+               )
+          (set-audio-handle-driver-handle!
+           handle
+           ((audio-reader-open reader)
+                                file
+                                (λ (meta)
+                                  (cb-stream-info reader-type handle meta))
+                                (λ (buf-info audio-buffer buf-len)
+                                  (cb-audio reader-type handle buf-info audio-buffer buf-len)))
+             )
+          handle)
+        )
+      )
+    )
+
+  (define/contract (audio-read handle)
+    (-> audio-handle? void?)
+    (let ((reader (audio-reader-reader (audio-handle-driver handle))))
+      (void? (reader (audio-handle-driver-handle handle)))))
+
+  (define/contract (audio-seek handle percentage)
+    (-> audio-handle? number? void?)
+    (let ((seeker (audio-reader-seeker (audio-handle-driver handle))))
+      (void (seeker (audio-handle-driver-handle handle) percentage))))
+
+  (define/contract (audio-stop handle)
+    (-> audio-handle? void?)
+    (let ((stopper (audio-reader-stopper (audio-handle-driver handle))))
+      (void (stopper (audio-handle-driver-handle handle)))))
+      
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; Utils
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (define (right-reader? reader ext)
+    (not (null? (filter (λ (e) (string-ci=? ext e)) (audio-reader-exts reader)))))
+
+  (define (find-reader audio-file)
+    (let* ((f (build-path audio-file))
+           (ext (substring (format "~a" (path-get-extension audio-file)) 1)))
+      (letrec ((f (λ (keys)
+                    (if (null? keys)
+                        #f
+                        (let ((reader (hash-ref audio-readers (car keys))))
+                          (if (right-reader? reader ext)
+                              (list (car keys) reader)
+                              (f (cdr keys))))))))
+        (f (hash-keys audio-readers))
+        )
+      )
+    )
+      
+) ; end of module
+          
+
+