ffmpeg support and audio sniffing

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))

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

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