reverted to the C-backend, because the racket version of libao-async just keeps stuttering on linux

flac-decoder.rkt

@@ -96,7 +96,7 @@
       (for ([channel (in-range channels)])
         (let* ([chan   (ptr-ref buffer _pointer channel)]
                [sample (ptr-ref chan _int32 k)])
-          (integer->integer-bytes sample bytes #t big? bs out-pos)
+          (integer->int-bytes sample bytes #t big? bs out-pos)
           (set! out-pos (+ out-pos bytes)))))
 
     ;(memcpy out bs buf-size)

libao-async-ffi-racket.rkt

@@ -59,11 +59,11 @@
 (define libao
   (get-lib (list (case (system-type 'os)
              [(windows) "libao-1.2.2"]
-             [else      "ao"])) '(#f)))
+             [else      "libao"])) '(#f)))
 
 (define-ffi-definer define-ao libao)
 
-(define _ao-device (_cpointer 'ao-device))
+(define _ao-device (_cpointer/null 'ao-device))
 (define _ao-option (_cpointer/null 'ao-option))
 
 (define-cstruct _ao_sample_format
@@ -87,7 +87,7 @@
 (define-ao ao_play
   ;(_fun #:blocking? #t _ao-device _pointer _uint32 -> _int))
   ;(_fun _ao-device _pointer _uint32 -> _int))
-  (_fun _ao-device _bytes _uint32 -> _int))
+  (_fun #:blocking? #t _ao-device _bytes _uint32 -> _int))
 
 ;; -------------------------------------------------------------------------
 ;; Mutex stuff
@@ -209,114 +209,8 @@
 
 ;;; Volume
 
-#|
-(define (adjust-volume h buf buf-size volume-in-10000)
-  (let* ((bytes-per-sample (ao-handle-dev-bits-per-sample h))
-         (endianness (ao-handle-dev-endianness h))
-         (i 0)
-         (sample 0)
-         (sample32 #f)
-         (k 0)
-         (little-endian (if (eq? endianness 'little-endian)
-                            #t
-                            (if (eq? endianness 'native-endian)
-                                (system-little-endian?)
-                                #f)))
-         )
-    (while (< i buf-size)
-       (if little-endian
-           (begin
-             (set! sample (if (> (ptr-ref buf _uint8 (- i 1)) 127)
-                              -1
-                              0))
-             (set! k (- (+ bytes-per-sample i) 1))
-             (while (>= k i)
-                    (set! sample (bitwise-ior (arithmetic-shift sample 8)
-                                              (ptr-ref buf _uint8 k)))
-                    (set! k (- k 1)))
-             )
-           (begin
-             (set! sample (if (> (ptr-ref buf _uint8 i) 127)
-                              -1
-                              0))
-             (set! k i)
-             (while (< k (+ i bytes-per-sample))
-                    (set! sample (bitwise-ior (arithmetic-shift sample 8)
-                                              (ptr-ref buf _uint8 k)))
-                    (set! k (+ k 1)))
-             ))
-       (set! sample (round (inexact->exact (/ (* sample volume-in-10000) 10000))))
-       (set! sample32 (integer->integer-bytes sample 4 #f (not little-endian)))
-       (set! k 0)
-       (while (< k bytes-per-sample)
-          (ptr-set! buf _uint8 (+ i k) (bytes-ref sample32 k))
-          (set! k (+ k 1)))
-       
-       (set! i (+ i bytes-per-sample))
-       )
-    )
-  )
-|#
 
 
-#|
-(define (adjust-volume h buf buf-size volume-in-10000)
-  (let* ((bits (ao-handle-dev-bits-per-sample h))
-         (bytes-per-sample (arithmetic-shift bits -3))
-         (endianness (ao-handle-dev-endianness h))
-         (little-endian? (if (eq? endianness 'little-endian)
-                            #t
-                            (if (eq? endianness 'native-endian)
-                                (system-little-endian?)
-                                #f)))
-         (sample 0)
-         )
-
-  (for ([i (in-range 0 buf-size bytes-per-sample)])
-
-    ;; read signed sample
-    (set! sample
-      (if little-endian?
-          (let ([last (+ i bytes-per-sample -1)])
-            (let loop ([k last]
-                       [s (if (> (ptr-ref buf _uint8 last) 127) -1 0)])
-              (if (< k i)
-                  s
-                  (loop (sub1 k)
-                        (bitwise-ior
-                         (arithmetic-shift s 8)
-                         (ptr-ref buf _uint8 k))))))
-          (let ([first i])
-            (let loop ([k first]
-                       [s (if (> (ptr-ref buf _uint8 first) 127) -1 0)])
-              (if (= k (+ i bytes-per-sample))
-                  s
-                  (loop (add1 k)
-                        (bitwise-ior
-                         (arithmetic-shift s 8)
-                         (ptr-ref buf _uint8 k))))))))
-
-    ;; scale
-    (set! sample (quotient (* sample volume-in-10000) 10000))
-
-    ;; write signed sample back
-    (if little-endian?
-        (let loop ([k i]
-                   [s sample])
-          (unless (= k (+ i bytes-per-sample))
-            (ptr-set! buf _uint8 k (bitwise-and s #xff))
-            (loop (add1 k) (arithmetic-shift s -8))))
-        (let loop ([k (+ i bytes-per-sample -1)]
-                   [s sample])
-          (unless (< k i)
-            (ptr-set! buf _uint8 k (bitwise-and s #xff))
-            (loop (sub1 k) (arithmetic-shift s -8))))))
-
-    )
-  #t
-  )
-|#
-
 (define (adjust-volume h bs buf-size volume-in-10000)
   ;; bs: bytes
   ;; buf-size: aantal geldige bytes in bs
@@ -327,64 +221,21 @@
 
     (unless (= volume-in-10000 10000)
       (for ([i (in-range 0 buf-size bytes-per-sample)])
-        (let* ([sample (integer-bytes->integer bs #t big?
+        (let* ([sample (int-bytes->integer bs #t big?
-                                                i
+                                           i
-                                                (+ i bytes-per-sample))]
+                                           (+ i bytes-per-sample))]
                [scaled (quotient (* sample volume-in-10000) 10000)])
-          (integer->integer-bytes scaled
+          (integer->int-bytes scaled
-                                  bytes-per-sample
+                              bytes-per-sample
-                                  #t
+                              #t
-                                  big?
+                              big?
-                                  bs
+                              bs
-                                  i))))
+                              i))))
 
     #t))
 
 ;;; planar -> intereleaved
 
-#|
-(define (planar-to-interleaved mem buf-size info)
-  (let* ([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]
-         [mem-out    (malloc out-size 'atomic)])
-
-    (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)])
-
-      (dbg-sound "~a ~a ~a ~a ~a" bits bytes buf-size samples-total samples-per-channel)
-
-      ;; Input:
-      ;;   C0[0] C0[1] ... C0[n]
-      ;;   C1[0] C1[1] ... C1[n]
-      ;;
-      ;; Output:
-      ;;   C0[0] C1[0] ... Ck[0]
-      ;;   C0[1] C1[1] ... Ck[1]
-      ;;
-      (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)])
-            (for ([b (in-range bytes)])
-              (ptr-set! mem-out _uint8 (+ out-pos b)
-                        (ptr-ref mem _uint8 (+ in-pos b)))))))
-
-      (list mem-out out-size))))
-|#
 
 (define (planar-to-interleaved mem buf-size info)
   ;; mem: bytes
@@ -420,54 +271,6 @@
 
 ;;; requested bits to device bits
 
-#|
-(define (convert-bits buf buf-size in-bits in-endianness out-bits out-endianness)
-  (let* ([in-bytes    (arithmetic-shift in-bits -3)]
-         [out-bytes   (arithmetic-shift out-bits -3)]
-         [samples     (quotient buf-size in-bytes)]
-         [out-size    (* samples out-bytes)]
-         [out-buf     (malloc out-size 'atomic)]
-         [shift       (- out-bits in-bits)]
-         [in-little?  (is-little-endian? in-endianness)]
-         [out-little? (is-little-endian? out-endianness)])
-
-    (for ([n (in-range samples)])
-      (let* ([in-pos  (* n in-bytes)]
-             [out-pos (* n out-bytes)]
-             [sample
-              (if in-little?
-                  (let* ([last (+ in-pos in-bytes -1)]
-                         [sign (if (> (ptr-ref buf _uint8 last) 127) -1 0)])
-                    (let loop ([k last] [s sign])
-                      (if (< k in-pos)
-                          s
-                          (loop (sub1 k)
-                                (bitwise-ior
-                                 (arithmetic-shift s 8)
-                                 (ptr-ref buf _uint8 k))))))
-                  (let* ([first in-pos]
-                         [sign (if (> (ptr-ref buf _uint8 first) 127) -1 0)])
-                    (let loop ([k first] [s sign])
-                      (if (= k (+ in-pos in-bytes))
-                          s
-                          (loop (add1 k)
-                                (bitwise-ior
-                                 (arithmetic-shift s 8)
-                                 (ptr-ref buf _uint8 k)))))))]
-             [converted (arithmetic-shift sample shift)])
-
-        (if out-little?
-            (let loop ([k out-pos] [s converted])
-              (unless (= k (+ out-pos out-bytes))
-                (ptr-set! out-buf _uint8 k (bitwise-and s #xff))
-                (loop (add1 k) (arithmetic-shift s -8))))
-            (let loop ([k (+ out-pos out-bytes -1)] [s converted])
-              (unless (< k out-pos)
-                (ptr-set! out-buf _uint8 k (bitwise-and s #xff))
-                (loop (sub1 k) (arithmetic-shift s -8)))))))
-
-    (list out-buf out-size)))
-|#
 
 (define (convert-bits buf buf-size in-bits in-endianness out-bits out-endianness)
   ;; buf: bytes
@@ -485,41 +288,22 @@
     (for ([n (in-range samples)])
       (let* ([in-pos    (* n in-bytes)]
              [out-pos   (* n out-bytes)]
-             [sample    (integer-bytes->integer
+             [sample    (int-bytes->integer buf #t in-big? in-pos (+ in-pos in-bytes))]
-                         buf #t in-big?
-                         in-pos
-                         (+ in-pos in-bytes))]
              [converted (arithmetic-shift sample shift)])
-        (integer->integer-bytes converted
+        (integer->int-bytes converted out-bytes #t out-big? out out-pos)))
-                                out-bytes
+    
-                                #t
-                                out-big?
-                                out
-                                out-pos)))
-
     (list out out-size)))
 
-
-
 (define (convert-req-bits-to-dev-bits h mem buf-size 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 buf-size)
-      (begin
+      (convert-bits mem buf-size
-        (dbg-sound "Converting info bits to dev bits: ~a ~a ~a ~a"
+                    (buffer-info-sample-bits info)
-                   (buffer-info-sample-bits info)
+                    (buffer-info-endianness info)
-                   (ao-handle-dev-bits-per-sample h)
+                    (ao-handle-dev-bits-per-sample h)
-                   (buffer-info-endianness info)
+                    (ao-handle-dev-endianness h)
-                   (ao-handle-dev-endianness h)
+                    )
-                   )
-
-        (convert-bits mem buf-size
-                      (buffer-info-sample-bits info)
-                      (buffer-info-endianness info)
-                      (ao-handle-dev-bits-per-sample h)
-                      (ao-handle-dev-endianness h)
-                      )
-        )
       )
   )
 
@@ -612,6 +396,7 @@
              (set! i n)
              )
            )
+         (set! i (+ i 1))
          )
       )
 
@@ -775,339 +560,3 @@
 (define (ao_real_output_bits_async h)
   (ao-handle-dev-bits-per-sample h))
 
-
-  
-
-
-
-#|
-(define initialized? #f)
-(define (ensure-ao-initialized!)
-  (unless initialized?
-    (ao_initialize)
-    (set! initialized? #t)))
-
-;; -------------------------------------------------------------------------
-;; Async player state.
-
-(struct play-frame (command music-id at-second music-duration data) #:transparent)
-
-(struct ao-async-handle
-  (device
-   requested-bits
-   device-bits
-   byte-format
-   channels
-   rate
-   queue
-   sema
-   lock
-   worker
-   paused-sema
-   paused-box
-   stopped-box
-   at-second-box
-   music-duration-box
-   at-music-id-box
-   buf-size-box
-   volume-box)
-  #:mutable)
-
-(define (with-lock l thunk)
-  (call-with-semaphore l thunk))
-
-(define (box-set-under-lock! h b v)
-  (with-lock (ao-async-handle-lock h)
-    (lambda () (set-box! b v))))
-
-(define (box-ref-under-lock h b)
-  (with-lock (ao-async-handle-lock h)
-    (lambda () (unbox b))))
-
-(define (enqueue! h frame)
-  (with-lock (ao-async-handle-lock h)
-    (lambda ()
-      (let ([q (ao-async-handle-queue h)]
-            [n (bytes-length (play-frame-data frame))])
-        (q:enqueue! q frame)
-        (set-box! (ao-async-handle-buf-size-box h)
-                  (+ (unbox (ao-async-handle-buf-size-box h)) n)))))
-  (semaphore-post (ao-async-handle-sema h)))
-
-(define (dequeue/timeout h timeout-ms)
-  (and (sync/timeout (/ timeout-ms 1000.0) (ao-async-handle-sema h))
-       (with-lock (ao-async-handle-lock h)
-         (lambda ()
-           (let ([q (ao-async-handle-queue h)])
-             (and (not (q:queue-empty? q))
-                  (let ([frame (q:dequeue! q)])
-                    (set-box! (ao-async-handle-buf-size-box h)
-                              (max 0 (- (unbox (ao-async-handle-buf-size-box h))
-                                        (bytes-length (play-frame-data frame)))))
-                    frame)))))))
-
-
-(define (clear-queue! h)
-  (with-lock (ao-async-handle-lock h)
-    (lambda ()
-      (let ([q (ao-async-handle-queue h)])
-        (let loop ()
-          (unless (q:queue-empty? q)
-            (q:dequeue! q)
-            (loop))))
-      (set-box! (ao-async-handle-buf-size-box h) 0)))
-  ;; Drain semaphore posts that belonged to discarded queue elements.
-  (let loop ()
-    (when (sync/timeout 0 (ao-async-handle-sema h))
-      (loop))))
-
-(define (wait-while-paused h)
-  (let loop ()
-    (when (box-ref-under-lock h (ao-async-handle-paused-box h))
-      (sync (ao-async-handle-paused-sema h))
-      (loop))))
-
-(define (player-loop h)
-  (let loop ()
-    (wait-while-paused h)
-    (define frame (dequeue/timeout h 250))
-    (cond
-      [(not frame)
-       (unless (box-ref-under-lock h (ao-async-handle-stopped-box h))
-         (sleep 0.005)
-         (loop))]
-      [(eq? (play-frame-command frame) 'stop)
-       (box-set-under-lock! h (ao-async-handle-stopped-box h) #t)
-       (void)]
-      [else
-       (with-lock (ao-async-handle-lock h)
-         (lambda ()
-           (set-box! (ao-async-handle-at-second-box h) (play-frame-at-second frame))
-           (set-box! (ao-async-handle-music-duration-box h) (play-frame-music-duration frame))
-           (set-box! (ao-async-handle-at-music-id-box h) (play-frame-music-id frame))))
-       (define out (apply-volume h (play-frame-data frame)))
-       (ao_play (ao-async-handle-device h) out (bytes-length out))
-       (loop)])))
-
-;; -------------------------------------------------------------------------
-;; Opening and closing.
-
-(define (ao_async_version) 2)
-
-(define (make-format bits rate channels byte-format)
-  (make-ao_sample_format bits rate channels (endian->int byte-format) #f))
-
-(define (endian->int e)
-  (case e
-    [(little-endian) 1]
-    [(big-endian)    2]
-    [(native-endian) 4]
-    [else e]))
-
-(define (try-open-device bits rate channels byte-format wav-file-output)
-  (define candidates
-    (append (list bits)
-            (if (> bits 24) (list 24) null)
-            (if (> bits 16) (list 16) null)))
-  (let loop ([xs candidates])
-    (cond
-      [(null? xs) (values #f 0)]
-      [else
-       (define out-bits (car xs))
-       (define fmt (make-format out-bits rate channels byte-format))
-       (define dev
-         (if wav-file-output
-             (ao_open_file (ao_driver_id "wav") wav-file-output 1 fmt #f)
-             (ao_open_live (ao_default_driver_id) fmt #f)))
-       (if dev
-           (values dev out-bits)
-           (loop (cdr xs)))])))
-
-(define (ao_create_async bits rate channels byte-format wav-file-output)
-  (ensure-ao-initialized!)
-  (define-values (dev opened-bits)
-    (try-open-device bits rate channels byte-format wav-file-output))
-  (and dev
-       (letrec ([h (ao-async-handle dev
-                                     bits
-                                     opened-bits
-                                     byte-format
-                                     channels
-                                     rate
-                                     (q:make-queue)
-                                     (make-semaphore 0)
-                                     (make-semaphore 1)
-                                     #f
-                                     (make-semaphore 0)
-                                     (box #f)
-                                     (box #f)
-                                     (box -1.0)
-                                     (box 0.0)
-                                     (box -1)
-                                     (box 0)
-                                     (box 100.0))]
-                [t (thread (lambda () (player-loop h)))])
-         (set-ao-async-handle-worker! h t)
-         h)))
-
-(define (ao_stop_async h)
-  (when h
-    (clear-queue! h)
-    (ao_pause_async h 0)
-    (enqueue! h (play-frame 'stop 0 0.0 0.0 #""))
-    (thread-wait (ao-async-handle-worker h))
-    (ao_close (ao-async-handle-device h))
-    (void)))
-
-;; -------------------------------------------------------------------------
-;; Buffer conversion.
-
-(define (native-little-endian?)
-  ;(= 1 (integer-bytes->integer #"\1\0" #f #t)))
-  (not (system-big-endian?)))
-
-(define (little-endian-format? byte-format)
-  (case byte-format
-    [(little-endian) #t]
-    [(big-endian) #f]
-    [(native-endian) (native-little-endian?)]
-    [else (= byte-format 1)]))
-
-(define (copy-pointer-bytes ptr len)
-  (define bs (make-bytes len))
-  (for ([i (in-range len)])
-    (bytes-set! bs i (ptr-ref ptr _uint8 i)))
-  bs)
-
-(define (read-sample bs pos byte-count little?)
-  (define unsigned
-    (for/fold ([v 0]) ([i (in-range byte-count)])
-      (define idx (if little? i (- byte-count i 1)))
-      (bitwise-ior v (arithmetic-shift (bytes-ref bs (+ pos idx)) (* 8 i)))))
-  (define bits (* byte-count 8))
-  (define sign (arithmetic-shift 1 (- bits 1)))
-  (if (zero? (bitwise-and unsigned sign))
-      unsigned
-      (- unsigned (arithmetic-shift 1 bits))))
-
-(define (store-sample! bs pos byte-count little? sample)
-  (for ([i (in-range byte-count)])
-    (define idx (if little? i (- byte-count i 1)))
-    (bytes-set! bs (+ pos idx) (bitwise-and sample #xff))
-    (set! sample (arithmetic-shift sample -8))))
-
-(define (convert-bits sample in-bits out-bits)
-  (cond
-    [(> in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
-    [(< in-bits out-bits) (arithmetic-shift sample (- out-bits in-bits))]
-    [else sample]))
-
-(define (convert-requested-to-real h bs info)
-  (define requested-bits (BufferInfo_t-sample_bits info))
-  (define output-bits (ao-async-handle-device-bits h))
-  (define in-bytes (/ requested-bits 8))
-  (define out-bytes (/ output-bits 8))
-  (cond
-    [(= requested-bits output-bits) bs]
-    [else
-     (define samples (quotient (bytes-length bs) in-bytes))
-     (define out (make-bytes (* samples out-bytes)))
-     (define little? (little-endian-format? (ao-async-handle-byte-format h)))
-     (for ([s (in-range samples)])
-       (define sample (read-sample bs (* s in-bytes) in-bytes little?))
-       (define converted (convert-bits sample requested-bits output-bits))
-       (store-sample! out (* s out-bytes) out-bytes little? converted))
-     out]))
-
-(define (flac-pointer->interleaved-bytes ptr sample-count info)
-  ;; FLAC buffers are int32_t *buffer[]: channel-oriented signed 32-bit
-  ;; samples. buf_size is the number of samples per channel.
-  (define bits (BufferInfo_t-sample_bits info))
-  (define bytes-per-sample (/ bits 8))
-  (define channels (BufferInfo_t-channels info))
-  (define little? (little-endian-format? (BufferInfo_t-endiannes info)))
-  (define out (make-bytes (* sample-count channels bytes-per-sample)))
-  (define pos 0)
-  (for ([k (in-range sample-count)])
-    (for ([ch (in-range channels)])
-      (define channel-ptr (ptr-ref ptr _pointer ch))
-      (define sample (ptr-ref channel-ptr _int32 k))
-      (store-sample! out pos bytes-per-sample little? sample)
-      (set! pos (+ pos bytes-per-sample))))
-  out)
-
-(define (ao_play_async h music-id at-second music-duration buf-size mem info)
-  (define source
-    (case (BufferInfo_t-type info)
-      [(ao)   (copy-pointer-bytes mem buf-size)]
-      [(flac) (flac-pointer->interleaved-bytes mem buf-size info)]
-      [(mp3 ogg)
-       (eprintf "format ~a not supported yet\n" (BufferInfo_t-type info))
-       #f]
-      [else
-       (eprintf "unknown buffer type ~a\n" (BufferInfo_t-type info))
-       #f]))
-  (when source
-    (define out (convert-requested-to-real h source info))
-    (enqueue! h (play-frame 'play
-                            music-id
-                            (real->double-flonum at-second)
-                            (real->double-flonum music-duration)
-                            out))))
-
-;; -------------------------------------------------------------------------
-;; Status and controls.
-
-(define (ao_clear_async h)
-  (clear-queue! h))
-
-(define (ao_is_at_second_async h)
-  (box-ref-under-lock h (ao-async-handle-at-second-box h)))
-
-(define (ao_is_at_music_id_async h)
-  (box-ref-under-lock h (ao-async-handle-at-music-id-box h)))
-
-(define (ao_music_duration_async h)
-  (box-ref-under-lock h (ao-async-handle-music-duration-box h)))
-
-(define (ao_bufsize_async h)
-  (box-ref-under-lock h (ao-async-handle-buf-size-box h)))
-
-(define (ao_real_output_bits_async h)
-  (ao-async-handle-device-bits h))
-
-(define (ao_pause_async h paused)
-  (define pause? (not (zero? paused)))
-  (with-lock (ao-async-handle-lock h)
-    (lambda ()
-      (define was-paused? (unbox (ao-async-handle-paused-box h)))
-      (set-box! (ao-async-handle-paused-box h) pause?)
-      (when (and was-paused? (not pause?))
-        (semaphore-post (ao-async-handle-paused-sema h))))))
-
-(define (ao_set_volume_async h percentage)
-  ;; Keep the old public meaning: 100.0 means 100 percent.
-  (define v (if (integer? percentage) (exact->inexact percentage) percentage))
-  (with-lock (ao-async-handle-lock h)
-    (lambda ()
-      (set-box! (ao-async-handle-volume-box h)
-                (if (and (>= v 99.9) (<= v 100.1)) 100.0 v)))))
-
-(define (ao_volume_async h)
-  (box-ref-under-lock h (ao-async-handle-volume-box h)))
-
-(define (apply-volume h bs)
-  (define volume (box-ref-under-lock h (ao-async-handle-volume-box h)))
-  (cond
-    [(= volume 100.0) bs]
-    [else
-     (define out (bytes-copy bs))
-     (define bytes-per-sample (/ (ao-async-handle-device-bits h) 8))
-     (define little? (little-endian-format? (ao-async-handle-byte-format h)))
-     (define factor (/ volume 100.0))
-     (for ([pos (in-range 0 (bytes-length out) bytes-per-sample)])
-       (define sample (read-sample out pos bytes-per-sample little?))
-       (define scaled (inexact->exact (truncate (* sample factor))))
-       (store-sample! out pos bytes-per-sample little? scaled))
-     out]))
-|#

libao.rkt

@@ -1,7 +1,7 @@
 #lang racket/base
 
 (require (prefix-in fin: finalizer)
-         (prefix-in ffi: "libao-async-ffi-racket.rkt")
+         (prefix-in ffi: "libao-async-ffi.rkt")
          ffi/unsafe
          ffi/unsafe/custodian
          data/queue

play-test.rkt

@@ -6,7 +6,7 @@
          racket-sprintf
          racket/runtime-path
          ;data/queue
-  ;racket-sound
+         ;racket-sound
          )
 
 (define-runtime-path tests "tests")
@@ -17,8 +17,8 @@
 (define test-file4-id 4)
 (let ((os (system-type 'os)))
   (when (eq? os 'unix)
-    (set! test-file3 (build-path tests "mahler-1.ogg"))
+    (set! test-file3 (build-path tests "idyll.mp3"))
-    (set! test-file4 (build-path tests "mahler-2.ogg"))
+    (set! test-file4 (build-path tests "idyll.flac"))
     )
   (when (eq? os 'windows)
     (set! test-file3 (build-path tests "idyll.mp3"))

private/downloader.rkt

@@ -24,9 +24,9 @@
 ;; Version info of the version to download
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
-(define version-major 0)
+(define version-major 1)
-(define version-minor 2)
+(define version-minor 0)
-(define version-patch 1)
+(define version-patch 0)
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; Internal functions

private/utils.rkt

@@ -19,6 +19,8 @@
            warn-sound
            fatal-sound
            sync-log-sound
+           integer->int-bytes
+           int-bytes->integer
            )
 
   (sl-def-log racket-sound sound)
@@ -69,18 +71,56 @@
     (soundlibs-directory))
 
   (define (get-lib* libs-to-try orig-libs versions)
-    (unless (soundlibs-available?)
+    (let ((libs-path (cons (build-lib-path) (get-lib-search-dirs))))
-      (download-soundlibs))
+      (unless (soundlibs-available?)
-    (if (null? libs-to-try)
+        (download-soundlibs))
-        (begin
+      (if (null? libs-to-try)
-          (displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs (build-lib-path)))
+          (begin
-          #f)
+            (displayln (format "Warning: Cannot find library, tried ~a in ~a" orig-libs libs-path))
-        (ffi-lib (car libs-to-try) versions
+            #f)
-                 #:get-lib-dirs (λ () (cons (build-lib-path) (get-lib-search-dirs)))
+          (ffi-lib (car libs-to-try) versions
-                 #:fail (λ () (get-lib* (cdr libs-to-try) orig-libs versions))
+                   #:get-lib-dirs (λ () libs-path)
-                 )))
+                   #:fail (λ ()
+                            (ffi-lib (car libs-to-try) versions
+                                     #:fail (λ () 
+                                              (get-lib* (cdr libs-to-try) orig-libs versions))))
+                   )
+          )
+      )
+    )
 
   (define (get-lib libs-to-try versions)
     (get-lib* libs-to-try libs-to-try versions))
+
+  (define-syntax-rule (integer->int-bytes v size signed? big? bs pos)
+    (if (= size 3)
+        (if big?
+            (begin
+              (bytes-set! bs pos       (bitwise-and (arithmetic-shift v -16) #xff))
+              (bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8)  #xff))
+              (bytes-set! bs (+ pos 2) (bitwise-and v #xff)))
+            (begin
+              (bytes-set! bs pos       (bitwise-and v #xff))
+              (bytes-set! bs (+ pos 1) (bitwise-and (arithmetic-shift v -8)  #xff))
+              (bytes-set! bs (+ pos 2) (bitwise-and (arithmetic-shift v -16) #xff))))
+        (integer->integer-bytes v size signed? big? bs pos)))
+
+  (define-syntax-rule (int-bytes->integer bs signed? big? start end)
+    (let ([size (- end start)])
+      (if (= size 3)
+          (let* ([b0 (bytes-ref bs start)]
+                 [b1 (bytes-ref bs (+ start 1))]
+                 [b2 (bytes-ref bs (+ start 2))]
+                 [u  (if big?
+                         (bitwise-ior (arithmetic-shift b0 16)
+                                      (arithmetic-shift b1 8)
+                                      b2)
+                         (bitwise-ior b0
+                                      (arithmetic-shift b1 8)
+                                      (arithmetic-shift b2 16)))])
+            (if (and signed? (not (zero? (bitwise-and u #x800000))))
+                (- u #x1000000)
+                u))
+          (integer-bytes->integer bs signed? big? start end))))
   
 ) ; end of module