racket backend for async ao

audio-decoder.rkt

@@ -227,7 +227,7 @@
     (not (null? (filter (λ (e) (string-ci=? ext e)) (audio-reader-exts reader)))))
 
   (define reader-for-kind
-    (make-hash '((mp3 . ffmpeg)            ; ffmpeg does a better job on gapless playback...
+    (make-hash '((mp3 . mp3)            ; ffmpeg does a better job on gapless playback...
                  (flac . flac)
                  (ogg . ffmpeg)
                  (vorbis . ffmpeg)

ffmpeg-ffi.rkt

@@ -161,7 +161,8 @@
          (let ((src (fmpg_buffer fh)))
            (if (eq? src #f)
                (error (format "fmpg_buffer: got NULL for ~a bytes" size))
-               (let ((dst (malloc size 'nonatomic)))
+               ;(let ((dst (malloc size 'nonatomic)))
+               (let ((dst (make-bytes size)))
                  (memcpy dst src size)
                  (values dst size))))))))
 

flac-decoder.rkt

@@ -50,6 +50,7 @@
         [(eq? e 'native-endian) (not (system-big-endian?))]
         [else (error (format "unknown endian value: ~a" e))]))
 
+  #|
   (define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
     (let* ([bytes   (quotient bits 8)]
            [little? (endian-little? endianness)]
@@ -78,6 +79,30 @@
             (set! out-pos (+ out-pos bytes)))))
 
       (list mem-out buf-size)))
+|#
+
+(define (flac-channels->interleaved-buffer buffer block-size channels bits endianness)
+  ;; buffer    = FLAC__int32 * const buffer[]
+  ;; block-size = samples per channel
+
+  (let* ([bytes    (quotient bits 8)]
+         [big?     (not (endian-little? endianness))]
+         [buf-size (* block-size channels bytes)]
+         [bs       (make-bytes buf-size)]
+         ;[out      (malloc buf-size 'atomic-interior)]
+         [out-pos  0])
+
+    (for ([k (in-range block-size)])
+      (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)
+          (set! out-pos (+ out-pos bytes)))))
+
+    ;(memcpy out bs buf-size)
+    ;(list out buf-size)
+    (list bs buf-size)
+    ))
   
   (define (process-frame handle frame buffer)
     (let* ([h          (flac-ffi-frame-header frame)]

libao-async-ffi-racket.rkt

@@ -86,7 +86,8 @@
 ;; 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 _ao-device _pointer _uint32 -> _int))
+  (_fun _ao-device _bytes _uint32 -> _int))
 
 ;; -------------------------------------------------------------------------
 ;; Mutex stuff
@@ -161,9 +162,10 @@
   )
 
 (define (new-elem command music-id at-second music-duration buflen buf)
-  (let ((new-buf (malloc buflen 'atomic)))
+  ;(let ((new-buf (make-bytes buflen))) ;((new-buf (malloc buflen 'atomic)))
-    (memcpy new-buf buf buflen)
+  ;  (memcpy new-buf buf buflen)
-    (make-queue-elem command new-buf buflen at-second music-duration music-id)))
+  ;(make-queue-elem command new-buf buflen at-second music-duration music-id)))
+  (make-queue-elem command buf buflen at-second music-duration music-id))
 
 (define (del-elem elem)
   ; does nothing
@@ -192,6 +194,9 @@
         [(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))
@@ -253,6 +258,8 @@
   )
 |#
 
+
+#|
 (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))
@@ -308,9 +315,34 @@
     )
   #t
   )
+|#
+
+(define (adjust-volume h bs buf-size volume-in-10000)
+  ;; bs: bytes
+  ;; buf-size: aantal geldige bytes in bs
+
+  (let* ([bits             (ao-handle-dev-bits-per-sample h)]
+         [bytes-per-sample (arithmetic-shift bits -3)]
+         [big?             (is-big-endian? (ao-handle-dev-endianness h))])
+
+    (unless (= volume-in-10000 10000)
+      (for ([i (in-range 0 buf-size bytes-per-sample)])
+        (let* ([sample (integer-bytes->integer bs #t big?
+                                                i
+                                                (+ i bytes-per-sample))]
+               [scaled (quotient (* sample volume-in-10000) 10000)])
+          (integer->integer-bytes scaled
+                                  bytes-per-sample
+                                  #t
+                                  big?
+                                  bs
+                                  i))))
+
+    #t))
 
 ;;; planar -> intereleaved
 
+#|
 (define (planar-to-interleaved mem buf-size info)
   (let* ([type       (buffer-info-type info)]
          [bits       (buffer-info-sample-bits info)]
@@ -352,10 +384,43 @@
                         (ptr-ref mem _uint8 (+ in-pos b)))))))
 
       (list mem-out out-size))))
+|#
 
+(define (planar-to-interleaved mem buf-size info)
+  ;; mem: bytes
+  ;; result: (list bytes output-size)
+
+  (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]
+         [out        (make-bytes out-size)])
+
+    (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 out-pos mem in-pos (+ in-pos bytes)))))
+
+      (list out out-size))))
 
 ;;; 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)]
@@ -402,6 +467,37 @@
                 (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
+  ;; returns: (list out-bytes out-size)
+
+  (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       (make-bytes out-size)]
+         [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    (integer-bytes->integer
+                         buf #t in-big?
+                         in-pos
+                         (+ in-pos in-bytes))]
+             [converted (arithmetic-shift sample shift)])
+        (integer->integer-bytes converted
+                                out-bytes
+                                #t
+                                out-big?
+                                out
+                                out-pos)))
+
+    (list out out-size)))
 
 
 
@@ -608,6 +704,9 @@
 (define (ao_play_async h music-id at-second music-duration buf-size mem info)
   (let ((type (buffer-info-type info)))
 
+    (unless (bytes? mem)
+      (error "ao_play_async: paramater mem must be of type bytes"))
+
     (when (or (eq? type 'planar) (eq? type 'flac))
       (dbg-sound "Converting from planar to interleaved")
       (let ((m (planar-to-interleaved mem buf-size info)))
@@ -621,6 +720,10 @@
         (set! ao-mem (car m))
         (set! ao-size (cadr m)))
 
+      (unless (bytes? ao-mem)
+        (error "Hey! this was unexpected!"))
+
+
       (let ((elem (new-elem 'play music-id at-second music-duration ao-size ao-mem)))
         (add h elem))
       )

libmpg123-ffi.rkt

@@ -429,16 +429,27 @@ int main(int argc, char *argv[])
         (set! mp3-file "")
         #t))
 
+    (define (copy-buffer buf size)
+      (cond
+        ((> size 0)
+         (let ((out (make-bytes size)))
+           (memcpy out buf size)
+           out))
+        ((= size 0)
+         (make-bytes 0))
+        (else
+         #f)))
+
     (define (read cb format-cb)
       (let-values ([(r done) (mpg123_read mh buffer buf-size)])
         (cond
-          ((eq? r 'MPG123_DONE) (cb 'done -1 buffer done))
+          ((eq? r 'MPG123_DONE) (cb 'done -1 (copy-buffer buffer done) done))
           ((eq? r 'MPG123_NEW_FORMAT) (do-format)
                                       (mp3-format format-cb)
                                       (read cb format-cb))
           ((eq? r 'MPG123_OK) (let ((pcm-pos (mpg123_tell64 mh)))
                                 (set! current-pcm-pos pcm-pos)
-                                (cb 'data pcm-pos buffer done)))
+                                (cb 'data pcm-pos (copy-buffer buffer done) done)))
           (else (error (format "mpg123_read: ~a" (mpg123_plain_strerror r))))
           )
         )

play-test.rkt

@@ -21,7 +21,7 @@
     (set! test-file4 (build-path tests "mahler-2.ogg"))
     )
   (when (eq? os 'windows)
-    (set! test-file3 (build-path tests "idyll.flac"))
+    (set! test-file3 (build-path tests "idyll.mp3"))
     (set! test-file4 (build-path tests "idyll.flac"))
     )
   )