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

Merge branch 'main' of https://git.dijkewijk.nl/hans/racket-sound

Browse Source
This commit is contained in:
Hans Dijkema
2026-04-06 12:31:17 +02:00
parent 83c6de6e60 dd174469d9
commit 0b86b8712e
6 changed files with 58 additions and 25 deletions
Download Patch File Download Diff File Expand all files Collapse all files

9
libao-async.rkt
View File

@@ -94,7 +94,7 @@
(set-ao-shm-bufsize! shm (- bs buf-len)))
(mutex-unlock (ao-shm-mutex shm))
(ao_play ao-device buf buf-len) ; Play this buffer part
(free buf) ; Free the previously malloc 'raw (see libao.rkt)
;(free buf) ; Free the previously malloc 'raw (see libao.rkt)
)]
)
(player)
@@ -185,9 +185,10 @@
(let ((q (ao-shm-queue shm)))
(while (> (queue-length q) 0)
;(displayln (format "queue-length: ~a" (queue-length q)))
(let* ((elem (dequeue! q))
(buf (car (cddddr elem))))
(free buf))))
;(let* ((elem (dequeue! q))
;(buf (car (cddddr elem))))
;(free buf))))
(dequeue! q)))
(set-ao-shm-queue! shm (make-queue))
(set-ao-shm-bufsize! shm 0)
)

2
libao-ffi.rkt
View File

@@ -68,7 +68,7 @@
(define-libao ao_close (_fun _libao-pointer -> _int))
; void ao_shutdown();
(define-libao ao_shutdown (_fun -> _int))
(define-libao ao_shutdown (_fun -> _void))
; int ao_append_option(ao_option **options, const char *key, const char *value);
(define-libao ao_append_option (_fun _pointer _pointer _pointer -> _int))

13
libao.rkt
View File

@@ -55,8 +55,10 @@
(lambda (my-handle)
(hash-for-each devices
(lambda (handle-num device)
(displayln (format "closing ao handle ~a" handle-num))
(ao-close handle-num)))
(set! devices (make-hash))
(displayln "shutting down ao")
(ao_shutdown)
(plumber-flush-handle-remove! my-handle)
)))
@@ -154,11 +156,16 @@
(if (number? handle)
(let ((ao-device (hash-ref devices handle #f)))
(close-device #f ao-device))
(unless (eq? ao-device #f)
(displayln (format "Closing ao device ~a" ao-device))
(close-device #f ao-device)
(hash-remove! devices handle)))
(let ((handle-num (ao-handle-handle-num handle)))
(let ((ao-device (hash-ref devices handle-num #f)))
(unless (eq? ao-device #f)
(displayln (format "ao-device = ~a" ao-device))
(close-device handle ao-device))
(close-device handle ao-device)
(hash-remove! devices handle-num)))
)
)
)
@@ -187,7 +194,7 @@
(audio-buf-len (* channels bytes-per-sample buf-len))
(audio (if (eq? libao-async-mode 'ffi)
(malloc 'atomic audio-buf-len)
(malloc 'raw audio-buf-len)))
(malloc 'atomic audio-buf-len))) ; was: 'raw
(get-sample (lambda (k channel)
(let ((chan-buf (list-ref buffer channel)))
(vector-ref chan-buf k))))

42
libflac-ffi.rkt
View File

@@ -402,7 +402,8 @@
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
(define _FLAC__StreamDecoder-pointer (_cpointer 'flac-streamdecoder))
(define _FLAC__Data-pointer (_cpointer 'flac-client-data))
(define _FLAC__Data-pointer (_cpointer/null 'flac-client-data))
;(define _FLAC__StreamMetadata-pointer (_cpointer/null 'flac-stream-metadata))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; FLAC Callback function definitions
@@ -414,18 +415,21 @@
(_fun _FLAC__StreamDecoder-pointer
_FLAC__Frame-pointer
FLAC__int32**
_FLAC__Data-pointer -> _int))
_FLAC__Data-pointer
-> _int))
;typedef void(* FLAC__StreamDecoderMetadataCallback) (const FLAC__StreamDecoder *decoder, const FLAC__StreamMetadata *metadata, void *client_data)
(define _FLAC__StreamDecoderMetadataCallback
(_fun _FLAC__StreamDecoder-pointer
_FLAC__StreamMetadata-pointer
_FLAC__Data-pointer -> _void))
_FLAC__Data-pointer
-> _void))
(define _FLAC__StreamDecoderErrorCallback
(_fun _FLAC__StreamDecoder-pointer
_int
_FLAC__Data-pointer -> _void))
_FLAC__Data-pointer
-> _void))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -464,6 +468,7 @@
_FLAC__StreamDecoderWriteCallback
_FLAC__StreamDecoderMetadataCallback
_FLAC__StreamDecoderErrorCallback
_FLAC__Data-pointer ; Seen by Jens Axel Søgaard - Is already present in FLAC 1.4.3
-> _int))
(define-libflac FLAC__stream_decoder_process_single
@@ -478,6 +483,16 @@
(_fun _FLAC__StreamDecoder-pointer FLAC__uint64
-> _bool))
;FLAC_API FLAC__StreamMetadata *FLAC__metadata_object_clone(const FLAC__StreamMetadata *object);
(define-libflac FLAC__metadata_object_clone
(_fun _FLAC__StreamMetadata-pointer
-> _FLAC__StreamMetadata-pointer))
;FLAC_API void FLAC__metadata_object_delete(FLAC__StreamMetadata *object);
(define-libflac FLAC__metadata_object_delete
(_fun _FLAC__StreamMetadata-pointer
-> _void))
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Our interface for decoding to racket
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
@@ -488,15 +503,18 @@
(define error-no -1)
(define fl #f)
(define flac-file #f)
(define client-data #f)
(define (write-callback fl frame buffer data)
(define (write-callback fl frame buffer client-data)
(set! write-data (append write-data (list (cons frame buffer))))
0)
(define (meta-callback fl meta data)
(set! meta-data (append meta-data (list meta))))
(define (meta-callback fl meta client-data)
(let ((meta-clone (FLAC__metadata_object_clone meta)))
(unless (eq? meta-clone #f)
(set! meta-data (append meta-data (list meta-clone))))))
(define (error-callback fl errno data)
(define (error-callback fl errno client-data)
(set! error-no errno)
)
@@ -510,7 +528,8 @@
file
write-callback
meta-callback
error-callback)))
error-callback
client-data)))
(set! flac-file file)
r))
@@ -524,7 +543,10 @@
(decoder-state (int-state)))
(define (process-meta-data cb)
(for-each cb meta-data)
(for-each (λ (meta-entry)
(cb meta-entry)
(FLAC__metadata_object_delete meta-entry))
meta-data)
(set! meta-data '()))
(define (process-write-data cb)

3
play-test.rkt
View File

@@ -15,6 +15,7 @@
)
)
(ao-set-async-mode! 'ffi)
;(define fmt (ao-mk-format 24 48000 2 'big-endian))
;(define ao-h (ao-open-live #f fmt))
@@ -34,7 +35,7 @@
(when (eq? ao-h #f)
(let ((fmt (ao-mk-format bits-per-sample rate channels 'big-endian)))
(set! ao-h (ao-open-live #f fmt))))
(ao-play ao-h second buffer)
(ao-play ao-h second duration buffer)
(let ((second-printer (λ ()
(let ((s (inexact->exact (round (ao-at-second ao-h)))))
(unless (= s current-seconds)

4
taglib.rkt
View File

@@ -67,7 +67,9 @@
(disc-number -1)
(picture #f))
(let ((tag-file (taglib_file_new file)))
(set! valid? (taglib_file_is_valid tag-file))
(if (eq? tag-file #f)
(set! valid? #f)
(set! valid? (taglib_file_is_valid tag-file)))
(when valid?
(let ((tag (taglib_file_tag tag-file))
(ap (taglib_file_audioproperties tag-file))