hans/racket-sound
1
0
Fork 0
Code Issues 1 Pull Requests Actions Packages Projects Releases Wiki Activity

racket backend for async ao

Browse Source
This commit is contained in:
Hans Dijkema
2026-05-03 14:16:32 +02:00
parent 92227133ff
commit d06d829f6a
6 changed files with 150 additions and 10 deletions
Download Patch File Download Diff File Expand all files Collapse all files
audio-decoder.rkt
+1 -1
View File
@@ -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)
ffmpeg-ffi.rkt
+2 -1
View File
@@ -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))))))))
flac-decoder.rkt
+25
View File
@@ -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)]
libao-async-ffi-racket.rkt
+107 -4
View File
@@ -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))
)
libmpg123-ffi.rkt
+13 -2
View File
@@ -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))))
)
)
play-test.rkt
+1 -1
View File
@@ -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"))
)
)