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

racket version of async C backend

Browse Source
This commit is contained in:
Hans Dijkema
2026-05-03 10:13:28 +02:00
parent 856c790257
commit 92227133ff
5 changed files with 1090 additions and 30 deletions
Download Patch File Download Diff File Expand all files Collapse all files
audio-decoder.rkt
+1 -1
View File
@@ -43,7 +43,7 @@
flac-read
flac-seek
flac-stop
'flac))
'ao))
;; MP3
(hash-set! audio-readers
flac-decoder.rkt
+61 -15
View File
@@ -43,25 +43,70 @@
(define kinds (make-hash))
(define last-buffer #f)
(define last-buf-len #f)
(define (endian-little? e)
(cond [(eq? e 'little-endian) #t]
[(eq? e 'big-endian) #f]
[(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)]
[buf-size (* block-size channels bytes)]
[mem-out (malloc buf-size 'atomic)]
[out-pos 0])
(for ([k (in-range block-size)])
(for ([channel (in-range channels)])
(let* ([channel-ptr (ptr-ref buffer _pointer channel)]
[sample (ptr-ref channel-ptr _int32 k)])
(if little?
(for ([j (in-range bytes)])
(ptr-set! mem-out _uint8 (+ out-pos j)
(bitwise-and
(arithmetic-shift sample (* -8 j))
#xff)))
(for ([j (in-range bytes)])
(ptr-set! mem-out _uint8 (+ out-pos j)
(bitwise-and
(arithmetic-shift sample
(* -8 (- bytes j 1)))
#xff))))
(set! out-pos (+ out-pos bytes)))))
(list mem-out buf-size)))
(define (process-frame handle frame buffer)
(let* ((h (flac-ffi-frame-header frame))
(cb-audio (flac-handle-cb-audio handle))
(ffi (flac-handle-ffi-decoder-handler handle))
(type (hash-ref h 'number-type))
(channels (hash-ref h 'channels))
(block-size (hash-ref h 'blocksize)))
(let* ([h (flac-ffi-frame-header frame)]
[cb-audio (flac-handle-cb-audio handle)]
[type (hash-ref h 'number-type)]
[channels (hash-ref h 'channels)]
[block-size (hash-ref h 'blocksize)]
[bits (hash-ref h 'bits-per-sample)]
[endianness 'native-endian]
[result (flac-channels->interleaved-buffer
buffer block-size channels bits endianness)]
[mem-out (car result)]
[buf-size (cadr result)])
(hash-set! h 'duration (flac-duration handle))
(let ((sample (hash-ref h 'number)))
(hash-set! h 'sample sample))
(set! last-buffer buffer)
(set! last-buf-len block-size)
(hash-set! h 'sample (hash-ref h 'number))
(hash-set! h 'type 'interleaved)
(hash-set! h 'endianness endianness)
(hash-set! h 'bits-per-sample bits)
(set! last-buffer mem-out)
(set! last-buf-len buf-size)
(hash-set! kinds type #t)
(when (procedure? cb-audio)
(cb-audio h buffer block-size))
)
#t
)
(cb-audio h mem-out buf-size))
#t))
(define (process-meta handle meta)
(let ((type (FLAC__StreamMetadata-type meta)))
@@ -74,13 +119,14 @@
(hash-ref mh 'min-framesize) (hash-ref mh 'max-framesize)
(hash-ref mh 'sample-rate)
(hash-ref mh 'channels)
(hash-ref mh 'bits-per-sample)
32 ; (hash-ref mh 'bits-per-sample)
(hash-ref mh 'total-samples))))
(let ((duration (exact->inexact
(/ (hash-ref mh 'total-samples)
(hash-ref mh 'sample-rate)))))
(hash-set! mh 'duration duration))
(set-flac-handle-stream-info! handle si)
(hash-set! mh 'bits-per-sample 32) ; Flac works internally 32 bits.
(let ((cb (flac-handle-cb-stream-info handle)))
(when (procedure? cb)
(cb mh))))))
libao-async-ffi-racket.rkt
+1010
View File
File diff suppressed because it is too large Load Diff
libao.rkt
+1 -1
View File
@@ -1,7 +1,7 @@
#lang racket/base
(require (prefix-in fin: finalizer)
(prefix-in ffi: "libao-async-ffi.rkt")
(prefix-in ffi: "libao-async-ffi-racket.rkt")
ffi/unsafe
ffi/unsafe/custodian
data/queue
play-test.rkt
+17 -13
View File
@@ -21,8 +21,8 @@
(set! test-file4 (build-path tests "mahler-2.ogg"))
)
(when (eq? os 'windows)
(set! test-file3 (build-path tests "mahler-1.ogg"))
(set! test-file4 (build-path tests "mahler-2.ogg"))
(set! test-file3 (build-path tests "idyll.flac"))
(set! test-file4 (build-path tests "idyll.flac"))
)
)
@@ -43,6 +43,7 @@
(define seeked #f)
(define (audio-play type ao-type handle buf-info buffer buf-len)
;(dbg-sound "~a ~a ~a ~a ~a" type ao-type handle buf-info buf-len)
(let* ((sample (hash-ref buf-info 'sample))
(rate (hash-ref buf-info 'sample-rate))
(second (/ (* sample 1.0) (* rate 1.0)))
@@ -58,8 +59,19 @@
(let ((perc (exact->inexact (* (/ (- duration 15) duration) 100.0))))
(info-sound "Seeking to ~a%" perc)
(audio-seek current-audio-h perc))))))
(cond-volume (λ ()
(when (= (round current-seconds) 20)
(ao-set-volume! ao-h 70.0))
(when (= (round current-seconds) 25)
(ao-set-volume! ao-h 30))
(when (= (round current-seconds) 30)
(ao-set-volume! ao-h 100))
(when (= (round current-seconds) 35)
(ao-set-volume! ao-h 150))
(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)
@@ -116,6 +128,7 @@
(buf-seconds (exact->inexact (/ buf-size bytes-per-sample-all-channels rate))))
(second-printer buf-seconds)
(cond-seek)
(cond-volume)
(when (> buf-seconds 5)
(letrec ((waiter (λ ()
(let ((buf-seconds-left (exact->inexact
@@ -127,16 +140,7 @@
(begin
(sleep 0.5)
(second-printer buf-seconds)
(when (= (round current-seconds) 20)
(ao-set-volume! ao-h 70.0))
(when (= (round current-seconds) 25)
(ao-set-volume! ao-h 30))
(when (= (round current-seconds) 30)
(ao-set-volume! ao-h 100))
(when (= (round current-seconds) 35)
(ao-set-volume! ao-h 150))
(when (= (round current-seconds) 40)
(ao-set-volume! ao-h 100))
(cond-volume)
(cond-seek)
(waiter)))))
))