gemigreerd-racket-audio/audio-player.rkt

#lang racket/base

(require racket/place
         racket/contract
         racket/async-channel
         racket/runtime-path
         "audio-placed-player.rkt"
         "private/utils.rkt"
         (prefix-in ffi: ffi/unsafe)
         )

(provide make-audio-player
         audio-play!
         audio-pause!
         audio-paused?
         audio-stop!
         audio-quit!
         audio-seek!
         audio-volume!
         audio-volume
         audio-at-second
         audio-duration
         audio-state
         audio-bits
         audio-channels
         audio-decoder
         audio-music-id
         audio-rate
         audio-full-state
         audio-file
         audio-play?
         audio-buf-seconds!
         audio-ao-buf-ms!
         audio-ao-buf-ms
         audio-known-exts?
         )

(define-runtime-path placed-player-module "audio-placed-player.rkt")

(define-struct audio-play
  (valid? cb-state cb-eof-stream rpc au-place evt-thread state)
  #:mutable
  #:transparent
  )

(define audio-play-struct? audio-play?)
(set! audio-play? (λ (h)
                    (and (audio-play-struct? h)
                         (audio-play-valid? h))))


(define (percentage? p)
  (and (number? p) (>= p 0)))

(define (max-percentage? n)
  (λ (p) (and (percentage? p)
              (<= p n))))

(define (is-return? retval sym)
  ;(displayln retval)
  (if (list? retval)
      (if (null? retval)
          #f
          (eq? (car retval) sym))
      #f))

(define (to-ret-value ret)
  (if (list? ret)
      (if (null? ret)
          (error (format "audio-player: no return value in ~a" ret))
          (car ret))
      ret))

(define (is-event? evt sym)
  (is-return? evt sym))

(define (evt-data evt)
  (cadr evt))

(define-syntax assert
  (syntax-rules ()
    ((_ cond message ...)
     (unless cond (error (format message ...))))))

(define/contract (make-audio-player cb-state cb-eof-stream
                                    #:use-place [use-place (place-enabled?)])
  (->* (procedure? procedure?) (#:use-place boolean?) audio-play?)
  (let ((cmd-ch #f)
        (ret-ch #f)
        (evt-ch #f)
        (cmd-put #f)
        (ret-get #f)
        (evt-get #f)
        (au-pl #f)
        (dead-guard #f)
        (rpc #f)
        (rpc-mutex (make-mutex))
        )
    (if use-place
        (begin
          (set! cmd-ch (dynamic-place placed-player-module 'placed-player))
          (set! cmd-put (λ (data) (place-channel-put cmd-ch data)))
          (set! au-pl cmd-ch)
          (set! dead-guard (λ () (let ((evt (place-dead-evt au-pl)))
                                   (sync evt))))
          (let-values (((ret-ch-in ret-ch-out) (place-channel))
                       ((evt-ch-in evt-ch-out) (place-channel)))
            (place-channel-put cmd-ch (list 'init ret-ch-out evt-ch-out))
            (set! evt-ch evt-ch-in)
            (set! ret-ch ret-ch-in)
            (assert (is-return? (place-channel-get ret-ch-in) 'initialized)
                    "Unexpected: not 'initialized returnd from 'init command"))
          )
        (begin
          (set! cmd-ch (make-async-channel))
          (set! cmd-put (λ (data) (async-channel-put cmd-ch data)))
          (set! au-pl (thread (λ () (placed-player cmd-ch))))
          (set! dead-guard (λ () (let ((evt (thread-dead-evt au-pl)))
                                   (sync evt))))
          (set! ret-ch (make-async-channel))
          (set! evt-ch (make-async-channel))
          (async-channel-put cmd-ch (list 'init ret-ch evt-ch))
          (assert (is-return? (async-channel-get ret-ch) 'initialized)
                  "Unexpected: not 'initialized returnd from 'init command")
          )
        )
    (set! ret-get (λ () (to-ret-value (sync ret-ch))))
    (set! evt-get (λ (timeout-ms) (sync/timeout (/ timeout-ms 1000) evt-ch)))
    (set! rpc (λ (cmd . args) (with-mutex rpc-mutex
                                (cmd-put (cons cmd args)) (ret-get))))

    (let* ((handle #f)
           (cb-state* (λ (st) (cb-state handle st)))
           (cb-eof*   (λ () (cb-eof-stream handle))))
      (set! handle (make-audio-play #t
                                   cb-state* cb-eof*
                                   rpc
                                   au-pl
                                   #f
                                   (make-hash)))
      (set-audio-play-evt-thread! handle
            (thread
             (λ ()
               (let loop ()
                 (if (audio-play-valid? handle)
                     (let ((e (evt-get 500)))
                       (cond ((eq? e #f) (loop))
                             ((is-event? e 'state)
                              (set-audio-play-state! handle (evt-data e))
                              (cb-state* (evt-data e)))
                             ((is-event? e 'audio-done) (cb-eof*))
                             ((is-event? e 'exception)
                              (err-sound "audio-player: exception event: ~a" e))
                             (else (warn-sound "audio-player: unknown event ~a" e))
                             )
                       (loop))
                     'done)))))

      (thread (λ ()
                (dbg-sound "guarding audio-placed-player")
                (dead-guard)
                (dbg-sound "audio-placed-player has stopped")
                (set-audio-play-valid?! handle #f)
                (set-audio-play-rpc! handle #f)
                (set-audio-play-au-place! handle #f)
                (set-audio-play-evt-thread! handle #f)
                (set-audio-play-cb-state! handle #f)
                (set-audio-play-cb-eof-stream! handle #f)
                (when (hash? (audio-play-state handle))
                  (let ((h (hash-copy (audio-play-state handle))))
                    (hash-set! h 'state 'invalid)
                    (set-audio-play-state! handle h)))
                (dbg-sound "audio-play handle invalidated and cleaned of references")
                ))

      (ffi:register-finalizer handle
                          (λ (h)
                            (when (audio-play? h)
                              (rpc 'quit))))
      
      handle)
    )
  )

(define/contract (audio-play! handle audio-file)
  (->  audio-play? path-string? number?)
  (let ((result ((audio-play-rpc handle) 'open audio-file)))
    (when (eq? result 'error)
        (error "Got an error from the placed audio player"))
    (cadr result)))

(define/contract (audio-pause! handle paused)
  (-> audio-play? boolean? symbol?)
  ((audio-play-rpc handle) 'pause paused))

(define/contract (audio-paused? handle)
  (-> audio-play? boolean?)
  ((audio-play-rpc handle) 'paused))

(define/contract (audio-stop! handle)
  (-> audio-play? symbol?)
  ((audio-play-rpc handle) 'stop))

(define/contract (audio-quit! handle)
  (-> audio-play? (or/c number? boolean? symbol?))
  (let ((r ((audio-play-rpc handle) 'quit)))
    (set-audio-play-valid?! handle #f)
    r))

(define/contract (audio-seek! handle percentage)
  (-> audio-play? (max-percentage? 100) symbol?)
  ((audio-play-rpc handle) 'seek percentage))

(define/contract (audio-volume! handle percentage)
  (-> audio-play? percentage? symbol?)
  ((audio-play-rpc handle) 'volume percentage))

(define/contract (audio-volume handle)
  (-> audio-play? percentage?)
  ((audio-play-rpc handle) 'get-volume))

(define/contract (audio-full-state handle)
  (-> audio-play? hash?)
  (audio-play-state handle))

(define-syntax get-state
  (syntax-rules ()
    ((_ handle id def)
     (hash-ref (audio-play-state handle) id def))))

(define/contract (audio-at-second handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'at-second #f))

(define/contract (audio-duration handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'duration #f))

(define/contract (audio-channels handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'channels #f))

(define/contract (audio-state handle)
  (-> audio-play-struct? symbol?)
  (if (audio-play-valid? handle)
      (get-state handle 'state 'initialized)
      'invalid))

(define/contract (audio-bits handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'bits #f))

(define/contract (audio-rate handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'rate #f))

(define/contract (audio-decoder handle)
  (-> audio-play? (or/c symbol? boolean?))
  (get-state handle 'decoder #f))

(define/contract (audio-music-id handle)
  (-> audio-play? (or/c number? boolean?))
  (get-state handle 'at-music-id #f))

(define/contract (audio-file handle)
  (-> audio-play? (or/c path-string? boolean?))
  (get-state handle 'file #f))

(define/contract (audio-buf-seconds! handle min max)
  (-> audio-play? number? number? (or/c symbol? boolean?))
  (let ((from (if (< min 1) 1 (if (> min 10) 10 min)))
        (until (if (< max min) (+ min 1) (if (> max 30) 30 max))))
    ((audio-play-rpc handle) 'buf-seconds from until)))

(define/contract (audio-ao-buf-ms! handle ms)
  (-> audio-play? integer? (or/c integer? boolean?))
  ((audio-play-rpc handle) 'ao-buf-ms ms))

(define/contract (audio-ao-buf-ms handle)
  (-> audio-play? (or/c integer? boolean?))
  ((audio-play-rpc handle) 'ao-buf-ms))