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