From d78a0ae9ff21ccb51654a264037939de114f4dce Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Tue, 28 Apr 2026 09:48:12 +0200 Subject: [PATCH] ffmpeg support and audio sniffing --- audio-sniffer.rkt | 336 +++++++++++++++++++++++++++++++++++++++++++++ ffmpeg-decoder.rkt | 156 +++++++++++++++++++++ ffmpeg-ffi.rkt | 324 +++++++++++++++++++++++++++++++++++++++++++ 3 files changed, 816 insertions(+) create mode 100644 audio-sniffer.rkt create mode 100644 ffmpeg-decoder.rkt create mode 100644 ffmpeg-ffi.rkt diff --git a/audio-sniffer.rkt b/audio-sniffer.rkt new file mode 100644 index 0000000..250dfe8 --- /dev/null +++ b/audio-sniffer.rkt @@ -0,0 +1,336 @@ +#lang racket/base + +(require racket/contract + racket/path + racket/string) + +(provide audio-format? + audio-sniff-format + audio-sniff-format/extension + audio-sniff-extension + audio-format-matches? + audio-format-known?) + +(define audio-formats + '(mp3 flac ogg vorbis opus wav aiff + mp4 aac alac encrypted-audio + ac3 ape wavpack wma matroska)) + +(define audio-status-formats + '(unknown file-not-found file-not-readable not-a-file)) + +(define known-formats + (append audio-formats audio-status-formats)) + +(define (audio-format? v) + (not (eq? (memq v known-formats) #f))) + +(define sniff-bytes 4096) + +(define mp4-head-peek-sizes + '(4096 8192 16384 32768 65536 131072 153600)) + +(define mp4-tail-peek-blocks + '(4096 8192 16384 32768 65536 65536)) + +(define (audio-sniff-extension* file) + (let ([ext (path-get-extension (build-path file))]) + (cond + [(not ext) #f] + [else + (let ([s (string-downcase (bytes->string/utf-8 ext #\?))]) + (if (and (> (string-length s) 0) + (char=? (string-ref s 0) #\.)) + (substring s 1) + s))]))) + +(define (file-readable-status file) + (cond + [(not (file-exists? file)) 'file-not-found] + [else + (let ([typ (file-or-directory-type file #f)]) + (cond + [(not typ) 'file-not-found] + [(not (eq? typ 'file)) 'not-a-file] + [else #t]))])) + +(define (read-prefix/status file [n sniff-bytes]) + (with-handlers ([exn:fail:filesystem? + (lambda (_) 'file-not-readable)]) + (call-with-input-file file + (lambda (in) + (let ([b (read-bytes n in)]) + (if (eof-object? b) #"" b))) + #:mode 'binary))) + +(define (read-block/status file start size) + (with-handlers ([exn:fail:filesystem? + (lambda (_) 'file-not-readable)]) + (call-with-input-file file + (lambda (in) + (file-position in start) + (let ([b (read-bytes size in)]) + (if (eof-object? b) #"" b))) + #:mode 'binary))) + +(define (u8 b i) + (bytes-ref b i)) + +(define (bytes-prefix? b prefix) + (and (>= (bytes-length b) (bytes-length prefix)) + (bytes=? (subbytes b 0 (bytes-length prefix)) prefix))) + +(define (bytes-at? b pos marker) + (and (>= (bytes-length b) (+ pos (bytes-length marker))) + (bytes=? (subbytes b pos (+ pos (bytes-length marker))) + marker))) + +(define (bytes-contains? b marker) + (let ([blen (bytes-length b)] + [mlen (bytes-length marker)]) + (cond + [(zero? mlen) #t] + [(< blen mlen) #f] + [else + (let loop ([i 0]) + (cond + [(> (+ i mlen) blen) #f] + [(bytes=? (subbytes b i (+ i mlen)) marker) #t] + [else (loop (add1 i))]))]))) + +(define asf-guid + (bytes #x30 #x26 #xb2 #x75 #x8e #x66 #xcf #x11 + #xa6 #xd9 #x00 #xaa #x00 #x62 #xce #x6c)) + +(define (riff-wave? b) + (and (bytes-at? b 0 #"RIFF") + (bytes-at? b 8 #"WAVE"))) + +(define (aiff? b) + (and (bytes-at? b 0 #"FORM") + (or (bytes-at? b 8 #"AIFF") + (bytes-at? b 8 #"AIFC")))) + +(define (iso-bmff? b) + (bytes-at? b 4 #"ftyp")) + +(define (matroska-or-webm? b) + (bytes-prefix? b #"\x1a\x45\xdf\xa3")) + +(define (ac3? b) + (bytes-prefix? b #"\x0b\x77")) + +(define (ape? b) + (bytes-prefix? b #"MAC ")) + +(define (wavpack? b) + (bytes-prefix? b #"wvpk")) + +(define (sniff-ogg-subtype b) + (cond + [(bytes-contains? b #"OpusHead") 'opus] + [(bytes-contains? b #"\x01vorbis") 'vorbis] + [(bytes-contains? b #"vorbis") 'vorbis] + [(bytes-contains? b #"fLaC") 'flac] + [else 'ogg])) + +(define (mp4-codec-peek b) + (cond + [(bytes-contains? b #"enca") 'encrypted-audio] + [(bytes-contains? b #"alac") 'alac] + [(bytes-contains? b #"mp4a") 'aac] + [else #f])) + +(define (mp4-codec-peek/tail file) + (with-handlers ([exn:fail:filesystem? + (lambda (_) 'file-not-readable)]) + (let ([file-len (file-size file)]) + (let loop ([blocks mp4-tail-peek-blocks] + [end file-len]) + (cond + [(null? blocks) #f] + [(<= end 0) #f] + [else + (let* ([block-size (car blocks)] + [start (max 0 (- end block-size))] + [size (- end start)] + [b (read-block/status file start size)]) + (cond + [(not (bytes? b)) b] + [else + (let ([r (mp4-codec-peek b)]) + (if r + r + (loop (cdr blocks) start)))]))]))))) + +(define (mp4-codec-peek/head file) + (let loop ([sizes (cdr mp4-head-peek-sizes)]) + (cond + [(null? sizes) #f] + [else + (let ([b (read-prefix/status file (car sizes))]) + (cond + [(not (bytes? b)) b] + [else + (let ([r (mp4-codec-peek b)]) + (if r + r + (loop (cdr sizes))))]))]))) + +(define (mp4-codec-peek/file file head) + (let ([r0 (mp4-codec-peek head)]) + (cond + [r0 r0] + [else + (let ([rtail (mp4-codec-peek/tail file)]) + (cond + [rtail rtail] + [else + (let ([rhead (mp4-codec-peek/head file)]) + (if rhead rhead #f))]))]))) + +(define (id3? b) + (and (bytes-at? b 0 #"ID3") + (>= (bytes-length b) 10) + (not (= (u8 b 3) #xff)) + (not (= (u8 b 4) #xff)) + (zero? (bitwise-and (u8 b 6) #x80)) + (zero? (bitwise-and (u8 b 7) #x80)) + (zero? (bitwise-and (u8 b 8) #x80)) + (zero? (bitwise-and (u8 b 9) #x80)))) + +(define (synchsafe-size b0 b1 b2 b3) + (+ (arithmetic-shift b0 21) + (arithmetic-shift b1 14) + (arithmetic-shift b2 7) + b3)) + +(define (id3-total-size b) + (and (id3? b) + (+ 10 + (synchsafe-size (u8 b 6) + (u8 b 7) + (u8 b 8) + (u8 b 9))))) + +(define (valid-mp3-frame-at? b i) + (and (>= (bytes-length b) (+ i 4)) + (let* ([b0 (u8 b i)] + [b1 (u8 b (+ i 1))] + [b2 (u8 b (+ i 2))] + [b3 (u8 b (+ i 3))] + [version (bitwise-and (arithmetic-shift b1 -3) #x03)] + [layer (bitwise-and (arithmetic-shift b1 -1) #x03)] + [bitrate (bitwise-and (arithmetic-shift b2 -4) #x0f)] + [sample-rate (bitwise-and (arithmetic-shift b2 -2) + #x03)] + [emphasis (bitwise-and b3 #x03)]) + (and (= b0 #xff) + (= (bitwise-and b1 #xe0) #xe0) + (not (= version #b01)) + (not (= layer #b00)) + (not (= bitrate #b0000)) + (not (= bitrate #b1111)) + (not (= sample-rate #b11)) + (not (= emphasis #b10)))))) + +(define (mp3-frame-sync? b) + (or (valid-mp3-frame-at? b 0) + (let ([id3-size (id3-total-size b)]) + (and id3-size + (< id3-size (bytes-length b)) + (valid-mp3-frame-at? b id3-size))))) + +(define (mp3? b) + (or (id3? b) + (mp3-frame-sync? b))) + +(define (aac-adts-sync? b) + (and (>= (bytes-length b) 7) + (= (u8 b 0) #xff) + (= (bitwise-and (u8 b 1) #xf6) #xf0) + (= (bitwise-and (u8 b 1) #x06) #x00) + (not (= (bitwise-and (arithmetic-shift (u8 b 2) -2) + #x0f) + #x0f)))) + +(define (audio-sniff-format* file) + (let ([status (file-readable-status file)]) + (cond + [(not (eq? status #t)) status] + [else + (let ([b (read-prefix/status file)]) + (cond + [(symbol? b) b] + + ;; Hard signatures + [(bytes-prefix? b #"fLaC") 'flac] + [(bytes-prefix? b #"OggS") (sniff-ogg-subtype b)] + [(riff-wave? b) 'wav] + [(aiff? b) 'aiff] + [(iso-bmff? b) + (let ([codec (mp4-codec-peek/file file b)]) + (if codec codec 'mp4))] + [(bytes-prefix? b asf-guid) 'wma] + [(matroska-or-webm? b) 'matroska] + [(ac3? b) 'ac3] + [(ape? b) 'ape] + [(wavpack? b) 'wavpack] + + ;; Heuristics + [(mp3? b) 'mp3] + [(aac-adts-sync? b) 'aac] + + [else 'unknown]))]))) + +(define (audio-sniff-format/extension* file) + (let ([fmt (audio-sniff-format* file)]) + (cond + [(not (eq? (memq fmt + '(file-not-found file-not-readable not-a-file)) + #f)) + fmt] + [(not (eq? fmt 'unknown)) fmt] + [else + (case (string->symbol (or (audio-sniff-extension* file) "")) + [(mp3 mp2 mp1) 'mp3] + [(flac) 'flac] + [(ogg oga) 'ogg] + [(opus) 'opus] + [(wav wave) 'wav] + [(aif aiff aifc) 'aiff] + [(m4a mp4 m4b m4p) 'mp4] + [(aac) 'aac] + [(alac) 'alac] + [(ac3) 'ac3] + [(ape) 'ape] + [(wv wvp wvpk wavpack) 'wavpack] + [(wma asf) 'wma] + [(webm mka mkv) 'matroska] + [else 'unknown])]))) + +(define (audio-format-known?* fmt) + (not (eq? (memq fmt audio-formats) #f))) + +(define (audio-format-matches?* file formats) + (not (eq? (memq (audio-sniff-format/extension* file) formats) #f))) + +(define/contract (audio-sniff-extension file) + (-> path-string? (or/c string? #f)) + (audio-sniff-extension* file)) + +(define/contract (audio-sniff-format file) + (-> path-string? audio-format?) + (audio-sniff-format* file)) + +(define/contract (audio-sniff-format/extension file) + (-> path-string? audio-format?) + (audio-sniff-format/extension* file)) + +(define/contract (audio-format-known? fmt) + (-> symbol? boolean?) + (audio-format-known?* fmt)) + +(define/contract (audio-format-matches? file formats) + (-> path-string? (listof symbol?) boolean?) + (audio-format-matches?* file formats)) \ No newline at end of file diff --git a/ffmpeg-decoder.rkt b/ffmpeg-decoder.rkt new file mode 100644 index 0000000..aa05db3 --- /dev/null +++ b/ffmpeg-decoder.rkt @@ -0,0 +1,156 @@ +(module ffmpeg_decoder racket/base + + (require ffi/unsafe + "ffmpeg_ffi.rkt" + "private/utils.rkt" + (prefix-in fin: finalizer) + ) + + (provide ffmpeg-open + ffmpeg-valid? + ffmpeg-read + ffmpeg-stop + ffmpeg-seek + ) + + (define-struct ffmpeg-handle + (if cb-info cb-audio + (stop #:mutable) + (seek #:mutable) + (reading #:mutable) + (format #:mutable) + ) + #:transparent + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Functions to do the good stuff +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (ffmpeg-valid? audio-file) + ;; Keep this deliberately weak, just like mp3-valid?. Existence and + ;; extension checks can be done by the generic audio-decoder layer. The + ;; real validation happens when the FFmpeg shim opens the file. + #t) + + (define audio-type 'ffmpeg) + + (define last-rate 44100) ; An assumption for if we've got nothing + (define last-channels 2) ; An assumption for if we've got nothing + (define last-bits 32) ; FFmpeg shim output is always S32 + (define last-bytes 4) ; One S32 sample is four bytes + + (define (correct-format-hash h) + (let ((rate (hash-ref h 'sample-rate #f))) + (when (eq? rate #f) + (hash-set! h 'sample-rate last-rate))) + (let ((channels (hash-ref h 'channels #f))) + (when (eq? channels #f) + (hash-set! h 'channels last-channels))) + (let ((bits (hash-ref h 'bits-per-sample #f))) + (when (eq? bits #f) + (hash-set! h 'bits-per-sample last-bits))) + (let ((bytes (hash-ref h 'bytes-per-sample #f))) + (when (eq? bytes #f) + (hash-set! h 'bytes-per-sample last-bytes))) + (let ((total-samples (hash-ref h 'total-samples #f))) + (when (eq? total-samples #f) + (hash-set! h 'total-samples 0) + (hash-set! h 'duration 0)))) + + (define (report-format handle current-pcm-pos) + (dbg-sound "Reporting ffmpeg format at pcm-pos: ~a" current-pcm-pos) + (let ((h (ffmpeg-handle-format handle))) + (set! last-rate (hash-ref h 'sample-rate)) + (set! last-channels (hash-ref h 'channels)) + (set! last-bits (hash-ref h 'bits-per-sample)) + (set! last-bytes (hash-ref h 'bytes-per-sample last-bytes))) + ((ffmpeg-handle-cb-info handle) (ffmpeg-handle-format handle))) + + (define (give-audio handle info pos buffer size) + (let ((h (ffmpeg-handle-format handle))) + (correct-format-hash h) + (hash-set! h 'sample pos) + (let ((sample-rate (hash-ref h 'sample-rate last-rate))) + (hash-set! h 'current-time (exact->inexact (/ pos sample-rate)))) + ((ffmpeg-handle-cb-audio handle) h buffer size))) + + (define (ffmpeg-open audio-file* cb-stream-info cb-audio) + (let ((audio-file (if (path? audio-file*) + (path->string audio-file*) + audio-file*))) + (if (file-exists? audio-file) + (let ((handler (fmpg-ffi-decoder-handler))) + (handler 'new) + (handler 'init audio-file) + (let ((h (make-ffmpeg-handle handler + cb-stream-info + cb-audio + #f + #f + #f + (make-hash)))) + h)) + #f))) + + (define (handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length) + (let ((f (make-hash))) + (hash-set! f 'duration (if (and (integer? pcm-length) + (>= pcm-length 0) + (integer? rate) + (> rate 0)) + (exact->inexact (/ pcm-length rate)) + 0.0)) + (hash-set! f 'sample-rate rate) + (hash-set! f 'channels channels) + (hash-set! f 'bits-per-sample sample-bits) + (hash-set! f 'bytes-per-sample sample-bytes) + (hash-set! f 'total-samples pcm-length) + (set-ffmpeg-handle-format! handle f)) + (report-format handle pcm-pos)) + + (define (ffmpeg-read handle) + (let* ((ffi-handler (ffmpeg-handle-if handle)) + (cb-info (ffmpeg-handle-cb-info handle)) + (cb-audio (ffmpeg-handle-cb-audio handle))) + (set-ffmpeg-handle-reading! handle #t) + (let loop () + (if (eq? (ffmpeg-handle-stop handle) #t) + (begin + (dbg-sound "Stopping ffmpeg decoding") + (set-ffmpeg-handle-reading! handle #f) + 'stopped-reading) + (begin + (unless (eq? (ffmpeg-handle-seek handle) #f) + (dbg-sound "Seeking to ~a" (ffmpeg-handle-seek handle)) + (ffi-handler 'seek (ffmpeg-handle-seek handle)) + (set-ffmpeg-handle-seek! handle #f)) + (ffi-handler 'read + (lambda (info pos buffer size) + (if (eq? info 'done) + (set-ffmpeg-handle-stop! handle #t) + (give-audio handle info pos buffer size))) + (lambda (pcm-pos rate channels sample-bits sample-bytes pcm-length) + (handle-format handle pcm-pos rate channels sample-bits sample-bytes pcm-length))) + (loop))))) + (let ((ffi-handler (ffmpeg-handle-if handle))) + (ffi-handler 'close) + (ffi-handler 'delete))) + + (define (ffmpeg-seek handle percentage) + (let ((fmt (ffmpeg-handle-format handle))) + (let ((total-samples (hash-ref fmt 'total-samples 0))) + (unless (or + (eq? total-samples #f) + (= total-samples -1)) + (let ((sample (inexact->exact + (round (* (exact->inexact (/ percentage 100.0)) + total-samples))))) + (set-ffmpeg-handle-seek! handle sample)))))) + + (define (ffmpeg-stop handle) + (set-ffmpeg-handle-stop! handle #t) + (while (ffmpeg-handle-reading handle) + (sleep 0.01))) + + ); end of module diff --git a/ffmpeg-ffi.rkt b/ffmpeg-ffi.rkt new file mode 100644 index 0000000..3d9f528 --- /dev/null +++ b/ffmpeg-ffi.rkt @@ -0,0 +1,324 @@ +(module ffmpeg_ffi racket/base + + (require ffi/unsafe + ffi/unsafe/define + ffi/unsafe/alloc + "private/utils.rkt" + ) + + (provide fmpg-ffi-decoder-handler + ) + + ;; The native shim is the new instance-only FFmpeg audio API. It exposes a + ;; single opaque fmpg_instance pointer and keeps stream-index, packets, + ;; decoder state and file metadata inside that instance. The public C header + ;; says that output is always signed 32-bit interleaved PCM and that the + ;; current buffer pointer is valid until the next decode/seek/close/free call. + + ;; Adjust the names below if your shared library has another basename. + ;; get-lib is used in the same style as libmpg123-ffi.rkt. + (define lib (get-lib '("ffmpeg_audio" "libffmpeg_audio") '(#f))) + + (define-ffi-definer define-ffmpeg-audio lib + #:default-make-fail make-not-available) + + (define _fmpg_instance _pointer) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Native bindings +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define-ffmpeg-audio fmpg_init + (_fun -> _fmpg_instance)) + + (define-ffmpeg-audio fmpg_free + (_fun _fmpg_instance -> _void)) + + (define-ffmpeg-audio fmpg_open_file + (_fun _fmpg_instance _string/utf-8 -> _int)) + + (define-ffmpeg-audio fmpg_close + (_fun _fmpg_instance -> _void)) + + (define-ffmpeg-audio fmpg_is_open + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_stream_count + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_sample_rate + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_channels + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_bits_per_sample + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_audio_bytes_per_sample + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_duration_ms + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_duration_samples + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_file_title + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_author + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_album + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_genre + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_comment + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_copyright + (_fun _fmpg_instance -> _string/utf-8)) + + (define-ffmpeg-audio fmpg_file_year + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_file_track + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_file_bitrate + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_decode_next + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_seek_ms + (_fun _fmpg_instance _int64 -> _int)) + + (define-ffmpeg-audio fmpg_buffer + (_fun _fmpg_instance -> _pointer)) + + (define-ffmpeg-audio fmpg_buffer_size + (_fun _fmpg_instance -> _int)) + + (define-ffmpeg-audio fmpg_buffer_samples + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_buffer_start_sample + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_buffer_end_sample + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_sample_position + (_fun _fmpg_instance -> _int64)) + + (define-ffmpeg-audio fmpg_timecode + (_fun _fmpg_instance -> _double)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Our interface for decoding to racket +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + + (define (ok? r) + (not (= r 0))) + + (define (str v) + (if (string? v) v "")) + + (define (known-int64? v) + (and (integer? v) (not (= v -1)))) + + (define (copy-current-buffer fh) + (let ((size (fmpg_buffer_size fh))) + (cond + ((<= size 0) (values #f 0)) + (else + (let ((src (fmpg_buffer fh))) + (if (eq? src #f) + (error (format "fmpg_buffer: got NULL for ~a bytes" size)) + (let ((dst (malloc size 'nonatomic))) + (memcpy dst src size) + (values dst size)))))))) + + (define (fmpg-ffi-decoder-handler) + + (define fh #f) + + (define rate -1) + (define channels -1) + (define sample-bits -1) + (define sample-bytes -1) + (define pcm-length -1) + (define duration-ms -1) + (define audio-streams -1) + (define ffmpeg-file "") + (define current-pcm-pos 0) + + (define title "") + (define author "") + (define album "") + (define genre "") + (define comment "") + (define copyright "") + (define year -1) + (define track -1) + (define bitrate -1) + + (define (new) + (if (eq? fh #f) + (begin + (set! fh (fmpg_init)) + (when (eq? fh #f) + (error "fmpg_init: could not allocate ffmpeg instance")) + #t) + (error "ffmpeg handle already initialized, delete it first"))) + + (define (delete) + (if (eq? fh #f) + (error "ffmpeg handle has already been deleted") + (begin + (fmpg_free fh) + (set! fh #f) + (set! rate -1) + (set! channels -1) + (set! sample-bits -1) + (set! sample-bytes -1) + (set! pcm-length -1) + (set! duration-ms -1) + (set! audio-streams -1) + (set! ffmpeg-file "") + (set! current-pcm-pos 0) + #t))) + + (define (fetch-info) + (set! rate (fmpg_audio_sample_rate fh)) + (set! channels (fmpg_audio_channels fh)) + (set! sample-bits (fmpg_audio_bits_per_sample fh)) + (set! sample-bytes (fmpg_audio_bytes_per_sample fh)) + (set! pcm-length (fmpg_duration_samples fh)) + (set! duration-ms (fmpg_duration_ms fh)) + (set! audio-streams (fmpg_audio_stream_count fh)) + (set! title (str (fmpg_file_title fh))) + (set! author (str (fmpg_file_author fh))) + (set! album (str (fmpg_file_album fh))) + (set! genre (str (fmpg_file_genre fh))) + (set! comment (str (fmpg_file_comment fh))) + (set! copyright (str (fmpg_file_copyright fh))) + (set! year (fmpg_file_year fh)) + (set! track (fmpg_file_track fh)) + (set! bitrate (fmpg_file_bitrate fh))) + + (define (init file) + (unless (ok? (fmpg_open_file fh file)) + (error (format "fmpg_open_file: could not open ~a" file))) + (set! ffmpeg-file (format "~a" file)) + (set! current-pcm-pos 0) + (fetch-info) + #t) + + (define (ffmpeg-format cb) + (cb current-pcm-pos rate channels sample-bits sample-bytes pcm-length)) + + (define (info) + (info-sound "file : ~a" ffmpeg-file) + (info-sound "audio-streams : ~a" audio-streams) + (info-sound "channels : ~a" channels) + (info-sound "sample-bits : ~a" sample-bits) + (info-sound "sample-bytes : ~a" sample-bytes) + (info-sound "rate : ~a" rate) + (info-sound "pcm-length : ~a" pcm-length) + (info-sound "duration-ms : ~a" duration-ms) + (info-sound "title : ~a" title) + (info-sound "author : ~a" author) + (info-sound "album : ~a" album) + (info-sound "genre : ~a" genre) + (info-sound "year : ~a" year) + (info-sound "track : ~a" track) + (info-sound "bitrate : ~a" bitrate) + #t) + + (define (close) + (unless (eq? fh #f) + (when (ok? (fmpg_is_open fh)) + (fmpg_close fh)) + (set! channels -1) + (set! pcm-length -1) + (set! duration-ms -1) + (set! rate -1) + (set! sample-bits -1) + (set! sample-bytes -1) + (set! audio-streams -1) + (set! ffmpeg-file "") + #t)) + + (define (read cb format-cb) + ;; Unlike mpg123, this shim already has a fixed output format after + ;; fmpg_open_file. Still report the format lazily on the first read so + ;; the decoder layer can keep exactly the same structure as mp3-decoder. + (when (= current-pcm-pos 0) + (ffmpeg-format format-cb)) + (if (ok? (fmpg_decode_next fh)) + (let-values ([(buffer size) (copy-current-buffer fh)]) + (cond + ((or (eq? buffer #f) (<= size 0)) + ;; Defensive: fmpg_decode_next should only return 1 when there + ;; is PCM data, but if the native side ever returns an empty + ;; block, simply read again. + (read cb format-cb)) + (else + ;; The start sample is the absolute music position of the first + ;; sample frame in this buffer. This is more useful than the + ;; end position for UI and progress reporting. + (let ((pcm-pos (fmpg_buffer_start_sample fh))) + (set! current-pcm-pos (fmpg_buffer_end_sample fh)) + (cb 'data pcm-pos buffer size))))) + (cb 'done -1 #f 0)) + #t) + + (define (seek pcm-pos) + (let* ((r (if (and (integer? rate) (> rate 0)) rate 44100)) + (ms (inexact->exact + (round (* 1000.0 (/ pcm-pos r)))))) + (unless (ok? (fmpg_seek_ms fh ms)) + (error (format "fmpg_seek_ms: could not seek to sample ~a (~a ms)" + pcm-pos ms))) + (set! current-pcm-pos (fmpg_sample_position fh)) + #t)) + + (define (tell) + (if (eq? fh #f) 0 (fmpg_sample_position fh))) + + (define (metadata) + (let ((h (make-hash))) + (hash-set! h 'title title) + (hash-set! h 'author author) + (hash-set! h 'album album) + (hash-set! h 'genre genre) + (hash-set! h 'comment comment) + (hash-set! h 'copyright copyright) + (hash-set! h 'year year) + (hash-set! h 'track track) + (hash-set! h 'bitrate bitrate) + (hash-set! h 'duration-ms duration-ms) + (hash-set! h 'audio-streams audio-streams) + h)) + + (lambda (cmd . args) + (cond + [(eq? cmd 'new) (new)] + [(eq? cmd 'delete) (delete)] + [(eq? cmd 'init) (init (car args))] + [(eq? cmd 'close) (close)] + [(eq? cmd 'format) (ffmpeg-format (car args))] + [(eq? cmd 'info) (info)] + [(eq? cmd 'read) (read (car args) (cadr args))] + [(eq? cmd 'seek) (seek (car args))] + [(eq? cmd 'tell) (tell)] + [(eq? cmd 'file) ffmpeg-file] + [(eq? cmd 'metadata) (metadata)] + [else (error (format "Unknown command: ~a" cmd))]))) + + ); end of module