testing placed backend

2026-05-12 14:42:49 +02:00
parent b7f58f43a9
commit a2f7341f1f
4 changed files with 552 additions and 1 deletions
@@ -0,0 +1,132 @@
+#lang racket/base
+
+(require racket/place
+         racket/match
+         "libao.rkt")
+
+(provide ao-placed-player-main)
+
+(define (closed-status)
+  (hash 'open? #f
+        'valid? #f
+        'at-second 0.0
+        'duration 0.0
+        'music-id 0
+        'buf-size 0
+        'reuse-buf-len 0
+        'sample-queue-len 0
+        'volume 100.0
+        'device-bits 0))
+
+(define (handle-status h)
+  (if (and h (ao-valid? h))
+      (hash 'open? #t
+            'valid? #t
+            'at-second (ao-at-second h)
+            'duration (ao-music-duration h)
+            'music-id (ao-at-music-id h)
+            'buf-size (ao-bufsize-async h)
+            'reuse-buf-len (ao-reuse-buf-len-async h)
+            'sample-queue-len (ao-sample-queue-len-async h)
+            'volume (ao-volume h)
+            'device-bits (ao-device-bits h))
+      (closed-status)))
+
+(define (ao-placed-player-main cmd-ch)
+  ;; First message must provide the log channel.
+  (define log-ch (place-channel-get cmd-ch))
+
+  (define (log! fmt . args)
+    (place-channel-put log-ch (apply format fmt args)))
+
+  (log! "ao-placed-player: started")
+
+  (define h #f)
+
+  (define (close!)
+    (when h
+      (log! "ao-placed-player: close")
+      (ao-close h)
+      (set! h #f)))
+
+  (place-channel-put cmd-ch 'started)
+
+  (let loop ()
+    (match (place-channel-get cmd-ch)
+
+      [`(open-file ,bits ,rate ,channels ,endianness ,wav-output-file)
+       (log! "open-file bits=~a rate=~a channels=~a endian=~a file=~a"
+             bits rate channels endianness wav-output-file)
+       (close!)
+       (set! h (ao-open-file bits rate channels endianness wav-output-file))
+       (place-channel-put
+        cmd-ch
+        (if (and h (ao-valid? h))
+            (hash 'ok? #t 'device-bits (ao-device-bits h))
+            (hash 'ok? #f 'device-bits 0)))
+       (loop)]
+
+      [`(open-live ,bits ,rate ,channels ,endianness)
+       (log! "open-live bits=~a rate=~a channels=~a endian=~a"
+             bits rate channels endianness)
+       (close!)
+       (set! h (ao-open-live bits rate channels endianness))
+       (place-channel-put
+        cmd-ch
+        (if (and h (ao-valid? h))
+            (hash 'ok? #t 'device-bits (ao-device-bits h))
+            (hash 'ok? #f 'device-bits 0)))
+       (loop)]
+
+      [`(play ,music-id ,second ,duration ,buffer ,buf-len ,ao-type)
+       (when (and h (ao-valid? h))
+         (ao-play h music-id second duration buffer buf-len ao-type))
+       (loop)]
+
+      [`(clear)
+       (log! "clear")
+       (when (and h (ao-valid? h))
+         (ao-clear-async h))
+       (loop)]
+
+      [`(pause ,paused?)
+       (log! "pause ~a" paused?)
+       (when (and h (ao-valid? h))
+         (ao-pause h paused?))
+       (loop)]
+
+      [`(set-volume ,volume)
+       (log! "set-volume ~a" volume)
+       (when (and h (ao-valid? h))
+         (ao-set-volume! h volume))
+       (loop)]
+
+      [`(status)
+       (place-channel-put cmd-ch (handle-status h))
+       (loop)]
+
+      [`(valid?)
+       (place-channel-put cmd-ch (and h (ao-valid? h)))
+       (loop)]
+
+      [`(playback-buf-ms)
+       (place-channel-put cmd-ch (ao-playback-buf-ms))
+       (loop)]
+
+      [`(set-playback-buf-ms ,ms)
+       (ao-set-playback-buf-ms! ms)
+       (place-channel-put cmd-ch 'ok)
+       (loop)]
+
+      [`(close)
+       (close!)
+       (place-channel-put cmd-ch 'closed)]
+
+      [`(stop)
+       (close!)
+       (place-channel-put cmd-ch 'stopped)
+       (loop)]
+
+      [msg
+       (log! "unknown message: ~a" msg)
+       (loop)])))