racket only ffmpeg backend. Now no racket-sound-libs are needed anymore.
This commit is contained in:
File diff suppressed because it is too large
Load Diff
+88
-249
@@ -1,8 +1,6 @@
|
|||||||
(module ffmpeg_ffi racket/base
|
(module ffmpeg_ffi_v2 racket/base
|
||||||
|
|
||||||
(require ffi/unsafe
|
(require "ffmpeg-definitions.rkt"
|
||||||
ffi/unsafe/define
|
|
||||||
ffi/unsafe/alloc
|
|
||||||
"private/utils.rkt"
|
"private/utils.rkt"
|
||||||
)
|
)
|
||||||
|
|
||||||
@@ -10,174 +8,53 @@
|
|||||||
fmpg-version
|
fmpg-version
|
||||||
)
|
)
|
||||||
|
|
||||||
;; The native shim is the new instance-only FFmpeg audio API. It exposes a
|
;; Handler adapter for ffmpeg-decoder.rkt. The decoder keeps using the
|
||||||
;; single opaque fmpg_instance pointer and keeps stream-index, packets,
|
;; same command protocol, while this module delegates to ffmpeg-definitions.rkt.
|
||||||
;; 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)
|
|
||||||
|
|
||||||
(define (fmpg-version)
|
|
||||||
(let* ((v (fmpg_version))
|
|
||||||
(patch (remainder v 256))
|
|
||||||
(minor (remainder (quotient v 256) 256))
|
|
||||||
(major (quotient v 65536))
|
|
||||||
)
|
|
||||||
(list major minor patch)))
|
|
||||||
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
;; Native bindings
|
;; Helpers
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
|
|
||||||
(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))
|
|
||||||
|
|
||||||
(define-ffmpeg-audio fmpg_version
|
|
||||||
(_fun -> _int))
|
|
||||||
|
|
||||||
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
|
||||||
;; Our interface for decoding to racket
|
|
||||||
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
(define (ok? r)
|
(define (ok? r)
|
||||||
(not (= r 0)))
|
(not (= r 0)))
|
||||||
|
|
||||||
(define (str v)
|
(define (filename->string filename)
|
||||||
(if (string? v) v ""))
|
(cond
|
||||||
|
[(path? filename) (path->string filename)]
|
||||||
|
[(string? filename) filename]
|
||||||
|
[else #f]))
|
||||||
|
|
||||||
(define (known-int64? v)
|
(define (fmpg-version)
|
||||||
(and (integer? v) (not (= v -1))))
|
(ffmpeg-version 'avformat))
|
||||||
|
|
||||||
(define (copy-current-buffer fh)
|
(define (copy-current-buffer fh)
|
||||||
(let ((size (fmpg_buffer_size fh)))
|
(let ((buffer (fmpg-buffer fh))
|
||||||
|
(size (fmpg-buffer-size fh)))
|
||||||
(cond
|
(cond
|
||||||
((<= size 0) (values #f 0))
|
[(or (eq? buffer #f) (<= size 0)) (values #f 0)]
|
||||||
(else
|
[else
|
||||||
(let ((src (fmpg_buffer fh)))
|
(let ((bs (make-bytes size)))
|
||||||
(if (eq? src #f)
|
(bytes-copy! bs 0 buffer 0 size)
|
||||||
(error (format "fmpg_buffer: got NULL for ~a bytes" size))
|
(values bs size))])))
|
||||||
;(let ((dst (malloc size 'nonatomic)))
|
|
||||||
(let ((dst (make-bytes size)))
|
(define (reset-info! set-rate! set-channels! set-sample-bits!
|
||||||
(memcpy dst src size)
|
set-sample-bytes! set-pcm-length! set-duration-ms!
|
||||||
(values dst size))))))))
|
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 (fmpg-ffi-decoder-handler)
|
||||||
|
|
||||||
@@ -192,23 +69,31 @@
|
|||||||
(define audio-streams -1)
|
(define audio-streams -1)
|
||||||
(define ffmpeg-file "")
|
(define ffmpeg-file "")
|
||||||
(define current-pcm-pos 0)
|
(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 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)
|
(define (new)
|
||||||
(if (eq? fh #f)
|
(if (eq? fh #f)
|
||||||
(begin
|
(begin
|
||||||
(set! fh (fmpg_init))
|
(set! fh (fmpg-init))
|
||||||
(when (eq? fh #f)
|
(when (eq? fh #f)
|
||||||
(error "fmpg_init: could not allocate ffmpeg instance"))
|
(error "fmpg-init: could not allocate ffmpeg instance"))
|
||||||
#t)
|
#t)
|
||||||
(error "ffmpeg handle already initialized, delete it first")))
|
(error "ffmpeg handle already initialized, delete it first")))
|
||||||
|
|
||||||
@@ -216,44 +101,31 @@
|
|||||||
(if (eq? fh #f)
|
(if (eq? fh #f)
|
||||||
(error "ffmpeg handle has already been deleted")
|
(error "ffmpeg handle has already been deleted")
|
||||||
(begin
|
(begin
|
||||||
(fmpg_free fh)
|
(fmpg-close! fh)
|
||||||
(set! fh #f)
|
(set! fh #f)
|
||||||
(set! rate -1)
|
(reset!)
|
||||||
(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)))
|
#t)))
|
||||||
|
|
||||||
(define (fetch-info)
|
(define (fetch-info)
|
||||||
(set! rate (fmpg_audio_sample_rate fh))
|
(set! rate (fmpg-audio-sample-rate fh))
|
||||||
(set! channels (fmpg_audio_channels fh))
|
(set! channels (fmpg-audio-channels fh))
|
||||||
(set! sample-bits (fmpg_audio_bits_per_sample fh))
|
(set! sample-bits (fmpg-audio-bits-per-sample fh))
|
||||||
(set! sample-bytes (fmpg_audio_bytes_per_sample fh))
|
(set! sample-bytes (fmpg-audio-bytes-per-sample fh))
|
||||||
(set! pcm-length (fmpg_duration_samples fh))
|
(set! pcm-length (fmpg-duration-samples fh))
|
||||||
(set! duration-ms (fmpg_duration_ms fh))
|
(set! duration-ms (fmpg-duration-ms fh))
|
||||||
(set! audio-streams (fmpg_audio_stream_count fh))
|
(set! audio-streams (fmpg-audio-stream-count fh))
|
||||||
(set! title (str (fmpg_file_title fh)))
|
(set! bitrate (fmpg-file-bitrate 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)
|
(define (init file)
|
||||||
(unless (ok? (fmpg_open_file fh file))
|
(let ((filename (filename->string file)))
|
||||||
(error (format "fmpg_open_file: could not open ~a" file)))
|
(unless filename
|
||||||
(set! ffmpeg-file (format "~a" file))
|
(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)
|
(set! current-pcm-pos 0)
|
||||||
(fetch-info)
|
(fetch-info)
|
||||||
#t)
|
#t))
|
||||||
|
|
||||||
(define (ffmpeg-format cb)
|
(define (ffmpeg-format cb)
|
||||||
(cb current-pcm-pos rate channels sample-bits sample-bytes pcm-length))
|
(cb current-pcm-pos rate channels sample-bits sample-bytes pcm-length))
|
||||||
@@ -267,76 +139,43 @@
|
|||||||
(info-sound "rate : ~a" rate)
|
(info-sound "rate : ~a" rate)
|
||||||
(info-sound "pcm-length : ~a" pcm-length)
|
(info-sound "pcm-length : ~a" pcm-length)
|
||||||
(info-sound "duration-ms : ~a" duration-ms)
|
(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)
|
(info-sound "bitrate : ~a" bitrate)
|
||||||
#t)
|
#t)
|
||||||
|
|
||||||
(define (close)
|
(define (close)
|
||||||
(unless (eq? fh #f)
|
(unless (eq? fh #f)
|
||||||
(when (ok? (fmpg_is_open fh))
|
(when (ok? (fmpg-is-open fh))
|
||||||
(fmpg_close fh))
|
(fmpg-close! fh))
|
||||||
(set! channels -1)
|
(reset!)
|
||||||
(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))
|
#t))
|
||||||
|
|
||||||
(define (read cb format-cb)
|
(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)
|
(when (= current-pcm-pos 0)
|
||||||
(ffmpeg-format format-cb))
|
(ffmpeg-format format-cb))
|
||||||
(if (ok? (fmpg_decode_next fh))
|
(if (ok? (fmpg-decode-next! fh))
|
||||||
(let-values ([(buffer size) (copy-current-buffer fh)])
|
(let-values ([(buffer size) (copy-current-buffer fh)])
|
||||||
(cond
|
(cond
|
||||||
((or (eq? buffer #f) (<= size 0))
|
[(or (eq? buffer #f) (<= size 0)) (read cb format-cb)]
|
||||||
;; Defensive: fmpg_decode_next should only return 1 when there
|
[else
|
||||||
;; is PCM data, but if the native side ever returns an empty
|
(let ((pcm-pos (fmpg-buffer-start-sample fh)))
|
||||||
;; block, simply read again.
|
(set! current-pcm-pos (fmpg-buffer-end-sample fh))
|
||||||
(read cb format-cb))
|
(cb 'data pcm-pos buffer size))]))
|
||||||
(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))
|
(cb 'done -1 #f 0))
|
||||||
#t)
|
#t)
|
||||||
|
|
||||||
(define (seek pcm-pos)
|
(define (seek pcm-pos)
|
||||||
(let* ((r (if (and (integer? rate) (> rate 0)) rate 44100))
|
(let* ((r (if (and (integer? rate) (> rate 0)) rate 44100))
|
||||||
(ms (inexact->exact
|
(ms (inexact->exact (round (* 1000.0 (/ pcm-pos r))))))
|
||||||
(round (* 1000.0 (/ pcm-pos r))))))
|
(unless (ok? (fmpg-seek-ms! fh ms))
|
||||||
(unless (ok? (fmpg_seek_ms fh ms))
|
(error (format "fmpg-seek-ms!: could not seek to sample ~a (~a ms)" pcm-pos ms)))
|
||||||
(error (format "fmpg_seek_ms: could not seek to sample ~a (~a ms)"
|
(set! current-pcm-pos (fmpg-sample-position fh))
|
||||||
pcm-pos ms)))
|
|
||||||
(set! current-pcm-pos (fmpg_sample_position fh))
|
|
||||||
#t))
|
#t))
|
||||||
|
|
||||||
(define (tell)
|
(define (tell)
|
||||||
(if (eq? fh #f) 0 (fmpg_sample_position fh)))
|
(if (eq? fh #f) 0 (fmpg-sample-position fh)))
|
||||||
|
|
||||||
(define (metadata)
|
(define (metadata)
|
||||||
(let ((h (make-hash)))
|
(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 'bitrate bitrate)
|
||||||
(hash-set! h 'duration-ms duration-ms)
|
(hash-set! h 'duration-ms duration-ms)
|
||||||
(hash-set! h 'audio-streams audio-streams)
|
(hash-set! h 'audio-streams audio-streams)
|
||||||
|
|||||||
+2
-2
@@ -16,8 +16,8 @@
|
|||||||
(define test-file3-id 3)
|
(define test-file3-id 3)
|
||||||
(define test-file4-id 4)
|
(define test-file4-id 4)
|
||||||
|
|
||||||
(set! test-file3 (build-path tests "idyll.flac"))
|
(set! test-file3 (build-path tests "mahler-1.mp3"))
|
||||||
(set! test-file4 (build-path tests "idyll.mp3"))
|
(set! test-file4 (build-path tests "mahler-2.mp3"))
|
||||||
|
|
||||||
;(define fmt (ao-mk-format 24 48000 2 'big-endian))
|
;(define fmt (ao-mk-format 24 48000 2 'big-endian))
|
||||||
;(define ao-h (ao-open-live #f fmt))
|
;(define ao-h (ao-open-live #f fmt))
|
||||||
|
|||||||
@@ -0,0 +1,102 @@
|
|||||||
|
#lang racket/base
|
||||||
|
|
||||||
|
(require ffi/unsafe
|
||||||
|
ffi/unsafe/define
|
||||||
|
ffi/unsafe/alloc
|
||||||
|
(for-syntax racket/base)
|
||||||
|
"utils.rkt"
|
||||||
|
)
|
||||||
|
|
||||||
|
(provide make-offsets
|
||||||
|
def-cstruct
|
||||||
|
struct-helpers
|
||||||
|
)
|
||||||
|
|
||||||
|
(define (make-offsets* defs)
|
||||||
|
(let ((name-store (make-hash)))
|
||||||
|
|
||||||
|
(define (expand-type n t)
|
||||||
|
(if (= n 0)
|
||||||
|
'()
|
||||||
|
(cons t (expand-type (- n 1) t))))
|
||||||
|
|
||||||
|
(define (make-types defs idx)
|
||||||
|
(if (null? defs)
|
||||||
|
'()
|
||||||
|
(let ((d (car defs)))
|
||||||
|
(let ((t (if (list? d)
|
||||||
|
(if (symbol? (car d))
|
||||||
|
(let ((name (car d)))
|
||||||
|
(hash-set! name-store name (list idx (cadr d)))
|
||||||
|
(list 1 (cadr d)))
|
||||||
|
d)
|
||||||
|
(list 1 d))))
|
||||||
|
(append (expand-type (car t) (cadr t))
|
||||||
|
(make-types (cdr defs) (+ idx (car t))))))
|
||||||
|
))
|
||||||
|
|
||||||
|
(let ((offsets (compute-offsets (make-types defs 0))))
|
||||||
|
(let ((keys (hash-keys name-store))
|
||||||
|
(offs (make-hash)))
|
||||||
|
(for-each (λ (key)
|
||||||
|
(let* ((idx-t (hash-ref name-store key))
|
||||||
|
(idx (car idx-t))
|
||||||
|
(t (cadr idx-t)))
|
||||||
|
(hash-set! offs key (list (list-ref offsets idx) t))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
keys)
|
||||||
|
offs))))
|
||||||
|
|
||||||
|
|
||||||
|
(define-syntax (make-offset stx)
|
||||||
|
(syntax-case stx ()
|
||||||
|
((_ (x t))
|
||||||
|
(cond
|
||||||
|
((number? (syntax->datum #'x)) #'(list x t))
|
||||||
|
(else #'(list 'x t))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
((_ t)
|
||||||
|
#'(list 1 t))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-syntax make-offsets
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ a ...)
|
||||||
|
(make-offsets* (list (make-offset a) ...)))))
|
||||||
|
|
||||||
|
(define-syntax def-cstruct
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ name (t ...) offs)
|
||||||
|
(define-cstruct name
|
||||||
|
([t (cadr (hash-ref offs 't)) #:offset (car (hash-ref offs 't))]
|
||||||
|
...)))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; Internal structures for ffmpeg decoding
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(define-syntax def-struct-helpers
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ (struct-get get struct-set set))
|
||||||
|
(begin
|
||||||
|
(define get struct-get)
|
||||||
|
(define set struct-set))
|
||||||
|
)
|
||||||
|
((_ (struct-get get))
|
||||||
|
(define get struct-get)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-syntax struct-helpers
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ a ...)
|
||||||
|
(begin
|
||||||
|
(def-struct-helpers a)
|
||||||
|
...))))
|
||||||
@@ -21,6 +21,17 @@
|
|||||||
sync-log-sound
|
sync-log-sound
|
||||||
integer->int-bytes
|
integer->int-bytes
|
||||||
int-bytes->integer
|
int-bytes->integer
|
||||||
|
|
||||||
|
let/assert
|
||||||
|
make-assert
|
||||||
|
a-eq? a-!eq?
|
||||||
|
a->? a-<=? a->=? a-<? a-=? a-!=?
|
||||||
|
a-nullptr? a-!nullptr?
|
||||||
|
a-true? a-false?
|
||||||
|
|
||||||
|
define/return
|
||||||
|
return
|
||||||
|
|
||||||
)
|
)
|
||||||
|
|
||||||
(sl-def-log racket-sound sound)
|
(sl-def-log racket-sound sound)
|
||||||
@@ -126,4 +137,102 @@
|
|||||||
u))
|
u))
|
||||||
(integer-bytes->integer bs signed? big? start end))))
|
(integer-bytes->integer bs signed? big? start end))))
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; let/assert
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
|
||||||
|
(define-syntax make-assert
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ name not-name pred)
|
||||||
|
(begin
|
||||||
|
(define-syntax name
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ const)
|
||||||
|
(λ (x) (pred x const)))))
|
||||||
|
(define-syntax not-name
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ const)
|
||||||
|
(λ (x) (not (pred x const))))))
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(make-assert a-eq? a-!eq? eq?)
|
||||||
|
|
||||||
|
(define a-nullptr? (a-eq? #f))
|
||||||
|
(define a-!nullptr? (a-!eq? #f))
|
||||||
|
|
||||||
|
(make-assert a->? a-<=? >)
|
||||||
|
(make-assert a->=? a-<? >=)
|
||||||
|
(make-assert a-=? a-!=? =)
|
||||||
|
|
||||||
|
(define a-true? (a-eq? #t))
|
||||||
|
(define a-false? (a-eq? #f))
|
||||||
|
|
||||||
|
(struct exn:let/assert exn (value) #:transparent)
|
||||||
|
|
||||||
|
(define (raise-let/assert v)
|
||||||
|
(raise (exn:let/assert "let/assert" (current-continuation-marks) v)))
|
||||||
|
|
||||||
|
(define (let/assert-value r)
|
||||||
|
(exn:let/assert-value r))
|
||||||
|
|
||||||
|
(define-syntax assert-expr
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ expr cond retval)
|
||||||
|
(let ((a expr)) (if (cond a) a (raise-let/assert retval))))
|
||||||
|
((_ expr)
|
||||||
|
expr)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
(define-syntax let/assert
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ ((v rest ...) ...) b1 ...)
|
||||||
|
(with-handlers ([exn:let/assert? let/assert-value])
|
||||||
|
(let* ((v (assert-expr rest ...))
|
||||||
|
...)
|
||||||
|
b1
|
||||||
|
...
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
;; define/return
|
||||||
|
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
|
||||||
|
|
||||||
|
(struct exn:return exn (value) #:transparent)
|
||||||
|
|
||||||
|
(define (raise-return v)
|
||||||
|
(raise (exn:return "return" (current-continuation-marks) v)))
|
||||||
|
|
||||||
|
(define (return-value r)
|
||||||
|
(exn:return-value r))
|
||||||
|
|
||||||
|
(define-syntax return
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ val)
|
||||||
|
(raise-return val))))
|
||||||
|
|
||||||
|
(define-syntax define/return
|
||||||
|
(syntax-rules ()
|
||||||
|
((_ (name ...) b1 ...)
|
||||||
|
(define (name ...)
|
||||||
|
(with-handlers ([exn:return? return-value])
|
||||||
|
b1
|
||||||
|
...
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
)
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
|
|
||||||
) ; end of module
|
) ; end of module
|
||||||
|
|||||||
Reference in New Issue
Block a user