initial import from racket-sound -> racket-audio

This commit is contained in:
2026-05-04 12:07:45 +02:00
parent f500f1711b
commit 87980f508a
28 changed files with 6282 additions and 16 deletions
+347
View File
@@ -0,0 +1,347 @@
(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.
(when (eq? (system-type 'os) 'windows)
; preload ffmpeg dlls.
(void
(begin
(get-lib '("avutil-60.dll") '(#f))
(get-lib '("swresample-6.dll") '(#f))
(get-lib '("avcodec-62") '(#f))
(get-lib '("avformat-62.dll") '(#f))
)
)
)
(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))
(define-ffmpeg-audio fmpg_ffmpeg_version
(_fun -> _string*/utf-8))
(define-ffmpeg-audio fmpg_int_version2string
(_fun _int -> _string*/utf-8))
(define-ffmpeg-audio fmpg_compatible_ffmpeg
(_fun -> _int))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; 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)))
(let ((dst (make-bytes size)))
(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