From 9411275e9f6dcee09923329d54fd6e6e439a497d Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 24 Apr 2022 18:20:53 +0200
Subject: Add define-fixture macro

---
 guile/starlet/fixture.scm | 36 +++++++++++++++++++++++++++++++++++-
 1 file changed, 35 insertions(+), 1 deletion(-)

(limited to 'guile')

diff --git a/guile/starlet/fixture.scm b/guile/starlet/fixture.scm
index ee0d5b8..1cda58d 100644
--- a/guile/starlet/fixture.scm
+++ b/guile/starlet/fixture.scm
@@ -45,7 +45,9 @@
             scale-and-clamp-to-range
             round-dmx
             percent->dmxval8
-            percent->dmxval16))
+            percent->dmxval16
+
+            define-fixture))
 
 
 (define-class <fixture-attribute> (<object>)
@@ -216,3 +218,35 @@
     (scale-to-range val orig-range dest-range)
     (car dest-range)
     (cadr dest-range)))
+
+
+(define-syntax define-fixture
+  (syntax-rules ()
+
+    ((_ classname
+        attrs
+        (get-attr set-chan8)
+        scanout-code ...)
+
+     (begin
+       (define-class classname (<fixture>)
+         (attributes #:init-form attrs))
+
+       (define-method (scanout-fixture (fixture classname)
+                                       get-attr set-chan8 dummy)
+
+         scanout-code ...)))
+
+    ((_ classname
+        attrs
+        (get-attr set-chan8 set-chan16)
+        scanout-code ...)
+
+     (begin
+       (define-class classname (<fixture>)
+         (attributes #:init-form attrs))
+
+       (define-method (scanout-fixture (fixture classname)
+                                       get-attr set-chan8 set-chan16)
+
+         scanout-code ...)))))
-- 
cgit v1.2.3