diff options
author | Thomas White <taw@physics.org> | 2022-04-24 18:20:53 +0200 |
---|---|---|
committer | Thomas White <taw@physics.org> | 2022-04-24 18:20:53 +0200 |
commit | 9411275e9f6dcee09923329d54fd6e6e439a497d (patch) | |
tree | 76e1ca8bd7fc9a089d42ed5070a4a2fdbebe01c2 | |
parent | d9f1fde46f72f729348ec3c6b96b1971e4bf2760 (diff) |
Add define-fixture macro
-rw-r--r-- | guile/starlet/fixture.scm | 36 |
1 files changed, 35 insertions, 1 deletions
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 ...))))) |