240 lines
7.7 KiB
Racket
240 lines
7.7 KiB
Racket
(module ffmpeg_ffi_v2 racket/base
|
|
|
|
(require "ffmpeg-definitions.rkt"
|
|
"private/utils.rkt"
|
|
)
|
|
|
|
(provide fmpg-ffi-decoder-handler
|
|
fmpg-version
|
|
)
|
|
|
|
;; Handler adapter for ffmpeg-decoder.rkt. The decoder keeps using the
|
|
;; same command protocol, while this module delegates to ffmpeg-definitions.rkt.
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Helpers
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(define (ok? r)
|
|
(> r 0))
|
|
|
|
(define (decode-ok? r)
|
|
(= r 1))
|
|
|
|
(define (decode-eof? r)
|
|
(= r 0))
|
|
|
|
(define (decode-error? r)
|
|
(< r 0))
|
|
|
|
(define (filename->string filename)
|
|
(cond
|
|
[(path? filename) (path->string filename)]
|
|
[(string? filename) filename]
|
|
[else #f]))
|
|
|
|
(define (fmpg-version)
|
|
(ffmpeg-version 'avformat))
|
|
|
|
(define (copy-current-buffer fh)
|
|
(let ((buffer (fmpg-buffer fh))
|
|
(size (fmpg-buffer-size fh)))
|
|
(cond
|
|
[(or (eq? buffer #f) (<= size 0)) (values #f 0)]
|
|
[else
|
|
(let ((bs (make-bytes size)))
|
|
(bytes-copy! bs 0 buffer 0 size)
|
|
(values bs size))])))
|
|
|
|
(define (reset-info! set-rate! set-channels! set-sample-bits!
|
|
set-sample-bytes! set-pcm-length! set-duration-ms!
|
|
set-audio-streams! set-ffmpeg-file! set-current-pcm-pos!
|
|
set-bitrate!)
|
|
(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)
|
|
(set-bitrate! -1))
|
|
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
;; Handler protocol used by ffmpeg-decoder.rkt
|
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
|
|
(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 bitrate -1)
|
|
|
|
(define (set-rate! v) (set! rate v))
|
|
(define (set-channels! v) (set! channels v))
|
|
(define (set-sample-bits! v) (set! sample-bits v))
|
|
(define (set-sample-bytes! v) (set! sample-bytes v))
|
|
(define (set-pcm-length! v) (set! pcm-length v))
|
|
(define (set-duration-ms! v) (set! duration-ms v))
|
|
(define (set-audio-streams! v) (set! audio-streams v))
|
|
(define (set-ffmpeg-file! v) (set! ffmpeg-file v))
|
|
(define (set-current-pcm-pos! v) (set! current-pcm-pos v))
|
|
(define (set-bitrate! v) (set! bitrate v))
|
|
|
|
(define (reset!)
|
|
(reset-info! set-rate! set-channels! set-sample-bits!
|
|
set-sample-bytes! set-pcm-length! set-duration-ms!
|
|
set-audio-streams! set-ffmpeg-file! set-current-pcm-pos!
|
|
set-bitrate!))
|
|
|
|
(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-close! fh)
|
|
(set! fh #f)
|
|
(reset!)
|
|
#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! bitrate (fmpg-file-bitrate fh)))
|
|
|
|
(define (init file)
|
|
(let ((filename (filename->string file)))
|
|
(unless filename
|
|
(error (format "fmpg-open-file!: expected path or string, got ~a" file)))
|
|
(unless (ok? (fmpg-open-file! fh filename))
|
|
(error (format "fmpg-open-file!: could not open ~a" filename)))
|
|
(set! ffmpeg-file filename)
|
|
(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 "bitrate : ~a" bitrate)
|
|
#t)
|
|
|
|
(define (close)
|
|
(unless (eq? fh #f)
|
|
(when (ok? (fmpg-is-open fh))
|
|
(fmpg-close! fh))
|
|
(reset!)
|
|
#t))
|
|
|
|
#|
|
|
(define (read cb format-cb)
|
|
(when (= current-pcm-pos 0)
|
|
(ffmpeg-format format-cb))
|
|
(let ((dec-val (fmpg-decode-next! fh)))
|
|
(unless (ok? dec-val)
|
|
(err-sound "return value of fmpg-decode-next = ~a" dec-val))
|
|
(if (ok? dec-val)
|
|
(let-values ([(buffer size) (copy-current-buffer fh)])
|
|
(cond
|
|
[(or (eq? buffer #f) (<= size 0)) (read cb format-cb)]
|
|
[else
|
|
(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 (read cb format-cb)
|
|
(when (= current-pcm-pos 0)
|
|
(ffmpeg-format format-cb))
|
|
(let ((dec-val (fmpg-decode-next! fh)))
|
|
(cond
|
|
[(decode-ok? dec-val)
|
|
(let-values ([(buffer size) (copy-current-buffer fh)])
|
|
(cond
|
|
[(or (eq? buffer #f) (<= size 0))
|
|
(read cb format-cb)]
|
|
[else
|
|
(let ((pcm-pos (fmpg-buffer-start-sample fh)))
|
|
(set! current-pcm-pos (fmpg-buffer-end-sample fh))
|
|
(cb 'data pcm-pos buffer size))]))]
|
|
|
|
[(decode-eof? dec-val)
|
|
(cb 'done -1 #f 0)]
|
|
|
|
[else
|
|
(err-sound "fmpg-decode-next failed: ~a" dec-val)
|
|
(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 'bitrate bitrate)
|
|
(hash-set! h 'duration-ms duration-ms)
|
|
(hash-set! h 'audio-streams audio-streams)
|
|
h))
|
|
|
|
(define (version)
|
|
(fmpg-version))
|
|
|
|
(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)]
|
|
[(eq? cmd 'version) (version)]
|
|
[else (error (format "Unknown command: ~a" cmd))])))
|
|
|
|
); end of module
|