racket-sound/libao/libao.rkt

#lang racket/base

(require "libao-ffi.rkt"
         ;"libao-async-ffi.rkt"
         "libao-async.rkt"
         (prefix-in fin: finalizer)
         ffi/unsafe
         data/queue
         )

(provide ao-open-live
         ao-play
         ao-mk-format
         ao-close
         ao-default-driver-id
         ao-at-second
         ao-bufsize-async
         ao-clear-async
         )

(define devices (make-hash))
(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
  )

(ao_initialize)

(define libao-plumber-flus-handle
  (plumber-add-flush! (current-plumber)
                      (lambda (my-handle)
                        (hash-for-each devices
                                       (lambda (handle-num device)
                                         (ao-close handle-num)))
                        (set! devices (make-hash))
                        (ao_shutdown)
                        (plumber-flush-handle-remove! my-handle)
                        )))



(define (ao-mk-format bits rate channels byte-format . matrix)
  (let ((bf (if (eq? byte-format 'little-endian)
                AO-FMT-LITTLE
                (if (eq? byte-format 'big-endian)
                    AO-FMT-BIG
                    AO-FMT-NATIVE))))
    (let ((format (make-ao_sample_format bits rate channels bf #f)))
      format)))

(define (ao-endianness->symbol e)
  (if (= e AO-FMT-LITTLE)
      'little-endian
      (if (= e AO-FMT-BIG)
          'big-endian
          'native)))

(define (ao-default-driver-id)
   (ao_default_driver_id))

(define (ao-open-live driver-id sample-format . options)
  (let ((id (if (eq? driver-id #f) (ao-default-driver-id) driver-id)))
    (let ((ao-device (ao_open_live id sample-format #f)))
      (if (eq? ao-device #f)
          (let ((handle (ao-handle -1)))
            handle)
          (let ((handle-num device-number))
            (set! device-number (+ device-number 1))
            (let ((handle (ao-handle handle-num)))
              (let* ((bits (ao_sample_format-bits sample-format))
                     (bytes-per-sample (inexact->exact (round (/ bits 8))))
                     (channels (ao_sample_format-channels sample-format))
                     (endianness (ao-endianness->symbol
                                  (ao_sample_format-byte_format sample-format)))
                     (rate (ao_sample_format-rate sample-format))
                    )
                (set-ao-handle-bits! handle bits)
                (set-ao-handle-bytes-per-sample! handle bytes-per-sample)
                (set-ao-handle-byte-format! handle endianness)
                (set-ao-handle-rate! handle rate)
                (set-ao-handle-channels! handle channels)
                (set-ao-handle-async-player! handle (ao_create_async ao-device)) ; ao_play_ptr))
                (hash-set! devices handle-num ao-device)
                (fin:register-finalizer handle
                                        (lambda (handle)
                                          (ao-close handle)))
                handle))
            ))
      )))
              
(define (ao-close handle)
  (displayln handle)
  (if (number? handle)
      (let ((ao-device (hash-ref devices handle #f)))
        (unless (eq? ao-device #f)
          (let ((r (ao_close ao-device)))
            (when (= r 0)
              (printf "Unexpected: cannot close ao-device"))))
        'internally-closed)
      (let ((handle-num (ao-handle-handle-num handle)))
        (unless (ao-handle-closed handle)
          (set-ao-handle-closed! handle #t)
          (ao_stop_async (ao-handle-async-player handle))
          (let ((ao-device (hash-ref devices handle-num #f)))
            (if (eq? ao-device #f)
                'error-ao-device-non-existent
                (let ((r (ao_close ao-device)))
                  (hash-remove! devices handle-num)
                  (if (= r 0)
                      'error-closing-ao-device
                      'ok))))))))


(define count 0)
(define (abs x) (if (>= x 0) x (* x -1)))

(define (make-sample-bytes sample bytes-per-sample endianess)
  (letrec ((mk (lambda (i d)
                 (if (< i bytes-per-sample)
                     (cons (bitwise-and d 255)
                           (mk (+ i 1) (arithmetic-shift d -8)))
                     '()))))
    (let ((bytes (mk 0 sample)))
      (if (eq? endianess 'big-endian)
          (reverse bytes)
          bytes))))

(define (ao-play handle at-time-in-s buffer)
  (let* ((bytes-per-sample (ao-handle-bytes-per-sample handle))
         (bits (ao-handle-bits handle))
         (channels (ao-handle-channels handle))
         (endianess (ao-handle-byte-format handle))
         (buf-len (vector-length (car buffer)))
         (audio-buf-len (* channels bytes-per-sample buf-len))
         (audio (malloc 'atomic audio-buf-len))
         (get-sample (lambda (k channel)
                       (let ((chan-buf (list-ref buffer channel)))
                         (vector-ref chan-buf k))))
         )
    ;(displayln (format "bps: ~a, buf-len: ~a, endianess: ~a, channels: ~a, bits ~a"
    ;                   bytes-per-sample buf-len endianess channels bits))
    (letrec ((i 0)
             (fill (lambda (k channel)
                     (if (< k buf-len)
                         (if (< channel channels)
                             (let* ((sample (get-sample k channel))
                                    (bytes (make-sample-bytes sample bytes-per-sample endianess))
                                    )
                               (for-each (lambda (byte)
                                           (ptr-set! audio _byte i byte)
                                           (set! i (+ i 1)))
                                         bytes)
                               ;; process sample
                               (fill k (+ channel 1)))
                             (fill (+ k 1) 0))
                         'filled))
                   ))
      (fill 0 0)
      (ao_play_async (ao-handle-async-player handle) (exact->inexact at-time-in-s)
                     audio-buf-len
                     audio)
      )
      ;(let* ((handle-num (ao-handle-handle-num handle))
      ;       (ao-device (hash-ref devices handle-num #f)))
      ;  (if (eq? ao-device #f)
      ;      (error "No device for this handle")
      ;      (ao_play ao-device audio audio-buf-len)))      )
    )
  )

(define (ao-at-second handle)
  (ao_is_at_second_async (ao-handle-async-player handle)))

(define (ao-bufsize-async handle)
  (ao_bufsize_async (ao-handle-async-player handle)))

(define (ao-clear-async handle)
  (ao_clear_async (ao-handle-async-player handle)))

;(let* ((handle-num (ao-handle-handle-num handle))
;             (ao-device (hash-ref devices handle-num #f)))
;        (if (eq? ao-device #f)
;            (error "No device for this handle")
;            (ao_play ao-device audio audio-buf-len))))))