Files
racket-audio/audio-decoder.rkt
2026-05-04 12:21:43 +02:00

263 lines
9.5 KiB
Racket

(module audio-decoder racket/base
(require "flac-decoder.rkt"
"mp3-decoder.rkt"
"ffmpeg-decoder.rkt"
"audio-sniffer.rkt"
"private/utils.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-supported-extensions
)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Audio readers
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define-struct audio-reader
(exts valid? open reader seeker stopper ao-type))
;; audiotype, audio-reader
(define audio-readers (make-hash))
;; FLAC
(hash-set! audio-readers
'flac
(make-audio-reader '("flac")
flac-valid?
flac-open
flac-read
flac-seek
flac-stop
'ao))
;; MP3
(hash-set! audio-readers
'mp3
(make-audio-reader '("mp3")
mp3-valid?
mp3-open
mp3-read
mp3-seek
mp3-stop
'ao))
;; FFmpeg decodere
(hash-set! audio-readers
'ffmpeg
(make-audio-reader '("ogg" "oga" "opus"
"m4a" "mp4" "m4b"
"aac"
"wav"
"aiff" "aif" "aifc"
"wma"
"webm" "mkv" "mka")
ffmpeg-valid?
ffmpeg-open
ffmpeg-read
ffmpeg-seek
ffmpeg-stop
'ao))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Known extensions
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define known-extensions
'("flac" ; FLAC decoder
"mp3" ; mp3 decoder
"ogg" "oga" "opus"
"m4a" "mp4" "m4b"
"aac"
"wav"
"aiff" "aif" "aifc"
"wma"
"webm" "mkv" "mka" ; FFMPEG decoder
))
(define (audio-supported-extensions)
known-extensions)
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))
(if (not (null? (filter (λ (e) (string-ci=? ext e)) known-extensions)))
#t
(begin
(warn-sound "extension '~a' not in known-extensions '~a'" ext known-extensions)
#f))
)
(define/contract (audio-file-valid? file)
(-> (or/c string? path?) boolean?)
(let ((f (build-path file)))
(let ((e (format "~a" (path-get-extension f))))
(if (audio-valid-ext? e)
(let ((reader (find-reader file)))
(if (eq? reader #f)
#f
((audio-reader-valid? (cadr reader)) file)))
#f))))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
; cb-stream-info will be called with
; - audio-type: symbol? (e.g. 'flac, 'mp3)
; - ao-type: symbol? - e.g. 'flac, 'ao (ao means the buffer can be used directly by aolib).
; - handle: audio-handle?
; - meta: hash?
; Meta information must at least contain:
; ('duration . seconds) - duration of the audio in seconds (or fractions): double
; ('bits-per-sample . integer) - number of audio bits per sample
; ('channels . integer) - number of audio channels
; ('sample-rate . integer) - number of samples per second per channel
; ('total-samples . integer) - total number of samples of the audio
;
; cb-audio will be called with
; - audio-type: symbol?
; - ao-type: symbol? - e.g. 'flac, 'ao (ao means the buffer can be used directly by aolib).
; - handle: audio-handle?
; - buf-info: hash?
; - buffer: cpointer? - contains data to be fed to ao - must be owned / released by the driver
; the ao-async backend will copy the data
; - buf-size: integer? - contains the size of the data
; buf-info must at least contain:
; ('duration . seconds) - duration of the audio in seconds (or fractions): double
; ('bits-per-sample . integer) - number of audio bits per sample
; ('channels . integer) - number of audio channels
; ('sample-rate . integer) - number of samples per second per channel
; ('total-samples . integer) - total number of samples of the audio
; (sample . integer) - the current sample the audio buffer applies to.
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(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*))
(ao-type (audio-reader-ao-type 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 ao-type handle meta))
(λ (buf-info audio-buffer buf-len)
(cb-audio reader-type ao-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 reader-for-kind
(make-hash '((mp3 . ffmpeg) ; ffmpeg does a better job on gapless playback...
(flac . flac)
(ogg . ffmpeg)
(vorbis . ffmpeg)
(opus . ffmpeg)
(wav . ffmpeg)
(aiff . ffmpeg)
(mp4 . ffmpeg)
(aac . ffmpeg)
(alac . ffmpeg)
(ac3 . ffmpeg)
(ape . ffmpeg)
(wavpack . ffmpeg)
(wma . ffmpeg)
(matroska . ffmpeg))))
(define (find-reader audio-file)
; First try to sniff the format
(let ((format (audio-sniff-format/extension audio-file)))
(let ((reader-kind (hash-ref reader-for-kind format #f)))
(if (eq? reader-kind #f)
#f
(let ((reader (hash-ref audio-readers reader-kind)))
(list reader-kind reader))
)
)
)
)
) ; end of module