Work on init.scm

1 files changed, 58 insertions, 35 deletions

diff --git a/src/init.scm b/src/init.scm
index 710204e..be9918c 100644
--- a/src/init.scm
+++ b/src/init.scm
@@ -38,42 +38,65 @@
       (display "Fixture class not available\n"))))
 
 
-(define at
-  (lambda (fixname level)
-    (cons fixname (cons 'intensity level))))
+(patch-many (find-fixture-class fixture-class-library "Robe Robin DL7S Profile Mode 1") 'mh 4 0 51)
+(patch-many (find-fixture-class fixture-class-library "Generic dimmer") 'dim 6 0 1)
 
+; New version
+
+(define (make-fixture fixture-class)
+  (list (int 0) (pan 50) (tilt 50)))
+
+(define (at source sink)
+  (let ((attr (car source))
+         (val (cdr source)))
+    (set-cdr! (assq attr sink) val)))
+
+(define (status fixture)
+  (for-each (lambda (a)
+              (format #t "~10@a:  ~a~%" (car a) ((cdr a))))
+    fixture))
+
+; Useful source functions
+
+(define (int value)
+  (cons 'intensity (lambda () value)))
+
+(define (pan value)
+  (cons 'pan (lambda () value)))
+
+(define (tilt value)
+  (cons 'tilt (lambda () value)))
+
+(define (flash sec)
+  (cons 'intensity (lambda ()
+                     (if (= 0 (remainder (current-time) sec))
+                       100 0))))
+
+
+(define-syntax define-state
+  (syntax-rules ()
+    ((_ name exp exp* ...)
+      (define name
+        (lambda () exp exp* ...)))))
+
+; Demo
+
+(define mh1 (make-fixture "Robe Robin DL7S Profile Mode 1"))
+(define mh2 (make-fixture "Robe Robin DL7S Profile Mode 1"))
+(define mh3 (make-fixture "Robe Robin DL7S Profile Mode 1"))
+(define mh4 (make-fixture "Robe Robin DL7S Profile Mode 1"))
+(define dim1 (make-fixture "Generic dimmer"))
+(define dim2 (make-fixture "Generic dimmer"))
+
+(define-state exstate
+  (mh1 (flash 2))
+  (mh2 (int 0))
+  (mh3 (int (+ 30 30)))
+  (mh4 (int 32))
+  (dim1 (int 100))
+  (dim2 (int 12)))
 
-(define show-state
-  (lambda (state)
-    (set-level fixtures 0)
-    (let ([qv (state)])
-      (for-each (lambda (q)
-		  (set-level (car q) (cddr q)))
-	qv))))
 
-(patch-many (find-fixture-class fixture-class-library "Robe Robin DL7S Profile Mode 1") 'mh 4 0 51)
-(patch-many (find-fixture-class fixture-class-library "Generic dimmer") 'dim 6 0 1)
 
-(define example
-  (lambda ()
-    (list
-      (at 'mh1 85)
-      (at 'mh2 0)
-      (at 'mh3 (+ 30 30))
-      (at 'mh4 32)
-      (at 'dim1 100)
-      (at 'dim2 12))))
-
-(define home
-  (lambda ()
-    (list)))
-
-(show-state home)
-
-(define att
-  (lambda (fix lvl)
-    (let ([st
-	    (lambda ()
-	      (list
-		(at fix lvl)))])
-      (show-state st))))
+; (def-cue lx5.7
+;  (xf 'up 10 'down 5 example-state))