Initial abstraction layer for colours

4 files changed, 92 insertions, 7 deletions

diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index ea7850c..bbb98e2 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -1,5 +1,6 @@
 (define-module (starlet base)
   #:use-module (starlet utils)
+  #:use-module (starlet colours)
   #:use-module (oop goops)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 atomic)
@@ -22,12 +23,14 @@
             <fixture-attribute>
             attr-continuous
             attr-list
+            attr-colour
             get-attr-type
             get-attr-range
             get-attr-name
             get-attr-home-val
             intensity?
             continuous-attribute?
+            colour-attribute?
 
             <starlet-state>
             make-empty-state
@@ -207,6 +210,11 @@
        (get-attr-type aobj)))
 
 
+(define (colour-attribute? aobj)
+  (eq? 'colour
+       (get-attr-type aobj)))
+
+
 (define (append-or-replace-named-state orig-list name new-state)
   (let ((new-list (map (lambda (st)
                          (if (eq? (get-state-name st) name)
@@ -520,6 +528,15 @@ pre-existing contents."
        #:home-value attr-home-value))))
 
 
+(define-syntax attr-colour
+  (syntax-rules ()
+    ((_ attr-name attr-home-value)
+     (make <fixture-attribute>
+       #:name attr-name
+       #:type 'colour
+       #:home-value attr-home-value))))
+
+
 (define current-state (make-parameter programmer-state))
 
 
diff --git a/guile/starlet/colours.scm b/guile/starlet/colours.scm
new file mode 100644
index 0000000..d390c5d
--- /dev/null
+++ b/guile/starlet/colours.scm
@@ -0,0 +1,45 @@
+(define-module (starlet colours)
+  #:use-module (oop goops)
+  #:export (<colour>
+             make-colour-cmy
+             make-colour-rgb
+             colour-as-cmy
+             white))
+
+
+(define-class <colour> (<object>)
+  (type
+    #:init-form (error "Colour type must be specified")
+    #:init-keyword #:type
+    #:getter colour-type)
+
+  (value
+    #:init-form (error "Colour value must be specified")
+    #:init-keyword #:value
+    #:getter colour-value))
+
+
+(define-method (write (col <colour>) port)
+  (format port "#<<colour> ~a ~a>"
+          (colour-type col)
+          (colour-value col)))
+
+
+(define (make-colour-cmy c m y)
+  (make <colour>
+        #:type 'cmy
+        #:value (list c m y)))
+
+
+(define (make-colour-rgb r g b)
+  (make <colour>
+        #:type 'rgb
+        #:value (list r g b)))
+
+
+(define white
+  (make-colour-cmy 0 0 0))
+
+
+(define (colour-as-cmy col)
+  (colour-value col))
diff --git a/guile/starlet/fixture-library/robe.scm b/guile/starlet/fixture-library/robe.scm
index 1dae94b..7654f69 100644
--- a/guile/starlet/fixture-library/robe.scm
+++ b/guile/starlet/fixture-library/robe.scm
@@ -1,6 +1,7 @@
 (define-module (starlet fixture-library robe)
   #:use-module (oop goops)
   #:use-module (starlet base)
+  #:use-module (starlet colours)
   #:export (<robe-dl7s-mode1>
             <robe-mmxwashbeam-mode1>
             <robe-mmxspot-mode1>))
@@ -127,9 +128,7 @@
                 (attr-list 'prism '(#t #f) #f)
                 (attr-list 'strobe '(#f #t random zap) #f)
                 (attr-continuous 'strobe-speed '(0 100) 50)
-                (attr-continuous 'cyan '(0 100) 0)
-                (attr-continuous 'magenta '(0 100) 0)
-                (attr-continuous 'yellow '(0 100) 0)
+                (attr-colour 'colour white)
                 (attr-continuous 'iris '(0 100) 0)
                 (attr-continuous 'zoom '(0 100) 0)
                 (attr-continuous 'focus '(0 100) 0)
@@ -171,9 +170,11 @@
                            (uv . 110))
                          (get-attr 'colwheel)))
 
-  (set-chan8 9 (percent->dmxval8 (get-attr 'cyan)))
-  (set-chan8 10 (percent->dmxval8 (get-attr 'magenta)))
-  (set-chan8 11 (percent->dmxval8 (get-attr 'yellow)))
+  (let ((cmy (colour-as-cmy (get-attr 'colour))))
+    (set-chan8 9 (percent->dmxval8 (car cmy)))
+    (set-chan8 10 (percent->dmxval8 (cadr cmy)))
+    (set-chan8 11 (percent->dmxval8 (caddr cmy))))
+
   (set-chan8 35 (percent->dmxval8 (get-attr 'hotspot)))
   (set-chan8 12 (scale-to-range (get-attr 'cto) '(3200 6900) '(0 255)))
   (set-chan8 27 (scale-to-range (get-attr 'frost) '(0 100) '(0 179))))
diff --git a/guile/starlet/playback.scm b/guile/starlet/playback.scm
index c9153d8..9d372bf 100644
--- a/guile/starlet/playback.scm
+++ b/guile/starlet/playback.scm
@@ -304,7 +304,28 @@
   (lambda (time)
     (cond
       ((< time fade-start-time) start-val)
-      ((> time (+ preset-start-time preset-time)) preset-val)
+      ((and (not (eq? 'no-value preset-val))
+            (> time (+ preset-start-time preset-time)))
+       preset-val)
+      (else target-val))))
+
+
+(define (make-colour-fade start-val
+                          target-val
+                          preset-val
+                          fade-time
+                          fade-start-time
+                          preset-time
+                          preset-start-time)
+  (lambda (time)
+    (cond
+
+      ((< time fade-start-time) start-val)
+
+      ((and (not (eq? 'no-value preset-val))
+            (> time (+ preset-start-time preset-time)))
+       preset-val)
+
       (else target-val))))
 
 
@@ -449,6 +470,7 @@
   (cond
     ((eq? type 'continuous) make-continuous-attr-fade)
     ((eq? type 'list) make-list-attr-fade)
+    ((eq? type 'colour) make-colour-fade)
     (else
       (raise-exception (make-exception
                          (make-exception-with-message