racket-sound/libao.rkt

#lang racket/base

(require (prefix-in fin: finalizer)
         (prefix-in ffi: "libao-async-ffi.rkt")
         ffi/unsafe
         ffi/unsafe/custodian
         data/queue
         "private/utils.rkt"
         (prefix-in rc: racket/contract)
         )

(provide ao-open-live
         ao-play
         ao-close
         ao-at-second
         ao-music-duration
         ao-at-music-id
         ao-bufsize-async
         ao-clear-async
         ao-pause
         ao-valid?
         ao-valid-bits?
         ao-valid-rate?
         ao-valid-channels?
         ao-valid-format?
         ao-handle?
         ao-supported-music-format?
         )

(define device-number 1)

(define-struct ao-handle (handle-num
                          [bits #:auto #:mutable]
                          [bytes-per-sample #:auto #:mutable]
                          [byte-format #:auto #:mutable]
                          [channels #:auto #:mutable]
                          [rate #:auto #:mutable]
                          [async-player #:auto #:mutable]
                          [closed #:auto #:mutable]
                          )
  #:auto-value #f
  )


(define (ao-supported-music-format? f)
  (and (symbol? f)
       (or (eq? f 'flac)
           (eq? f 'mp3)
           (eq? f 'ao))))


(define (bytes-for-bits bits)
  (/ bits 8))

(define (ao-valid-bits? bits)
  (and (integer? bits) (or
                        (= bits 8)
                        (= bits 16)
                        (= bits 24)
                        (= bits 32))
       )
  )

(define (ao-valid-rate? rate)
  (and (integer? rate)
       (not (eq? (memq rate '(8000 11025 16000 22050 44100
                                   48000 88200 96000 1764000
                                   192000 352800 384000)) #f))))

(define (ao-valid-channels? c)
  (and (integer? c)
       (>= 1 c)))

(define (ao-valid-format? f)
  (or (eq? f 'little-endian)
      (eq? f 'big-endian)
      (eq? f 'native-endian)))

(rc:define/contract (ao-open-live bits rate channels byte-format)
  (rc:-> ao-valid-bits? ao-valid-rate? ao-valid-channels? ao-valid-format? ao-handle?)
  (let ((handle (make-ao-handle device-number)))

    (fin:register-finalizer handle
                            (lambda (handle)
                              (ao-close handle)))

    (set-ao-handle-bits! handle bits)
    (set-ao-handle-bytes-per-sample! handle (bytes-for-bits bits))
    (set-ao-handle-byte-format! handle byte-format)
    (set-ao-handle-channels! handle channels)
    (set-ao-handle-rate! handle rate)

    (info-sound "ao-open-live ~a ~a ~a ~a" bits rate channels byte-format)
    
    (let ((player (ffi:ao_create_async bits rate channels byte-format)))
      (set-ao-handle-async-player! handle player)
      (if (eq? player #f)
          (begin
            (err-sound "ao-open-live - cannote create player")
            (set-ao-handle-closed! handle #t)
            handle)
          (begin
            (info-sound "ao-open-live - created player")
            (set-ao-handle-closed! handle #f)
            handle
            )
          )
      )
    )
  )

(rc:define/contract (ao-close handle)
  (rc:-> ao-handle? void?)
  (void
   (unless (eq? (ao-handle-async-player handle) #f)
     (info-sound "ao-close - closing handle")
     (ffi:ao_stop_async (ao-handle-async-player handle))
     (set-ao-handle-async-player! handle #f)
     )
   )
  )

(define (ao-valid? handle)
  (and (ao-handle? handle)
       (not (eq? (ao-handle-async-player handle) #f)))
  )

(define (any? x)
  #t)

(rc:define/contract (ao-play handle music-id at-time-in-s music-duration-s buffer buf-len buf-type)
  (rc:-> ao-handle? integer? number? number? any? integer? ao-supported-music-format? void?)                    
  (let* ((bytes-per-sample (ao-handle-bytes-per-sample handle))
         (bits (ao-handle-bits handle))
         (rate (ao-handle-rate handle))
         (channels (ao-handle-channels handle))
         (endianess (ao-handle-byte-format handle))
         (buf-info (ffi:make-BufferInfo_t buf-type bits rate channels endianess))
         )
    (unless (ao-valid? handle)
      (err-sound "Cannot play on an invalid ao-device")
      (error "Cannot play on an invalid ao-device"))
    (ffi:ao_play_async (ao-handle-async-player handle)
                       music-id
                       (exact->inexact at-time-in-s)
                       (exact->inexact music-duration-s)
                       buf-len
                       buffer
                       buf-info)
    
    )
  )

(rc:define/contract (ao-pause handle pause)
  (rc:-> ao-handle? boolean? void?)
  (dbg-sound "ao-pause ~a" pause)
  (ffi:ao_pause_async (ao-handle-async-player handle) (if (eq? pause #f) 0 1))
  )

(rc:define/contract (ao-at-second handle)
  (rc:-> ao-handle? number?)
  (ffi:ao_is_at_second_async (ao-handle-async-player handle))
  )

(rc:define/contract (ao-at-music-id handle)
  (rc:-> ao-handle? integer?)
  (ffi:ao_is_at_music_id_async (ao-handle-async-player handle))
  )
  
(rc:define/contract (ao-music-duration handle)
  (rc:-> ao-handle? number?)
  (ffi:ao_music_duration_async (ao-handle-async-player handle))
  )

(rc:define/contract (ao-bufsize-async handle)
  (rc:-> ao-handle? integer?)                    
  (ffi:ao_bufsize_async (ao-handle-async-player handle))
  )

(define (ao-clear-async handle)
  (rc:-> ao-handle? void?)
  (ffi:ao_clear_async (ao-handle-async-player handle))
  )