#lang racket/base

;; Pure Racket replacement for ao_playasync.c as used by libao.rkt.
;;
;; This module exports the same Racket API as libao-async-ffi.rkt, but it
;; calls Xiph libao directly and uses a Racket worker thread instead of the
;; C queue/thread backend.

(define AO-ASYNC-VERSION 3)

(require ffi/unsafe
         ffi/unsafe/define
         ffi/unsafe/custodian
         racket/async-channel
         data/queue
         racket/list
         "private/utils.rkt"
         racket/place)

(provide ao_version_async
         ao_create_async
         ao_real_output_bits_async
         ao_stop_async
         ao_play_async
         ao_is_at_music_id_async
         ao_is_at_second_async
         ao_music_duration_async
         ao_bufsize_async
         ao_clear_async
         ao_pause_async
         ao_set_volume_async
         ao_volume_async
         ao_reuse_buf_len
         ao_sample_queue_len
         make-buffer-info
         make-BufferInfo_t
         ao-playback-buf-ms
         ao-set-playback-buf-ms!
         )

;; -------------------------------------------------------------------------
;; Public structs and enums: keep these equal to the old FFI module.

(define _Endian_t
  (_enum '(little-endian = 1
           big-endian    = 2
           native-endian = 4)))

(define-struct buffer-info
  (type                           ; 'interleaved (old: 'ao) or 'planar (old: 'flac)
   sample-bits
   sample-rate
   channels
   endianness
   )
  #:mutable
  #:transparent
  )

(define make-BufferInfo_t make-buffer-info)

;; -------------------------------------------------------------------------
;; Direct libao FFI.

(define libao
  (get-lib (list (case (system-type 'os)
             [(windows) "libao-1.2.2"]
             [else      "libao"])) '(#f)))

(define-ffi-definer define-ao libao)

(define _ao-device (_cpointer/null 'ao-device))
(define _ao-option (_cpointer/null 'ao-option))

(define-cstruct _ao_sample_format
  ([bits        _int]
   [rate        _int]
   [channels    _int]
   [byte_format _Endian_t]
   [matrix      _string*/utf-8]))

(define-ao ao_initialize         (_fun -> _void))
(define-ao ao_shutdown           (_fun -> _void))
(define-ao ao_default_driver_id  (_fun -> _int))
(define-ao ao_driver_id          (_fun _string/utf-8 -> _int))
(define-ao ao_open_live          (_fun _int _ao_sample_format-pointer _ao-option -> _ao-device))
(define-ao ao_open_file          (_fun _int _string/utf-8 _int _ao_sample_format-pointer _ao-option -> _ao-device))
(define-ao ao_close              (_fun _ao-device -> _int))

;; ao_play can block until the device accepts more data. Mark it as blocking
;; so other Racket places/threads are not needlessly held up by the foreign
;; call. This is the important part that makes the C backend much less useful.
(define-ao ao_play
  (_fun #:blocking? #t _ao-device _pointer _uint32 -> _int))
  ;(_fun _ao-device _pointer _uint32 -> _int))
  ;(_fun #:blocking? #t _ao-device _bytes _uint32 -> _int))

;; -------------------------------------------------------------------------
;; Mutex stuff
;; -------------------------------------------------------------------------

(define (make-mutex)
  (let ((sem (make-semaphore)))
    (semaphore-post sem)
    sem))

(define (mutex-lock sem)
  (semaphore-wait sem))

(define (mutex-unlock sem)
  (semaphore-post sem))

;; -------------------------------------------------------------------------
;; Async handle etc.
;; -------------------------------------------------------------------------

(define (command? x)
  (or (eq? x 'play) (eq? x 'stop)))

(define-struct queue-elem
  (command
   buf
   buflen
   at-second
   music-duration
   music-id
   )
  #:mutable
  )


(define-struct ao-handle
  (queue
   in-queue
   buf-size 

   paused

   ao-device
   requested-bits-per-sample
   dev-bits-per-sample
   dev-endianness
   dev-channels
   dev-rate

   mutex
   pause-mutex
   clear-mutex
   
   play-thread

   at-second
   music-duration
   music-id
   volume-in-10000

   valid

   bufs
   current-elem
   bytes-left
   )
  #:mutable
  )

;; -------------------------------------------------------------------------
;; Internal memory structure, to be able to reuse allocated memory bytes
;; And prevent the GC from collecting this memory that is constantly reused
;; -------------------------------------------------------------------------

(define-struct mem
  (size bytes allocated) #:mutable)

(define (to-mem m)
  (if (mem? m)
      m
      (if (bytes? m)
          (make-mem (bytes-length m) m #f)
          (error
           (format
            "Cannot convert m of other type than bytes? or mem?, got ~a" m)))))

(define (m-memcpy dst from size . args)
  (let ((offset (if (null? args) 0 from))
        (from* (if (null? args) from size))
        (size* (if (null? args) size (car args)))
        )
    (let ((dst** (if (cpointer? dst) dst (mem-bytes (to-mem dst))))
          (from** (if (cpointer? from*) from* (mem-bytes (to-mem from*))))
          )
      (memcpy dst** offset from** size*)
      )
    )
  )

;; -------------------------------------------------------------------------
;; Playback buffer to send to libao in milliseconds
;; -------------------------------------------------------------------------

(define ao-buf-ms 150)  ;; Playback buffer of 0.15s

(define (ao-playback-buf-ms)
  ao-buf-ms)

(define (ao-set-playback-buf-ms! ms)
  (set! ao-buf-ms ms))

;; -------------------------------------------------------------------------
;; Sample queue handling
;; -------------------------------------------------------------------------

(define (get h ms-wait)
  (let ((el (if (<= ms-wait 0)
                (sync/timeout 0 (ao-handle-queue h))
                (sync/timeout (/ ms-wait 1000.0) (ao-handle-queue h) ))))
    (if (eq? el #f)
        (begin
          (set-ao-handle-buf-size! h 0) ; no elements in queue => empty => no buffer with music samples
          (set-ao-handle-in-queue! h 0))
        (begin
          (set-ao-handle-buf-size! h (- (ao-handle-buf-size h) (queue-elem-buflen el)))
          (set-ao-handle-in-queue! h (- (ao-handle-in-queue h) 1))
          ))
    el)
  )


(define (needed-bytes h elem-buflen)
  (let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8))
        (rate-s (ao-handle-dev-rate h))
        (channels (ao-handle-dev-channels h))
        )
    (let ((needed-for-ao (/ (* req-bytes rate-s channels ao-buf-ms) 1000)))
      (max needed-for-ao elem-buflen))
    )
  )

(define (bytes->samples h s)
  (let ((req-bytes (/ (ao-handle-dev-bits-per-sample h) 8))
        (rate-s (ao-handle-dev-rate h))
        (channels (ao-handle-dev-channels h)))
    (/ s req-bytes channels)))


(define (add h elem)
  (if (eq? (queue-elem-command elem) 'stop)
      (begin
        (unless (eq? (ao-handle-current-elem h) #f)
          (async-channel-put (ao-handle-queue h) (ao-handle-current-elem h))
          (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
          (set-ao-handle-current-elem! h #f))
        (async-channel-put (ao-handle-queue h) elem)
        (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
        )
      (let* ((cb (ao-handle-current-elem h)))
        (if (eq? cb #f)
            (begin
              (set-ao-handle-current-elem! h elem)
              (set! cb elem)
              (let* ((ns (needed-bytes h (queue-elem-buflen elem)))
                     (new-buf (alloc-buf h ns)))
                (m-memcpy new-buf (queue-elem-buf cb) (queue-elem-buflen cb))
                (reuse-buf h (queue-elem-buf cb))
                (set-queue-elem-buf! cb new-buf)
                (set-ao-handle-bytes-left! h (- ns (queue-elem-buflen cb)))
                (set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem)))
              ))
            (if (or
                 (not (equal? (queue-elem-music-id cb) (queue-elem-music-id elem)))
                 (< (- (ao-handle-bytes-left h) (queue-elem-buflen elem)) 0))
                (begin
                  ; push this buffer and restart
                  (async-channel-put (ao-handle-queue h) cb)
                  (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
                  (set-ao-handle-current-elem! h #f)
                  (add h elem))
                (let ((offset (queue-elem-buflen cb)))
                  (m-memcpy (queue-elem-buf cb) offset (queue-elem-buf elem) (queue-elem-buflen elem))
                  (set-queue-elem-buflen! cb (+ offset (queue-elem-buflen elem)))
                  (set-ao-handle-bytes-left! h (- (ao-handle-bytes-left h) (queue-elem-buflen elem)))
                  (set-ao-handle-buf-size! h (+ (ao-handle-buf-size h) (queue-elem-buflen elem)))
                  (reuse-buf h (queue-elem-buf elem))
                  (when (= (ao-handle-bytes-left h) 0)
                    (async-channel-put (ao-handle-queue h) cb)
                    (set-ao-handle-in-queue! h (+ (ao-handle-in-queue h) 1))
                    (set-ao-handle-current-elem! h #f))
                  )
                )
            )
        )
      )
  )

(define (new-elem h command music-id at-second music-duration buflen buf)
  (make-queue-elem command buf buflen at-second music-duration music-id))

(define (del-elem h elem)
  (reuse-buf h (queue-elem-buf elem))
  #t)

(define (clear h)
  (let ((count 0))
    (mutex-lock (ao-handle-clear-mutex h))
    (let ((el (get h 0)))
      
      ; Clear the elements in the queue
      (while (not (eq? el #f))
             (del-elem h el)    
             (set! count (+ count 1))
             (set! el (get h 0)))
      
      ; Clear the current element in processing
      (unless (eq? (ao-handle-current-elem h) #f)
        (let* ((ce (ao-handle-current-elem h))
               (cb (queue-elem-buf ce)))
          (unless (eq? cb #f)
            (reuse-buf h cb))))
      (set-ao-handle-current-elem! h #f)
      (set-ao-handle-bytes-left! h 0)
      (set-ao-handle-buf-size! h 0)
      
      (mutex-unlock (ao-handle-clear-mutex h))
      (dbg-sound "~a elements cleared" count)
      )
    )
  )

(define-syntax system-little-endian?
  (syntax-rules ()
    ((_) (not (system-big-endian?)))))

(define (is-little-endian? e)
  (cond [(eq? e 'little-endian) #t]
        [(eq? e 'big-endian) #f]
        [(eq? e 'native-endian) (system-little-endian?)]
        [else (error 'convert-bits "unknown endian value: ~a" e)]))

(define (is-big-endian? e)
  (not (is-little-endian? e)))


(define (endian-eq? a b)
  (let ((le-a (is-little-endian? a))
        (le-b (is-little-endian? b)))
    (eq? le-a le-b)))



(define (alloc-buf h size)
  (let ((entry #f))
    (letrec ((f (λ (entries min-size min-size-idx idx)
                  (if (null? entries)
                      min-size-idx
                      (let ((e (car entries)))
                        (if (<= size (mem-size e))
                            (if (or (eq? min-size #f) (< (mem-size e) min-size))
                                (f (cdr entries) (mem-size e) idx (+ idx 1))
                                (f (cdr entries) min-size min-size-idx (+ idx 1))
                                )
                            (f (cdr entries) min-size min-size-idx (+ idx 1))
                            )
                        )
                      )
                  )
                ))
      (let ((bufs (ao-handle-bufs h))
            (entry #f))
        (unless (null? bufs)
          (let ((idx (f bufs #f #f 0)))
            (unless (eq? idx #f)
              (let ((e (list-ref bufs idx)))
                (set! entry (list-ref bufs idx))
                (set-ao-handle-bufs! h (append (take bufs idx) (drop bufs (+ idx 1))))
                )
              )
            )
          )
        (if (eq? entry #f)
            (make-mem size (make-bytes size) #t)
            entry)
        )
      )
    )
  )

(define (reuse-buf h buf)
  (when (and (mem? buf) (mem-allocated buf))
    (set-ao-handle-bufs! h (cons buf (ao-handle-bufs h)))
    )
  #t
  )
         
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; Converters
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

;;; Volume

(define (adjust-volume h bs volume-in-10000)
  ;; bs: mem
  ;; buf-size: aantal geldige bytes in bs

  (let* ([bs-bytes         (mem-bytes bs)]
         [buf-size         (mem-size bs)]
         [bits             (ao-handle-dev-bits-per-sample h)]
         [bytes-per-sample (arithmetic-shift bits -3)]
         [big?             (is-big-endian? (ao-handle-dev-endianness h))]
         [min-sample       (- (arithmetic-shift 1 (- bits 1)))]
         [max-sample       (- (arithmetic-shift 1 (- bits 1)) 1)]
         [clip             (λ (scaled)
                             (cond
                               [(< scaled min-sample) min-sample]
                               [(> scaled max-sample) max-sample]
                               [else scaled]))]
         )

    (unless (= volume-in-10000 10000)
      (for ([i (in-range 0 buf-size bytes-per-sample)])
        (let* ([sample (int-bytes->integer bs-bytes #t big?
                                           i
                                           (+ i bytes-per-sample))]
               [scaled (clip (quotient (* sample volume-in-10000) 10000))])
          (integer->int-bytes scaled
                              bytes-per-sample
                              #t
                              big?
                              bs-bytes
                              i))))

    #t))

;;; planar -> intereleaved


(define (planar-to-interleaved h in-buf info)
  ;; in-buf: mem
  ;; result: mem

  (let* ([in-bytes   (mem-bytes in-buf)]
         [buf-size   (mem-size in-buf)]
         [type       (buffer-info-type info)]
         [bits       (buffer-info-sample-bits info)]
         [channels   (buffer-info-channels info)]
         [bytes      (arithmetic-shift bits -3)]
         [out-size   buf-size]
         [out        (alloc-buf h out-size)]
         [out-bytes  (mem-bytes out)]
         )

    (unless (or (eq? type 'planar) (eq? type 'flac))
      (error (format "expected planar buffer, got: ~a" type)))

    (unless (zero? (remainder buf-size (* channels bytes)))
      (error (format "buffer size ~a is not aligned to ~a channels of ~a-bit samples"
                     buf-size channels bits)))

    (let* ([samples-total       (quotient buf-size bytes)]
           [samples-per-channel (quotient samples-total channels)]
           [plane-size          (* samples-per-channel bytes)])

      (for ([sample-index (in-range samples-per-channel)])
        (for ([channel (in-range channels)])
          (let* ([in-pos  (+ (* channel plane-size)
                             (* sample-index bytes))]
                 [out-pos (* (+ (* sample-index channels) channel)
                             bytes)])
            (bytes-copy! out-bytes out-pos in-bytes in-pos (+ in-pos bytes)))))

      out)))

;;; requested bits to device bits


(define (convert-bits h buf in-bits in-endianness out-bits out-endianness)
  ;; buf: bytes
  ;; returns: (list out-bytes out-size)

  (let* ([in-bytes  (arithmetic-shift in-bits -3)]
         [out-bytes (arithmetic-shift out-bits -3)]
         [in-buf    (mem-bytes buf)]
         [buf-size  (mem-size buf)]
         [samples   (quotient buf-size in-bytes)]
         [out-size  (* samples out-bytes)]
         [out       (alloc-buf h out-size)]
         [out-buf   (mem-bytes out)]
         [shift     (- out-bits in-bits)]
         [in-big?   (is-big-endian? in-endianness)]
         [out-big?  (is-big-endian? out-endianness)])

    (for ([n (in-range samples)])
      (let* ([in-pos    (* n in-bytes)]
             [out-pos   (* n out-bytes)]
             [sample    (int-bytes->integer in-buf #t in-big? in-pos (+ in-pos in-bytes))]
             [converted (arithmetic-shift sample shift)])
        (integer->int-bytes converted out-bytes #t out-big? out-buf out-pos)))

    (list out #t)))

(define (convert-req-bits-to-dev-bits h mem info)
  (if (and (= (buffer-info-sample-bits info) (ao-handle-dev-bits-per-sample h))
               (endian-eq? (buffer-info-endianness info) (ao-handle-dev-endianness h)))
      (list mem #f)
      (convert-bits h mem 
                    (buffer-info-sample-bits info)
                    (buffer-info-endianness info)
                    (ao-handle-dev-bits-per-sample h)
                    (ao-handle-dev-endianness h)
                    )
      )
  )

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; ASync player
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;


(define (run h)
  (thread
   (λ ()
     (let ((go-on #t)
           (buf #f)
           (buf-size 0))
       (while go-on
          (mutex-lock (ao-handle-pause-mutex h))
          (mutex-unlock (ao-handle-pause-mutex h))
          (mutex-lock (ao-handle-clear-mutex h))
          (let ((elem (get h 150)))
            (mutex-unlock (ao-handle-clear-mutex h))
            (if (eq? elem #f)
                (begin
                  ;(dbg-sound "nothing in the queue")
                  (sleep 0.05))
                (begin
                  (if (eq? (queue-elem-command elem) 'stop)
                      (set! go-on #f)
                      (begin
                        (set-ao-handle-at-second! h (queue-elem-at-second elem))
                        (set-ao-handle-music-duration! h (queue-elem-music-duration elem))
                        (set-ao-handle-music-id! h (queue-elem-music-id elem))
                    
                        (unless (= (ao-handle-volume-in-10000 h) 10000)
                          (adjust-volume h (queue-elem-buf elem) 
                                         (ao-handle-volume-in-10000 h)))

                        (let* ((size (queue-elem-buflen elem))
                               (el-buf (to-mem (queue-elem-buf elem))))
                          (when (> size buf-size)
                            (set! buf (malloc size 'atomic-interior ))
                            (set! buf-size size))
                          (m-memcpy buf (mem-bytes el-buf) size)
                          (ao_play (ao-handle-ao-device h) buf size)
                          )
                        )
                      )

                  (del-elem h elem)
                  )
                )
            )
          )
       )
     )
   #:pool 'own
   )
  )

(define handle-admin-mutex (make-mutex))
(define num-of-handles 0)

(register-finalizer-and-custodian-shutdown
   num-of-handles
   (λ (v)
     (unless (= num-of-handles 0)
       (ao_shutdown)))
   #:at-exit? #t
   )

(define (dec-ao-handles)
  (mutex-lock handle-admin-mutex)
  (set! num-of-handles (- num-of-handles 1))
  (when (= num-of-handles 0)
    (ao_shutdown)
    (dbg-sound "ao_shutdown executed")
    )
  (mutex-unlock handle-admin-mutex)
  )

(define (inc-ao-handles)
  (mutex-lock handle-admin-mutex)
  (when (= num-of-handles 0)
    (ao_initialize)
    (dbg-sound "ao_initialized executed")
    )
  (set! num-of-handles (+ num-of-handles 1))
  (mutex-unlock handle-admin-mutex)
  )
  
(define (ao_close* ao_ffi_handle)
  (ao_close ao_ffi_handle)
  (dec-ao-handles))

(define (ao_open_live* driver-id fmt matrix)
  (inc-ao-handles)
  (let ((r (ao_open_live driver-id fmt matrix)))
    (when (eq? r #f)
      (dec-ao-handles))
    r))

(define (ao_open_file* driver-id file x fmt matrix)
  (inc-ao-handles)
  (let ((r (ao_open_file driver-id file x fmt matrix)))
    (when (eq? r #f)
      (dec-ao-handles))
    r))

(define (ao_default_driver_id*)
  (inc-ao-handles)
  (let ((r (ao_default_driver_id)))
    (dec-ao-handles)
    r))

(define (try-open-device bits rate channels byte-format wav-output-file)
  (let ((candidates (make-vector 3 bits))
        (n 1)
        (result #f))

    (when (> bits 24)
      (vector-set! candidates n 24)
      (set! n (+ n 1)))

    (when (> bits 16)
      (vector-set! candidates n 16)
      (set! n (+ n 1)))

    (let ((i 0))
      (while (< i n)
         (let* ((fmt (make-ao_sample_format (vector-ref candidates i)
                                            rate
                                            channels
                                            byte-format
                                            #f))
                (driver-id (if (eq? wav-output-file #f)
                               (ao_default_driver_id*)
                               (ao_driver_id "wav")))
                (dev (if (eq? wav-output-file #f)
                         (ao_open_live* driver-id fmt #f)
                         (ao_open_file* driver-id wav-output-file 1 fmt #f)))
                )

           (unless (eq? dev #f)
             (set! result (list dev (vector-ref candidates i)))
             (set! i n)
             )
           )
         (set! i (+ i 1))
         )
      )

    (if (eq? result #f)
        (list #f 0)
        result)
    )
  )
    

;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
;; API
;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;

(define (ao_version_async)
  AO-ASYNC-VERSION)

(define (ao_create_async bits rate channels byte-format wav-output-file)
  (let ((handle (make-ao-handle
                 (make-async-channel)    ; queue
                 0                       ; in-queue
                 0                       ; total buf size

                 #f                      ; paused

                 #f                      ; ao-device
                 bits                    ; requested-bits-per-sample
                 0                       ; device bits per sample
                 'little-endian          ; dev-endianness
                 channels                ; dev-channels
                 rate                    ; dev-rate

                 (make-mutex)            ; mutex
                 (make-mutex)            ; pause-mutex
                 (make-mutex)            ; clear-mutex
                 
                 #f                      ; play-thread

                 0.0                     ; at-second
                 0.0                     ; music-duration
                 0                       ; music-id
                 
                 10000                   ; volume-in-10000

                 #t                      ; valid handle
                 '()                     ; reuse buffer

                 #f                      ; current element
                 0                       ; bytes left
                 )))

    (let ((ao-dev-bits (try-open-device bits rate channels byte-format wav-output-file)))
      (set-ao-handle-ao-device! handle (car ao-dev-bits))
      (set-ao-handle-dev-bits-per-sample! handle (cadr ao-dev-bits))

      (if (eq? (car ao-dev-bits) #f)
          (begin
            (err-sound "Cannot open ao-device")
            #f)
          (begin
            (set-ao-handle-play-thread! handle (run handle))
            (register-finalizer handle (λ (v)
                                         (when (ao-handle-valid v)
                                           ao_stop_async v)))
            handle)
          )
      )
    )
  )

(define (ao_stop_async h)
  (unless (ao-handle-valid h)
    (error "Not a valid ao handle"))
  
  (dbg-sound "Stopping ao-async, calling clear")
  (clear h)
  (dbg-sound "Queue cleared")

  (when (ao-handle-paused h)
    (mutex-unlock (ao-handle-pause-mutex h)))

  (let ((elem (new-elem h 'stop 0 0.0 0.0 0 #f)))
    (add h elem))

  (dbg-sound "Stop command queued")

  (thread-wait (ao-handle-play-thread h))
  (dbg-sound "Play thread stopped")

  (ao_close* (ao-handle-ao-device h))
  (dbg-sound "AO Device closed")

  (set-ao-handle-valid! h #f)
  h
  )

(define (ao_play_async h music-id at-second music-duration buf-size au-buf info)
  (let ((type (buffer-info-type info)))

    (unless (or (bytes? au-buf) (mem? au-buf))
      (error "ao_play_async: paramater au-buf must be of type bytes or mem?"))

    (set! au-buf (to-mem au-buf))
    (set-mem-size! au-buf buf-size)

    (when (or (eq? type 'planar) (eq? type 'flac))
      (let ((m (planar-to-interleaved h au-buf info)))
        (reuse-buf h au-buf)  
        (set! au-buf m)
        (set! buf-size (mem-size m)))
      )

    (let ((ao-size buf-size)
          (ao-mem au-buf))
      (let ((m (convert-req-bits-to-dev-bits h au-buf info)))
        (when (eq? (cadr m) #t)
          (reuse-buf h au-buf)
          (set! ao-mem (car m))
          (set! ao-size (mem-size ao-mem))))

      (let ((elem (new-elem h 'play music-id at-second music-duration ao-size ao-mem)))
        (add h elem))
      )
    )
  )

(define (ao_clear_async h)
  (clear h))

(define (ao_is_at_second_async h)
  (ao-handle-at-second h))

(define (ao_is_at_music_id_async h)
  (ao-handle-music-id h))

(define (ao_music_duration_async h)
  (ao-handle-music-duration h))

(define (ao_bufsize_async h)
  (ao-handle-buf-size h))

(define (ao_set_volume_async h percentage)
  (let ((volume-10000 (inexact->exact (round (* percentage 100.0)))))
    (when (and (> volume-10000 9990) (< volume-10000 10010))
      (set! volume-10000 10000))
    (set-ao-handle-volume-in-10000! h volume-10000)
    )
  )

(define (ao_volume_async h)
  (let ((volume-10000 (ao-handle-volume-in-10000 h)))
    (/ volume-10000 100.0)
    )
  )

(define (ao_pause_async h paused)
  (when (integer? paused)
    (set! paused (not (= paused 0))))
  (dbg-sound "ao_pause_async ~a" paused)
  (if (ao-handle-paused h)
      (when (eq? paused #f)
        (mutex-unlock (ao-handle-pause-mutex h))
        (set-ao-handle-paused! h #f)
        )
      (when (eq? paused #t)
        (sync-log-sound)
        (mutex-lock (ao-handle-pause-mutex h))
        (set-ao-handle-paused! h #t)
        (dbg-sound "paused")
        )
      )
  )

(define (ao_real_output_bits_async h)
  (ao-handle-dev-bits-per-sample h))

(define (ao_reuse_buf_len h)
  (length (ao-handle-bufs h)))

(define (ao_sample_queue_len h)
  (ao-handle-in-queue h))