From d06d829f6a474a8b25d262698d6859bc16f5838a Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Sun, 3 May 2026 14:16:32 +0200 Subject: [PATCH] racket backend for async ao --- audio-decoder.rkt | 2 +- ffmpeg-ffi.rkt | 3 +- flac-decoder.rkt | 25 +++++++++ libao-async-ffi-racket.rkt | 111 +++++++++++++++++++++++++++++++++++-- libmpg123-ffi.rkt | 15 ++++- play-test.rkt | 4 +- 6 files changed, 150 insertions(+), 10 deletions(-) diff --git a/audio-decoder.rkt b/audio-decoder.rkt index 38edffb..73a820b 100644 --- a/audio-decoder.rkt +++ b/audio-decoder.rkt @@ -227,7 +227,7 @@ (not (null? (filter (λ (e) (string-ci=? ext e)) (audio-reader-exts reader))))) (define reader-for-kind - (make-hash '((mp3 . ffmpeg) ; ffmpeg does a better job on gapless playback... + (make-hash '((mp3 . mp3) ; ffmpeg does a better job on gapless playback... (flac . flac) (ogg . ffmpeg) (vorbis . ffmpeg) diff --git a/ffmpeg-ffi.rkt b/ffmpeg-ffi.rkt index ebee0d4..df6131c 100644 --- a/ffmpeg-ffi.rkt +++ b/ffmpeg-ffi.rkt @@ -161,7 +161,8 @@ (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 (malloc size 'nonatomic))) + (let ((dst (make-bytes size))) (memcpy dst src size) (values dst size)))))))) diff --git a/flac-decoder.rkt b/flac-decoder.rkt index ca5a537..ed07eaf 100644 --- a/flac-decoder.rkt +++ b/flac-decoder.rkt @@ -50,6 +50,7 @@ [(eq? e 'native-endian) (not (system-big-endian?))] [else (error (format "unknown endian value: ~a" e))])) + #| (define (flac-channels->interleaved-buffer buffer block-size channels bits endianness) (let* ([bytes (quotient bits 8)] [little? (endian-little? endianness)] @@ -78,6 +79,30 @@ (set! out-pos (+ out-pos bytes))))) (list mem-out buf-size))) +|# + +(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness) + ;; buffer = FLAC__int32 * const buffer[] + ;; block-size = samples per channel + + (let* ([bytes (quotient bits 8)] + [big? (not (endian-little? endianness))] + [buf-size (* block-size channels bytes)] + [bs (make-bytes buf-size)] + ;[out (malloc buf-size 'atomic-interior)] + [out-pos 0]) + + (for ([k (in-range block-size)]) + (for ([channel (in-range channels)]) + (let* ([chan (ptr-ref buffer _pointer channel)] + [sample (ptr-ref chan _int32 k)]) + (integer->integer-bytes sample bytes #t big? bs out-pos) + (set! out-pos (+ out-pos bytes))))) + + ;(memcpy out bs buf-size) + ;(list out buf-size) + (list bs buf-size) + )) (define (process-frame handle frame buffer) (let* ([h (flac-ffi-frame-header frame)] diff --git a/libao-async-ffi-racket.rkt b/libao-async-ffi-racket.rkt index 56b4d0d..9677693 100644 --- a/libao-async-ffi-racket.rkt +++ b/libao-async-ffi-racket.rkt @@ -86,7 +86,8 @@ ;; call. This is the important part that makes the C backend much less useful. (define-ao ao_play ;(_fun #:blocking? #t _ao-device _pointer _uint32 -> _int)) - (_fun _ao-device _pointer _uint32 -> _int)) + ;(_fun _ao-device _pointer _uint32 -> _int)) + (_fun _ao-device _bytes _uint32 -> _int)) ;; ------------------------------------------------------------------------- ;; Mutex stuff @@ -161,9 +162,10 @@ ) (define (new-elem command music-id at-second music-duration buflen buf) - (let ((new-buf (malloc buflen 'atomic))) - (memcpy new-buf buf buflen) - (make-queue-elem command new-buf buflen at-second music-duration music-id))) + ;(let ((new-buf (make-bytes buflen))) ;((new-buf (malloc buflen 'atomic))) + ; (memcpy new-buf buf buflen) + ;(make-queue-elem command new-buf buflen at-second music-duration music-id))) + (make-queue-elem command buf buflen at-second music-duration music-id)) (define (del-elem elem) ; does nothing @@ -192,6 +194,9 @@ [(eq? e 'native-endian) (system-little-endian?)] [else (error 'convert-bits "unknown endian value: ~a" e)])) +(define (is-big-endian? e) + (not (is-little-endian? e))) + (define (endian-eq? a b) (let ((le-a (is-little-endian? a)) @@ -253,6 +258,8 @@ ) |# + +#| (define (adjust-volume h buf buf-size volume-in-10000) (let* ((bits (ao-handle-dev-bits-per-sample h)) (bytes-per-sample (arithmetic-shift bits -3)) @@ -308,9 +315,34 @@ ) #t ) +|# + +(define (adjust-volume h bs buf-size volume-in-10000) + ;; bs: bytes + ;; buf-size: aantal geldige bytes in bs + + (let* ([bits (ao-handle-dev-bits-per-sample h)] + [bytes-per-sample (arithmetic-shift bits -3)] + [big? (is-big-endian? (ao-handle-dev-endianness h))]) + + (unless (= volume-in-10000 10000) + (for ([i (in-range 0 buf-size bytes-per-sample)]) + (let* ([sample (integer-bytes->integer bs #t big? + i + (+ i bytes-per-sample))] + [scaled (quotient (* sample volume-in-10000) 10000)]) + (integer->integer-bytes scaled + bytes-per-sample + #t + big? + bs + i)))) + + #t)) ;;; planar -> intereleaved +#| (define (planar-to-interleaved mem buf-size info) (let* ([type (buffer-info-type info)] [bits (buffer-info-sample-bits info)] @@ -352,10 +384,43 @@ (ptr-ref mem _uint8 (+ in-pos b))))))) (list mem-out out-size)))) +|# +(define (planar-to-interleaved mem buf-size info) + ;; mem: bytes + ;; result: (list bytes output-size) + + (let* ([type (buffer-info-type info)] + [bits (buffer-info-sample-bits info)] + [channels (buffer-info-channels info)] + [bytes (arithmetic-shift bits -3)] + [out-size buf-size] + [out (make-bytes out-size)]) + + (unless (or (eq? type 'planar) (eq? type 'flac)) + (error (format "expected planar buffer, got: ~a" type))) + + (unless (zero? (remainder buf-size (* channels bytes))) + (error (format "buffer size ~a is not aligned to ~a channels of ~a-bit samples" + buf-size channels bits))) + + (let* ([samples-total (quotient buf-size bytes)] + [samples-per-channel (quotient samples-total channels)] + [plane-size (* samples-per-channel bytes)]) + + (for ([sample-index (in-range samples-per-channel)]) + (for ([channel (in-range channels)]) + (let* ([in-pos (+ (* channel plane-size) + (* sample-index bytes))] + [out-pos (* (+ (* sample-index channels) channel) + bytes)]) + (bytes-copy! out out-pos mem in-pos (+ in-pos bytes))))) + + (list out out-size)))) ;;; requested bits to device bits +#| (define (convert-bits buf buf-size in-bits in-endianness out-bits out-endianness) (let* ([in-bytes (arithmetic-shift in-bits -3)] [out-bytes (arithmetic-shift out-bits -3)] @@ -402,6 +467,37 @@ (loop (sub1 k) (arithmetic-shift s -8))))))) (list out-buf out-size))) +|# + +(define (convert-bits buf buf-size in-bits in-endianness out-bits out-endianness) + ;; buf: bytes + ;; returns: (list out-bytes out-size) + + (let* ([in-bytes (arithmetic-shift in-bits -3)] + [out-bytes (arithmetic-shift out-bits -3)] + [samples (quotient buf-size in-bytes)] + [out-size (* samples out-bytes)] + [out (make-bytes out-size)] + [shift (- out-bits in-bits)] + [in-big? (is-big-endian? in-endianness)] + [out-big? (is-big-endian? out-endianness)]) + + (for ([n (in-range samples)]) + (let* ([in-pos (* n in-bytes)] + [out-pos (* n out-bytes)] + [sample (integer-bytes->integer + buf #t in-big? + in-pos + (+ in-pos in-bytes))] + [converted (arithmetic-shift sample shift)]) + (integer->integer-bytes converted + out-bytes + #t + out-big? + out + out-pos))) + + (list out out-size))) @@ -608,6 +704,9 @@ (define (ao_play_async h music-id at-second music-duration buf-size mem info) (let ((type (buffer-info-type info))) + (unless (bytes? mem) + (error "ao_play_async: paramater mem must be of type bytes")) + (when (or (eq? type 'planar) (eq? type 'flac)) (dbg-sound "Converting from planar to interleaved") (let ((m (planar-to-interleaved mem buf-size info))) @@ -621,6 +720,10 @@ (set! ao-mem (car m)) (set! ao-size (cadr m))) + (unless (bytes? ao-mem) + (error "Hey! this was unexpected!")) + + (let ((elem (new-elem 'play music-id at-second music-duration ao-size ao-mem))) (add h elem)) ) diff --git a/libmpg123-ffi.rkt b/libmpg123-ffi.rkt index ae87f91..a7b1da8 100644 --- a/libmpg123-ffi.rkt +++ b/libmpg123-ffi.rkt @@ -429,16 +429,27 @@ int main(int argc, char *argv[]) (set! mp3-file "") #t)) + (define (copy-buffer buf size) + (cond + ((> size 0) + (let ((out (make-bytes size))) + (memcpy out buf size) + out)) + ((= size 0) + (make-bytes 0)) + (else + #f))) + (define (read cb format-cb) (let-values ([(r done) (mpg123_read mh buffer buf-size)]) (cond - ((eq? r 'MPG123_DONE) (cb 'done -1 buffer done)) + ((eq? r 'MPG123_DONE) (cb 'done -1 (copy-buffer buffer done) done)) ((eq? r 'MPG123_NEW_FORMAT) (do-format) (mp3-format format-cb) (read cb format-cb)) ((eq? r 'MPG123_OK) (let ((pcm-pos (mpg123_tell64 mh))) (set! current-pcm-pos pcm-pos) - (cb 'data pcm-pos buffer done))) + (cb 'data pcm-pos (copy-buffer buffer done) done))) (else (error (format "mpg123_read: ~a" (mpg123_plain_strerror r)))) ) ) diff --git a/play-test.rkt b/play-test.rkt index 5282ea7..1050706 100644 --- a/play-test.rkt +++ b/play-test.rkt @@ -21,7 +21,7 @@ (set! test-file4 (build-path tests "mahler-2.ogg")) ) (when (eq? os 'windows) - (set! test-file3 (build-path tests "idyll.flac")) + (set! test-file3 (build-path tests "idyll.mp3")) (set! test-file4 (build-path tests "idyll.flac")) ) ) @@ -71,7 +71,7 @@ (when (= (round current-seconds) 40) (ao-set-volume! ao-h 100)))) ) - + (when (not (eq? ao-h #f)) (when (not (and (= current-bits bits-per-sample)