gemigreerd-racket-audio/ao-player.rkt

#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)))