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

2026-05-10 01:02:13 +02:00
parent be0399796d
commit ddb44e1c41
5 changed files with 1556 additions and 253 deletions
@@ -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)
+       ...))))