testing placed backend

ao-placed-player.rkt

@@ -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)])))

ao-player.rkt

@@ -0,0 +1,229 @@
+#lang racket/base
+
+(require racket/place
+         racket/runtime-path
+         "private/utils.rkt"
+         "libao.rkt")
+
+(provide make-ao-player
+         ao-player?
+         ao-player-open-file!
+         ao-player-open-live!
+         ao-player-play!
+         ao-player-close!
+         ao-player-stop!
+         ao-player-clear!
+         ao-player-pause!
+         ao-player-set-volume!
+         ao-player-volume
+         ao-player-status
+         ao-player-at-second
+         ao-player-music-duration
+         ao-player-at-music-id
+         ao-player-bufsize-async
+         ao-player-reuse-buf-len-async
+         ao-player-sample-queue-len-async
+         ao-player-device-bits
+         ao-player-valid?
+         ao-player-playback-buf-ms
+         ao-player-set-playback-buf-ms!
+         ao-player-audio-callback
+         ao-valid-bits?
+         ao-valid-rate?
+         ao-valid-channels?
+         ao-valid-format?
+         ao-supported-music-format?)
+
+(define-runtime-path placed-player-module "ao-placed-player.rkt")
+
+(struct ao-player
+  (cmd-ch
+   log-ch
+   current-bits
+   current-rate
+   current-channels
+   current-endianness
+   wav-output-file
+   device-bits)
+  #:mutable
+  #:transparent)
+
+(define (default-log-handler msg)
+  (dbg-sound msg))
+
+(define (start-log-reader! log-ch log-handler)
+  (thread
+   (lambda ()
+     (let loop ()
+       (define msg (place-channel-get log-ch))
+       (log-handler msg)
+       (loop)))))
+
+(define (make-ao-player #:wav-output-file [wav-output-file #f]
+                        #:log-handler [log-handler default-log-handler])
+  (let ((cmd-ch (dynamic-place placed-player-module 'ao-placed-player-main)))
+    (let-values (((log-main-ch log-place-ch) (place-channel)))
+      ;; Geef het place-einde van het log-channel aan de worker.
+      (place-channel-put cmd-ch log-place-ch)
+
+      ;; Main-kant leest logs.
+      (start-log-reader! log-main-ch log-handler)
+
+      ;; Startup handshake via command-channel.
+      (define started (place-channel-get cmd-ch))
+      (unless (eq? started 'started)
+        (error 'make-ao-player "ao place did not start: ~a" started))
+
+      (ao-player cmd-ch log-main-ch
+                 -1 -1 -1
+                 'native-endian
+                 wav-output-file
+                 0))))
+
+(define (send! player msg)
+  (place-channel-put (ao-player-cmd-ch player) msg))
+
+(define (call! player msg)
+  (define cmd-ch (ao-player-cmd-ch player))
+  (place-channel-put cmd-ch msg)
+  (place-channel-get cmd-ch))
+
+(define (reset-format-cache! player)
+  (set-ao-player-current-bits! player -1)
+  (set-ao-player-current-rate! player -1)
+  (set-ao-player-current-channels! player -1)
+  (set-ao-player-current-endianness! player 'native-endian)
+  (set-ao-player-device-bits! player 0))
+
+(define (same-format? player bits rate channels endianness)
+  (and (= (ao-player-current-bits player) bits)
+       (= (ao-player-current-rate player) rate)
+       (= (ao-player-current-channels player) channels)
+       (eq? (ao-player-current-endianness player) endianness)))
+
+(define (remember-format! player bits rate channels endianness reply)
+  (set-ao-player-current-bits! player bits)
+  (set-ao-player-current-rate! player rate)
+  (set-ao-player-current-channels! player channels)
+  (set-ao-player-current-endianness! player endianness)
+  (set-ao-player-device-bits! player (hash-ref reply 'device-bits 0)))
+
+(define (ao-player-open-file! player bits rate channels
+                              #:endianness [endianness 'native-endian]
+                              #:wav-output-file [wav-output-file
+                                                 (ao-player-wav-output-file player)])
+  (cond
+    [(same-format? player bits rate channels endianness) #t]
+    [else
+     (define reply
+       (call! player `(open-file ,bits ,rate ,channels
+                                 ,endianness ,wav-output-file)))
+     (cond
+       [(hash-ref reply 'ok? #f)
+        (remember-format! player bits rate channels endianness reply)
+        #t]
+       [else
+        (reset-format-cache! player)
+        #f])]))
+
+(define (ao-player-open-live! player bits rate channels
+                              #:endianness [endianness 'native-endian])
+  (cond
+    [(same-format? player bits rate channels endianness) #t]
+    [else
+     (define reply
+       (call! player `(open-live ,bits ,rate ,channels ,endianness)))
+     (cond
+       [(hash-ref reply 'ok? #f)
+        (remember-format! player bits rate channels endianness reply)
+        #t]
+       [else
+        (reset-format-cache! player)
+        #f])]))
+
+(define (ao-player-open-for-info! player buf-info)
+  (define bits (hash-ref buf-info 'bits-per-sample))
+  (define rate (hash-ref buf-info 'sample-rate))
+  (define channels (hash-ref buf-info 'channels))
+  (define endianness (hash-ref buf-info 'endianness 'native-endian))
+  (if (ao-player-wav-output-file player)
+      (ao-player-open-file! player bits rate channels #:endianness endianness)
+      (ao-player-open-live! player bits rate channels #:endianness endianness)))
+
+(define (ao-player-play! player music-id second duration
+                         buf-info buffer buf-len ao-type)
+  ;; This intentionally synchronizes on open/reopen.  If opening fails or
+  ;; hangs, the caller sees it immediately.
+  (when (ao-player-open-for-info! player buf-info)
+    (send! player `(play ,music-id ,second ,duration
+                         ,buffer ,buf-len ,ao-type))))
+
+(define (ao-player-clear! player)
+  (send! player '(clear)))
+
+(define (ao-player-pause! player paused?)
+  (send! player `(pause ,paused?)))
+
+(define (ao-player-set-volume! player volume)
+  (send! player `(set-volume ,volume)))
+
+(define (ao-player-status player)
+  (call! player '(status)))
+
+(define (status-ref player key fallback)
+  (hash-ref (ao-player-status player) key fallback))
+
+(define (ao-player-at-second player)
+  (status-ref player 'at-second 0.0))
+
+(define (ao-player-music-duration player)
+  (status-ref player 'duration 0.0))
+
+(define (ao-player-at-music-id player)
+  (status-ref player 'music-id 0))
+
+(define (ao-player-bufsize-async player)
+  (status-ref player 'buf-size 0))
+
+(define (ao-player-reuse-buf-len-async player)
+  (status-ref player 'reuse-buf-len 0))
+
+(define (ao-player-sample-queue-len-async player)
+  (status-ref player 'sample-queue-len 0))
+
+(define (ao-player-volume player)
+  (status-ref player 'volume 100.0))
+
+(define (ao-player-valid? player)
+  (call! player '(valid?)))
+
+(define (ao-player-close! player)
+  (define r (call! player '(close)))
+  (reset-format-cache! player)
+  r)
+
+(define (ao-player-stop! player)
+  (define r (call! player '(stop)))
+  (reset-format-cache! player)
+  r)
+
+(define (ao-player-playback-buf-ms player)
+  (call! player '(playback-buf-ms)))
+
+(define (ao-player-set-playback-buf-ms! player ms)
+  (call! player `(set-playback-buf-ms ,ms)))
+
+(define (ao-player-audio-callback player current-music-id)
+  (lambda (type ao-type handle buf-info buffer buf-len)
+    (define sample (hash-ref buf-info 'sample 0))
+    (define rate (hash-ref buf-info 'sample-rate 44100))
+    (define second (/ (exact->inexact sample) (exact->inexact rate)))
+    (define duration (hash-ref buf-info 'duration 0.0))
+    (ao-player-play! player
+                     (current-music-id)
+                     second
+                     duration
+                     buf-info
+                     buffer
+                     buf-len
+                     ao-type)))

libao-async-ffi-racket.rkt

@@ -14,7 +14,8 @@
          racket/async-channel
          data/queue
          racket/list
-         "private/utils.rkt")
+         "private/utils.rkt"
+         racket/place)
 
 (provide ao_version_async
          ao_create_async
@@ -511,6 +512,7 @@
 ;; ASync player
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
+
 (define (run h)
   (thread
    (λ ()

test-player-2.rkt

@@ -0,0 +1,188 @@
+#lang racket/base
+
+(require "ao-player.rkt"
+         "audio-decoder.rkt"
+         simple-log
+         "private/utils.rkt"
+         racket-sprintf
+         racket/runtime-path)
+
+(define-runtime-path tests "../racket-audio-test")
+
+(define test-file3 (build-path tests "idyll.flac"))
+(define test-file4 (build-path tests "mahler-2.mp3"))
+(define test-file3-id 3)
+(define test-file4-id 4)
+
+(define current-seconds 0)
+(define current-file-id -1)
+(define current-audio-h #f)
+(define player #f)
+
+(sl-log-to-display)
+
+(define wav-output-file #f)
+(define seeked #f)
+
+(define (player-status)
+  (if player
+      (ao-player-status player)
+      (hash 'open? #f
+            'at-second 0.0
+            'duration 0.0
+            'buf-size 0
+            'volume 100.0
+            'reuse-buf-len 0
+            'sample-queue-len 0
+            'device-bits 0)))
+
+(define (player-at-second)
+  (hash-ref (player-status) 'at-second 0.0))
+
+(define (player-volume)
+  (hash-ref (player-status) 'volume 100.0))
+
+(define (player-bufsize)
+  (hash-ref (player-status) 'buf-size 0))
+
+(define (player-reuse-buf-len)
+  (hash-ref (player-status) 'reuse-buf-len 0))
+
+(define (player-sample-queue-len)
+  (hash-ref (player-status) 'sample-queue-len 0))
+
+(define (cond-seek duration)
+  (when (>= (round current-seconds) 10)
+    (when (and (= current-file-id test-file3-id) (not seeked))
+      (set! seeked #t)
+      (let ((perc (exact->inexact (* (/ (- duration 15) duration) 100.0))))
+        (info-sound "Seeking to ~a%" perc)
+        (audio-seek current-audio-h perc)))))
+
+(define (cond-volume)
+  (when (= (round current-seconds) 20)
+    (ao-player-set-volume! player 70.0))
+  (when (= (round current-seconds) 25)
+    (ao-player-set-volume! player 30))
+  (when (= (round current-seconds) 30)
+    (ao-player-set-volume! player 100))
+  (when (= (round current-seconds) 35)
+    (ao-player-set-volume! player 150))
+  (when (= (round current-seconds) 40)
+    (ao-player-set-volume! player 100)))
+
+(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)))
+         (bits-per-sample (hash-ref buf-info 'bits-per-sample))
+         (bytes-per-sample (/ bits-per-sample 8))
+         (channels (hash-ref buf-info 'channels))
+         (bytes-per-sample-all-channels (* channels bytes-per-sample))
+         (duration (hash-ref buf-info 'duration)))
+
+    ;; Fire-and-forget naar de player-place.  De player opent/sluit intern
+    ;; opnieuw wanneer bits/rate/channels wijzigen.
+    ;(dbg-sound "Playing ~a" buf-info)
+    ;(sync-log-sound)
+    (ao-player-play! player
+                     current-file-id
+                     second
+                     duration
+                     buf-info
+                     buffer
+                     buf-len
+                     ao-type)
+    ;(dbg-sound "played")
+    ;(sync-log-sound)
+
+    (let ((duration* (inexact->exact (round duration))))
+      (define (second-printer buf-seconds)
+        (let* ((st (player-status))
+               (s (inexact->exact (round (hash-ref st 'at-second 0.0)))))
+          (unless (= s current-seconds)
+            (set! current-seconds s)
+            (let ((minutes (quotient s 60))
+                  (seconds (remainder s 60))
+                  (tminutes (quotient duration* 60))
+                  (tseconds (remainder duration* 60))
+                  (volume (hash-ref st 'volume 100.0)))
+              (info-sound
+               (sprintf "At time: %02d:%02d (%02d:%02d) - %d - volume: %d"
+                        minutes seconds
+                        tminutes tseconds
+                        buf-seconds
+                        volume))))))
+
+      (let* ((st (player-status))
+             (buf-size (hash-ref st 'buf-size 0))
+             (buf-seconds
+              (exact->inexact
+               (/ buf-size bytes-per-sample-all-channels rate))))
+        (second-printer buf-seconds)
+        (cond-seek duration)
+        (cond-volume)
+
+        (when (> buf-seconds 10)
+          (info-sound "Reuse buf/Sample queue: ~a/~a"
+                      (hash-ref st 'reuse-buf-len 0)
+                      (hash-ref st 'sample-queue-len 0))
+
+          (letrec ((waiter
+                    (lambda ()
+                      (let* ((st (player-status))
+                             (buf-size-left (hash-ref st 'buf-size 0))
+                             (buf-seconds-left
+                              (exact->inexact
+                               (/ buf-size-left
+                                  bytes-per-sample-all-channels
+                                  rate))))
+                        (if (< buf-seconds-left 3.0)
+                            (info-sound "Seconds in buffer left: ~a"
+                                        buf-seconds-left)
+                            (begin
+                              (sleep 0.5)
+                              (second-printer buf-seconds-left)
+                              (cond-volume)
+                              (cond-seek duration)
+                              (waiter)))))))
+            (waiter)
+            (let ((st (player-status)))
+              (info-sound "Reuse buf/Sample queue: ~a/~a"
+                          (hash-ref st 'reuse-buf-len 0)
+                          (hash-ref st 'sample-queue-len 0)))))))))
+
+(define (audio-meta type ao-type handle meta)
+  (dbg-sound "type:    ~a" type)
+  (dbg-sound "ao-type: ~a" ao-type)
+  (dbg-sound "meta:    ~a" meta))
+
+(define (play-one file file-id)
+  (let ((audio-h (audio-open file audio-meta audio-play)))
+    (set! current-file-id file-id)
+    (set! current-audio-h audio-h)
+    (audio-read audio-h)))
+
+(define (play)
+  (set! player (make-ao-player #:wav-output-file wav-output-file))
+  (set! current-seconds 0)
+  (set! seeked #f)
+
+  (displayln (player-status))
+
+  (play-one test-file3 test-file3-id)
+
+  ;; Bij overgang naar volgend bestand: queue leegmaken, zodat oude buffers
+  ;; niet doorlopen in de volgende track.
+  (ao-player-clear! player)
+
+  (info-sound "Opening next file: ~a" test-file4)
+  (set! current-seconds 0)
+  (play-one test-file4 test-file4-id)
+
+  (ao-player-close! player)
+  (set! player #f))
+
+(play)