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-device-bits
         ao-open-file
         ao-play
         ao-close
         ao-at-second
         ao-music-duration
         ao-at-music-id
         ao-bufsize-async
         ao-clear-async
         ao-pause
         ao-set-volume!
         ao-volume
         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]
                          [dev-bits #:auto #:mutable]
                          [dev-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 '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)
       (> rate 0)
       (not (eq? (memq rate '(8000 11025 16000 22050 44100
                                   48000 88200 96000 176400
                                   192000 352800 384000)) #f))))

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

(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?)
  (ao-open-file bits rate channels byte-format #f))

(define (valid-file-kind? f)
  (or (string? f) (path? f) (eq? f #f)))

(rc:define/contract (ao-open-file bits rate channels byte-format filename)
  (rc:-> ao-valid-bits? ao-valid-rate? ao-valid-channels? ao-valid-format? valid-file-kind? ao-handle?)
    (let* ((handle (make-ao-handle device-number))
           (file (if (eq? filename #f)
                     #f
                     (format "~a" filename)))
           )
      (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 ~a" bits rate channels byte-format file)
    
      (let ((player (ffi:ao_create_async bits rate channels byte-format file)))
            (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)
                (let ((out-bits (ffi:ao_real_output_bits_async player)))
                  (info-sound "ao-open-live - created player at ~a bits" out-bits)
                  (set-ao-handle-dev-bits! handle out-bits)
                  (set-ao-handle-dev-bytes-per-sample! handle (/ out-bits 8))
                  (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-device-bits handle)
  (rc:-> ao-handle? integer?)
  (ao-handle-dev-bits handle))

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

(rc:define/contract (ao-set-volume! handle percentage)
  (rc:-> ao-handle? number? void?)
  (ffi:ao_set_volume_async (ao-handle-async-player handle)
                           (if (integer? percentage)
                               (exact->inexact percentage)
                               percentage))
  )

(rc:define/contract (ao-volume handle)
  (rc:-> ao-handle? number?)
  (ffi:ao_volume_async (ao-handle-async-player handle))
  )

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