ffmpeg support and audio sniffing
This commit is contained in:
@@ -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))
|
||||
@@ -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
|
||||
+324
@@ -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
|
||||
Reference in New Issue
Block a user