From 3439bd8fdc93b176f0bf2aa9cc19c47ad2801b11 Mon Sep 17 00:00:00 2001 From: Hans Dijkema Date: Mon, 23 Feb 2026 15:32:50 +0100 Subject: [PATCH] - --- libao/libao-async.rkt | 138 ++++++++++++++++++++++++++++++++++++++++++ libao/libao.rkt | 6 +- play-test.rkt | 20 +++--- 3 files changed, 155 insertions(+), 9 deletions(-) create mode 100644 libao/libao-async.rkt diff --git a/libao/libao-async.rkt b/libao/libao-async.rkt new file mode 100644 index 0000000..408c1a3 --- /dev/null +++ b/libao/libao-async.rkt @@ -0,0 +1,138 @@ +#lang racket/base + +(require ffi/unsafe/os-thread + "../utils/utils.rkt" + "libao-ffi.rkt" + data/queue + ) + +(provide ao_create_async + ao_stop_async + ao_play_async + ao_is_at_second_async + ao_bufsize_async + ao_clear_async + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; Mutex +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (make-mutex) + (let ((sem (make-os-semaphore))) + (os-semaphore-post sem) + sem)) + +(define (mutex-lock mutex) + (os-semaphore-wait mutex)) + +(define (mutex-unlock mutex) + (os-semaphore-post mutex)) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; ao-player in os thread +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define-struct ao-shm + (mutex + device + [at-second #:mutable] + [bufsize #:mutable] + queue-sem + [queue #:mutable] + ) + #:transparent + ) + +(define (ao-player* shm) + (call-in-os-thread + ;(thread + (λ () + (let ((ao-device (ao-shm-device shm))) + (define (player) + (os-semaphore-wait (ao-shm-queue-sem shm)) + (mutex-lock (ao-shm-mutex shm)) + (if (= (queue-length (ao-shm-queue shm)) 0) + (begin + (mutex-unlock (ao-shm-mutex shm)) + (player)) + (let* ((elem (dequeue! (ao-shm-queue shm))) + (command (car elem)) + ) + (mutex-unlock (ao-shm-mutex shm)) + (cond + [(eq? command 'stop) + (begin + ;(displayln "stopping") + 'done)] + [(eq? command 'play) + (let ((at-second (cadr elem)) + (buf-len (caddr elem)) + (buf (cadddr elem)) + ) + (mutex-lock (ao-shm-mutex shm)) + (set-ao-shm-at-second! shm at-second) + (let ((bs (ao-shm-bufsize shm))) + (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 + )] + ) + (player) + ) + ) + ) + (player) + ) + ) + ) + ) + +(define (ao-player ao_device) + (let ((shm (make-ao-shm (make-mutex) ao_device 0.0 0 (make-os-semaphore) (make-queue)))) + (ao-player* shm) + shm + ) + ) + +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;; External interface +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; + +(define (ao_create_async ao_device) + (ao-player ao_device)) + +(define (ao_stop_async shm) + (displayln "Stopping") + (mutex-lock (ao-shm-mutex shm)) + (enqueue! (ao-shm-queue shm) (list 'stop 0 #f #f)) + (os-semaphore-post (ao-shm-queue-sem shm)) + (mutex-unlock (ao-shm-mutex shm)) + ) + +(define (ao_play_async shm at-second buf-size buf) + (let ((item (list 'play at-second buf-size buf))) + (mutex-lock (ao-shm-mutex shm)) + (let ((bs (ao-shm-bufsize shm))) + (set-ao-shm-bufsize! shm (+ bs buf-size))) + (enqueue! (ao-shm-queue shm) item) + (os-semaphore-post (ao-shm-queue-sem shm)) + (mutex-unlock (ao-shm-mutex shm)))) + +(define (ao_is_at_second_async shm) + (mutex-lock (ao-shm-mutex shm)) + (let ((at-second (ao-shm-at-second shm))) + (mutex-unlock (ao-shm-mutex shm)) + at-second)) + +(define (ao_bufsize_async shm) + (mutex-lock (ao-shm-mutex shm)) + (let ((buf-size (ao-shm-bufsize shm))) + (mutex-unlock (ao-shm-mutex shm)) + buf-size)) + +(define (ao_clear_async shm) + (mutex-lock (ao-shm-mutex shm)) + (set-ao-shm-queue! shm (make-queue)) + (mutex-unlock (ao-shm-mutex shm))) + diff --git a/libao/libao.rkt b/libao/libao.rkt index f117d1d..7596f74 100644 --- a/libao/libao.rkt +++ b/libao/libao.rkt @@ -1,7 +1,8 @@ #lang racket/base (require "libao-ffi.rkt" - "libao-async-ffi.rkt" + ;"libao-async-ffi.rkt" + "libao-async.rkt" (prefix-in fin: finalizer) ffi/unsafe data/queue @@ -87,7 +88,7 @@ (set-ao-handle-byte-format! handle endianness) (set-ao-handle-rate! handle rate) (set-ao-handle-channels! handle channels) - (set-ao-handle-async-player! handle (ao_create_async ao-device ao_play_ptr)) + (set-ao-handle-async-player! handle (ao_create_async ao-device)) ; ao_play_ptr)) (hash-set! devices handle-num ao-device) (fin:register-finalizer handle (lambda (handle) @@ -97,6 +98,7 @@ ))) (define (ao-close handle) + (displayln handle) (if (number? handle) (let ((ao-device (hash-ref devices handle #f))) (unless (eq? ao-device #f) diff --git a/play-test.rkt b/play-test.rkt index 7321506..0684ba6 100644 --- a/play-test.rkt +++ b/play-test.rkt @@ -1,8 +1,8 @@ #lang racket/base -(require ;"libao/libao.rkt" - ;"libflac/flac-decoder.rkt" +(require "libao/libao.rkt" + "libflac/flac-decoder.rkt" ;data/queue - racket-sound + ;racket-sound ) (define test-file3 #f) @@ -37,7 +37,7 @@ (ao-play ao-h second buffer) (let ((second-printer (λ () (let ((s (inexact->exact (round (ao-at-second ao-h))))) - (when (> s current-seconds) + (unless (= s current-seconds) (set! current-seconds s) (let ((minutes (quotient s 60)) (seconds (remainder s 60)) @@ -72,8 +72,14 @@ (define (flac-meta meta) (displayln meta)) -(define flac-h - (flac-open test-file3 flac-meta flac-play)) +(define (play) + (let ((flac-h (flac-open test-file3 flac-meta flac-play))) + (flac-read flac-h) + (ao-close ao-h))) + ;(sleep 1.0) + ;(play))) -(flac-read flac-h) +;(flac-read flac-h) + +(play)