racket only ffmpeg backend. Now no racket-sound-libs are needed anymore.

ffmpeg-ffi.rkt

@@ -1,8 +1,6 @@
-(module ffmpeg_ffi racket/base
+(module ffmpeg_ffi_v2 racket/base
 
-  (require ffi/unsafe
+  (require "ffmpeg-definitions.rkt"
-           ffi/unsafe/define
-           ffi/unsafe/alloc
            "private/utils.rkt"
            )
 
@@ -10,174 +8,53 @@
            fmpg-version
            )
 
-  ;; The native shim is the new instance-only FFmpeg audio API.  It exposes a
+  ;; Handler adapter for ffmpeg-decoder.rkt.  The decoder keeps using the
-  ;; single opaque fmpg_instance pointer and keeps stream-index, packets,
+  ;; same command protocol, while this module delegates to ffmpeg-definitions.rkt.
-  ;; decoder state and file metadata inside that instance.  The public C header
-  ;; says that output is always signed 32-bit interleaved PCM and that the
-  ;; current buffer pointer is valid until the next decode/seek/close/free call.
-
-  ;; Adjust the names below if your shared library has another basename.
-  ;; get-lib is used in the same style as libmpg123-ffi.rkt.
-  (when (eq? (system-type 'os) 'windows)
-    ; preload ffmpeg dlls.
-    (void
-     (begin
-       (get-lib '("avutil-60.dll") '(#f))
-       (get-lib '("swresample-6.dll") '(#f))
-       (get-lib '("avcodec-62") '(#f))
-       (get-lib '("avformat-62.dll") '(#f))
-       )
-     )
-    )
-  
-  (define lib (get-lib '("ffmpeg_audio" "libffmpeg_audio") '(#f)))
-
-  (define-ffi-definer define-ffmpeg-audio lib
-    #:default-make-fail make-not-available)
-
-  (define _fmpg_instance _pointer)
-
-  (define (fmpg-version)
-    (let* ((v (fmpg_version))
-           (patch (remainder v 256))
-           (minor (remainder (quotient v 256) 256))
-           (major (quotient v 65536))
-           )
-      (list major minor patch)))
-
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Native bindings
+;; Helpers
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-
-  (define-ffmpeg-audio fmpg_init
-    (_fun -> _fmpg_instance))
-
-  (define-ffmpeg-audio fmpg_free
-    (_fun _fmpg_instance -> _void))
-
-  (define-ffmpeg-audio fmpg_open_file
-    (_fun _fmpg_instance _string/utf-8 -> _int))
-
-  (define-ffmpeg-audio fmpg_close
-    (_fun _fmpg_instance -> _void))
-
-  (define-ffmpeg-audio fmpg_is_open
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_audio_stream_count
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_audio_sample_rate
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_audio_channels
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_audio_bits_per_sample
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_audio_bytes_per_sample
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_duration_ms
-    (_fun _fmpg_instance -> _int64))
-
-  (define-ffmpeg-audio fmpg_duration_samples
-    (_fun _fmpg_instance -> _int64))
-
-  (define-ffmpeg-audio fmpg_file_title
-    (_fun _fmpg_instance -> _string/utf-8))
-
-  (define-ffmpeg-audio fmpg_file_author
-    (_fun _fmpg_instance -> _string/utf-8))
-
-  (define-ffmpeg-audio fmpg_file_album
-    (_fun _fmpg_instance -> _string/utf-8))
-
-  (define-ffmpeg-audio fmpg_file_genre
-    (_fun _fmpg_instance -> _string/utf-8))
-
-  (define-ffmpeg-audio fmpg_file_comment
-    (_fun _fmpg_instance -> _string/utf-8))
-
-  (define-ffmpeg-audio fmpg_file_copyright
-    (_fun _fmpg_instance -> _string/utf-8))
-
-  (define-ffmpeg-audio fmpg_file_year
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_file_track
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_file_bitrate
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_decode_next
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_seek_ms
-    (_fun _fmpg_instance _int64 -> _int))
-
-  (define-ffmpeg-audio fmpg_buffer
-    (_fun _fmpg_instance -> _pointer))
-
-  (define-ffmpeg-audio fmpg_buffer_size
-    (_fun _fmpg_instance -> _int))
-
-  (define-ffmpeg-audio fmpg_buffer_samples
-    (_fun _fmpg_instance -> _int64))
-
-  (define-ffmpeg-audio fmpg_buffer_start_sample
-    (_fun _fmpg_instance -> _int64))
-
-  (define-ffmpeg-audio fmpg_buffer_end_sample
-    (_fun _fmpg_instance -> _int64))
-
-  (define-ffmpeg-audio fmpg_sample_position
-    (_fun _fmpg_instance -> _int64))
-
-  (define-ffmpeg-audio fmpg_timecode
-    (_fun _fmpg_instance -> _double))
-
-  (define-ffmpeg-audio fmpg_ffmpeg_version
-    (_fun -> _string*/utf-8))
-
-  (define-ffmpeg-audio fmpg_int_version2string
-    (_fun _int -> _string*/utf-8))
-
-  (define-ffmpeg-audio fmpg_compatible_ffmpeg
-    (_fun -> _int))
-
-  (define-ffmpeg-audio fmpg_version
-    (_fun -> _int))
-  
-
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-;; Our interface for decoding to racket
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (define (ok? r)
     (not (= r 0)))
 
-  (define (str v)
+  (define (filename->string filename)
-    (if (string? v) v ""))
+    (cond
+      [(path? filename) (path->string filename)]
+      [(string? filename) filename]
+      [else #f]))
 
-  (define (known-int64? v)
+  (define (fmpg-version)
-    (and (integer? v) (not (= v -1))))
+    (ffmpeg-version 'avformat))
 
   (define (copy-current-buffer fh)
-    (let ((size (fmpg_buffer_size fh)))
+    (let ((buffer (fmpg-buffer fh))
+          (size (fmpg-buffer-size fh)))
       (cond
-        ((<= size 0) (values #f 0))
+        [(or (eq? buffer #f) (<= size 0)) (values #f 0)]
-        (else
+        [else
-         (let ((src (fmpg_buffer fh)))
+         (let ((bs (make-bytes size)))
-           (if (eq? src #f)
+           (bytes-copy! bs 0 buffer 0 size)
-               (error (format "fmpg_buffer: got NULL for ~a bytes" size))
+           (values bs size))])))
-               ;(let ((dst (malloc size 'nonatomic)))
+
-               (let ((dst (make-bytes size)))
+  (define (reset-info! set-rate! set-channels! set-sample-bits!
-                 (memcpy dst src size)
+                       set-sample-bytes! set-pcm-length! set-duration-ms!
-                 (values dst size))))))))
+                       set-audio-streams! set-ffmpeg-file! set-current-pcm-pos!
+                       set-bitrate!)
+    (set-rate! -1)
+    (set-channels! -1)
+    (set-sample-bits! -1)
+    (set-sample-bytes! -1)
+    (set-pcm-length! -1)
+    (set-duration-ms! -1)
+    (set-audio-streams! -1)
+    (set-ffmpeg-file! "")
+    (set-current-pcm-pos! 0)
+    (set-bitrate! -1))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Handler protocol used by ffmpeg-decoder.rkt
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
   (define (fmpg-ffi-decoder-handler)
 
@@ -192,23 +69,31 @@
     (define audio-streams -1)
     (define ffmpeg-file "")
     (define current-pcm-pos 0)
-
-    (define title "")
-    (define author "")
-    (define album "")
-    (define genre "")
-    (define comment "")
-    (define copyright "")
-    (define year -1)
-    (define track -1)
     (define bitrate -1)
 
+    (define (set-rate! v) (set! rate v))
+    (define (set-channels! v) (set! channels v))
+    (define (set-sample-bits! v) (set! sample-bits v))
+    (define (set-sample-bytes! v) (set! sample-bytes v))
+    (define (set-pcm-length! v) (set! pcm-length v))
+    (define (set-duration-ms! v) (set! duration-ms v))
+    (define (set-audio-streams! v) (set! audio-streams v))
+    (define (set-ffmpeg-file! v) (set! ffmpeg-file v))
+    (define (set-current-pcm-pos! v) (set! current-pcm-pos v))
+    (define (set-bitrate! v) (set! bitrate v))
+
+    (define (reset!)
+      (reset-info! set-rate! set-channels! set-sample-bits!
+                   set-sample-bytes! set-pcm-length! set-duration-ms!
+                   set-audio-streams! set-ffmpeg-file! set-current-pcm-pos!
+                   set-bitrate!))
+
     (define (new)
       (if (eq? fh #f)
           (begin
-            (set! fh (fmpg_init))
+            (set! fh (fmpg-init))
             (when (eq? fh #f)
-              (error "fmpg_init: could not allocate ffmpeg instance"))
+              (error "fmpg-init: could not allocate ffmpeg instance"))
             #t)
           (error "ffmpeg handle already initialized, delete it first")))
 
@@ -216,44 +101,31 @@
       (if (eq? fh #f)
           (error "ffmpeg handle has already been deleted")
           (begin
-            (fmpg_free fh)
+            (fmpg-close! fh)
             (set! fh #f)
-            (set! rate -1)
+            (reset!)
-            (set! channels -1)
-            (set! sample-bits -1)
-            (set! sample-bytes -1)
-            (set! pcm-length -1)
-            (set! duration-ms -1)
-            (set! audio-streams -1)
-            (set! ffmpeg-file "")
-            (set! current-pcm-pos 0)
             #t)))
 
     (define (fetch-info)
-      (set! rate (fmpg_audio_sample_rate fh))
+      (set! rate (fmpg-audio-sample-rate fh))
-      (set! channels (fmpg_audio_channels fh))
+      (set! channels (fmpg-audio-channels fh))
-      (set! sample-bits (fmpg_audio_bits_per_sample fh))
+      (set! sample-bits (fmpg-audio-bits-per-sample fh))
-      (set! sample-bytes (fmpg_audio_bytes_per_sample fh))
+      (set! sample-bytes (fmpg-audio-bytes-per-sample fh))
-      (set! pcm-length (fmpg_duration_samples fh))
+      (set! pcm-length (fmpg-duration-samples fh))
-      (set! duration-ms (fmpg_duration_ms fh))
+      (set! duration-ms (fmpg-duration-ms fh))
-      (set! audio-streams (fmpg_audio_stream_count fh))
+      (set! audio-streams (fmpg-audio-stream-count fh))
-      (set! title (str (fmpg_file_title fh)))
+      (set! bitrate (fmpg-file-bitrate fh)))
-      (set! author (str (fmpg_file_author fh)))
-      (set! album (str (fmpg_file_album fh)))
-      (set! genre (str (fmpg_file_genre fh)))
-      (set! comment (str (fmpg_file_comment fh)))
-      (set! copyright (str (fmpg_file_copyright fh)))
-      (set! year (fmpg_file_year fh))
-      (set! track (fmpg_file_track fh))
-      (set! bitrate (fmpg_file_bitrate fh)))
 
     (define (init file)
-      (unless (ok? (fmpg_open_file fh file))
+      (let ((filename (filename->string file)))
-        (error (format "fmpg_open_file: could not open ~a" file)))
+        (unless filename
-      (set! ffmpeg-file (format "~a" file))
+          (error (format "fmpg-open-file!: expected path or string, got ~a" file)))
-      (set! current-pcm-pos 0)
+        (unless (ok? (fmpg-open-file! fh filename))
-      (fetch-info)
+          (error (format "fmpg-open-file!: could not open ~a" filename)))
-      #t)
+        (set! ffmpeg-file filename)
+        (set! current-pcm-pos 0)
+        (fetch-info)
+        #t))
 
     (define (ffmpeg-format cb)
       (cb current-pcm-pos rate channels sample-bits sample-bytes pcm-length))
@@ -267,76 +139,43 @@
       (info-sound "rate          : ~a" rate)
       (info-sound "pcm-length    : ~a" pcm-length)
       (info-sound "duration-ms   : ~a" duration-ms)
-      (info-sound "title         : ~a" title)
-      (info-sound "author        : ~a" author)
-      (info-sound "album         : ~a" album)
-      (info-sound "genre         : ~a" genre)
-      (info-sound "year          : ~a" year)
-      (info-sound "track         : ~a" track)
       (info-sound "bitrate       : ~a" bitrate)
       #t)
 
     (define (close)
       (unless (eq? fh #f)
-        (when (ok? (fmpg_is_open fh))
+        (when (ok? (fmpg-is-open fh))
-          (fmpg_close fh))
+          (fmpg-close! fh))
-        (set! channels -1)
+        (reset!)
-        (set! pcm-length -1)
-        (set! duration-ms -1)
-        (set! rate -1)
-        (set! sample-bits -1)
-        (set! sample-bytes -1)
-        (set! audio-streams -1)
-        (set! ffmpeg-file "")
         #t))
 
     (define (read cb format-cb)
-      ;; Unlike mpg123, this shim already has a fixed output format after
-      ;; fmpg_open_file.  Still report the format lazily on the first read so
-      ;; the decoder layer can keep exactly the same structure as mp3-decoder.
       (when (= current-pcm-pos 0)
         (ffmpeg-format format-cb))
-      (if (ok? (fmpg_decode_next fh))
+      (if (ok? (fmpg-decode-next! fh))
           (let-values ([(buffer size) (copy-current-buffer fh)])
             (cond
-              ((or (eq? buffer #f) (<= size 0))
+              [(or (eq? buffer #f) (<= size 0)) (read cb format-cb)]
-               ;; Defensive: fmpg_decode_next should only return 1 when there
+              [else
-               ;; is PCM data, but if the native side ever returns an empty
+               (let ((pcm-pos (fmpg-buffer-start-sample fh)))
-               ;; block, simply read again.
+                 (set! current-pcm-pos (fmpg-buffer-end-sample fh))
-               (read cb format-cb))
+                 (cb 'data pcm-pos buffer size))]))
-              (else
-               ;; The start sample is the absolute music position of the first
-               ;; sample frame in this buffer.  This is more useful than the
-               ;; end position for UI and progress reporting.
-               (let ((pcm-pos (fmpg_buffer_start_sample fh)))
-                 (set! current-pcm-pos (fmpg_buffer_end_sample fh))
-                 (cb 'data pcm-pos buffer size)))))
           (cb 'done -1 #f 0))
       #t)
 
     (define (seek pcm-pos)
       (let* ((r (if (and (integer? rate) (> rate 0)) rate 44100))
-             (ms (inexact->exact
+             (ms (inexact->exact (round (* 1000.0 (/ pcm-pos r))))))
-                  (round (* 1000.0 (/ pcm-pos r))))))
+        (unless (ok? (fmpg-seek-ms! fh ms))
-        (unless (ok? (fmpg_seek_ms fh ms))
+          (error (format "fmpg-seek-ms!: could not seek to sample ~a (~a ms)" pcm-pos ms)))
-          (error (format "fmpg_seek_ms: could not seek to sample ~a (~a ms)"
+        (set! current-pcm-pos (fmpg-sample-position fh))
-                         pcm-pos ms)))
-        (set! current-pcm-pos (fmpg_sample_position fh))
         #t))
 
     (define (tell)
-      (if (eq? fh #f) 0 (fmpg_sample_position fh)))
+      (if (eq? fh #f) 0 (fmpg-sample-position fh)))
 
     (define (metadata)
       (let ((h (make-hash)))
-        (hash-set! h 'title title)
-        (hash-set! h 'author author)
-        (hash-set! h 'album album)
-        (hash-set! h 'genre genre)
-        (hash-set! h 'comment comment)
-        (hash-set! h 'copyright copyright)
-        (hash-set! h 'year year)
-        (hash-set! h 'track track)
         (hash-set! h 'bitrate bitrate)
         (hash-set! h 'duration-ms duration-ms)
         (hash-set! h 'audio-streams audio-streams)

play-test.rkt

@@ -16,8 +16,8 @@
 (define test-file3-id 3)
 (define test-file4-id 4)
 
-(set! test-file3 (build-path tests "idyll.flac"))
+(set! test-file3 (build-path tests "mahler-1.mp3"))
-(set! test-file4 (build-path tests "idyll.mp3"))
+(set! test-file4 (build-path tests "mahler-2.mp3"))
 
 ;(define fmt (ao-mk-format 24 48000 2 'big-endian))
 ;(define ao-h (ao-open-live #f fmt))

private/cstruct-helper.rkt

@@ -0,0 +1,102 @@
+#lang racket/base
+
+(require ffi/unsafe
+         ffi/unsafe/define
+         ffi/unsafe/alloc
+         (for-syntax racket/base)
+         "utils.rkt"
+         )
+
+(provide make-offsets
+         def-cstruct
+         struct-helpers
+         )
+
+(define (make-offsets* defs)
+  (let ((name-store (make-hash)))
+
+    (define (expand-type n t)
+      (if (= n 0)
+          '()
+          (cons t (expand-type (- n 1) t))))
+
+    (define (make-types defs idx)
+      (if (null? defs)
+          '()
+          (let ((d (car defs)))
+            (let ((t (if (list? d)
+                         (if (symbol? (car d))
+                             (let ((name (car d)))
+                               (hash-set! name-store name (list idx (cadr d)))
+                               (list 1 (cadr d)))
+                              d)
+                         (list 1 d))))
+              (append (expand-type (car t) (cadr t))
+                      (make-types (cdr defs) (+ idx (car t))))))
+          ))
+
+    (let ((offsets (compute-offsets (make-types defs 0))))
+      (let ((keys (hash-keys name-store))
+            (offs (make-hash)))
+        (for-each (λ (key)
+                    (let* ((idx-t (hash-ref name-store key))
+                           (idx (car idx-t))
+                           (t (cadr idx-t)))
+                      (hash-set! offs key (list (list-ref offsets idx) t))
+                      )
+                    )
+                  keys)
+        offs))))
+
+
+(define-syntax (make-offset stx)
+  (syntax-case stx ()
+    ((_ (x t))
+     (cond
+       ((number? (syntax->datum #'x)) #'(list x t))
+       (else #'(list 'x t))
+       )
+     )
+    ((_ t)
+     #'(list 1 t))
+    )
+  )
+
+(define-syntax make-offsets
+  (syntax-rules ()
+    ((_ a ...)
+     (make-offsets* (list (make-offset a) ...)))))
+
+(define-syntax def-cstruct
+  (syntax-rules ()
+    ((_ name (t ...) offs)
+        (define-cstruct name
+          ([t (cadr (hash-ref offs 't)) #:offset (car (hash-ref offs 't))]
+           ...)))
+    )
+  )
+
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;; Internal structures for ffmpeg decoding
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+(define-syntax def-struct-helpers
+  (syntax-rules ()
+    ((_ (struct-get get struct-set set))
+     (begin
+       (define get struct-get)
+       (define set struct-set))
+     )
+    ((_ (struct-get get))
+     (define get struct-get)
+     )
+     )
+  )
+
+(define-syntax struct-helpers
+  (syntax-rules ()
+    ((_ a ...)
+     (begin
+       (def-struct-helpers a)
+       ...))))

private/utils.rkt

@@ -21,6 +21,17 @@
            sync-log-sound
            integer->int-bytes
            int-bytes->integer
+
+           let/assert
+           make-assert
+           a-eq? a-!eq?
+           a->? a-<=? a->=? a-<? a-=? a-!=?
+           a-nullptr? a-!nullptr?
+           a-true? a-false?
+           
+           define/return
+           return
+           
            )
 
   (sl-def-log racket-sound sound)
@@ -125,5 +136,103 @@
                 (- u #x1000000)
                 u))
           (integer-bytes->integer bs signed? big? start end))))
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; let/assert
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+
+  (define-syntax make-assert
+    (syntax-rules ()
+      ((_ name not-name pred)
+       (begin
+         (define-syntax name
+           (syntax-rules ()
+             ((_ const)
+              (λ (x) (pred x const)))))
+         (define-syntax not-name
+           (syntax-rules ()
+             ((_ const)
+              (λ (x) (not (pred x const))))))
+         )
+       )
+      )
+    )
+
+  (make-assert a-eq? a-!eq? eq?)
+
+  (define a-nullptr? (a-eq? #f))
+  (define a-!nullptr? (a-!eq? #f))
+
+  (make-assert a->? a-<=? >)
+  (make-assert a->=? a-<? >=)
+  (make-assert a-=? a-!=? =)
+
+  (define a-true? (a-eq? #t))
+  (define a-false? (a-eq? #f))
+
+  (struct exn:let/assert exn (value) #:transparent)
+
+  (define (raise-let/assert v)
+    (raise (exn:let/assert "let/assert" (current-continuation-marks) v)))
+
+  (define (let/assert-value r)
+    (exn:let/assert-value r))
+
+  (define-syntax assert-expr
+    (syntax-rules ()
+      ((_ expr cond retval)
+       (let ((a expr)) (if (cond a) a (raise-let/assert retval))))
+      ((_ expr)
+       expr)
+      )
+    )
+
+  (define-syntax let/assert
+    (syntax-rules ()
+      ((_ ((v rest ...) ...) b1 ...)
+       (with-handlers ([exn:let/assert? let/assert-value])
+         (let* ((v (assert-expr rest ...))
+                ...)
+           b1
+           ...
+           )
+         )
+       )
+      )
+    )
+
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+  ;; define/return
+  ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+
+  (struct exn:return exn (value) #:transparent)
+
+  (define (raise-return v)
+    (raise (exn:return "return" (current-continuation-marks) v)))
+
+  (define (return-value r)
+    (exn:return-value r))
+  
+  (define-syntax return
+    (syntax-rules ()
+      ((_ val)
+       (raise-return val))))
+
+  (define-syntax define/return
+    (syntax-rules ()
+      ((_ (name ...) b1 ...)
+       (define (name ...)
+         (with-handlers ([exn:return? return-value])
+           b1
+           ...
+           )
+         )
+       )
+      )
+    )
+            
+           
+       
   
 ) ; end of module