From 1d6f430b10f90b42220125af98829b3ddbe1eed2 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Thu, 15 Jun 2023 22:34:51 +0200
Subject: Remove colour-component stuff

It's a bit of a hack, only needed for MIDI control.  I have a better
solution using OSC in mind.
---
 guile/starlet/colours.scm | 45 +---------------------------
 guile/starlet/engine.scm  |  6 ----
 guile/starlet/fixture.scm | 10 -------
 guile/starlet/scanout.scm |  5 ----
 guile/starlet/state.scm   | 76 -----------------------------------------------
 5 files changed, 1 insertion(+), 141 deletions(-)

diff --git a/guile/starlet/colours.scm b/guile/starlet/colours.scm
index cf71567..2162322 100644
--- a/guile/starlet/colours.scm
+++ b/guile/starlet/colours.scm
@@ -37,13 +37,7 @@
              blue
 
              interpolate-colour
-             white
-
-             <colour-component-id>
-             colour-component-id?
-             colour-component-id
-             get-colour-component
-             extract-colour-component))
+             white))
 
 
 (define-class <colour> (<object>)
@@ -167,40 +161,3 @@
                          (make-exception-with-message
                            "Unrecognised colour interpolation type")
                          (make-exception-with-irritants interpolation-type))))))
-
-
-(define-class <colour-component-id> (<object>)
-  (component
-    #:init-form (error "Colour component must be specified")
-    #:init-keyword #:component
-    #:getter get-colour-component))
-
-
-(define (colour-component-id? a)
-  (is-a? a <colour-component-id>))
-
-
-(define (colour-component-id a)
-  (make <colour-component-id>
-        #:component a))
-
-
-(define (extract-colour-component col component-id)
-  (cond
-    ((eq? (get-colour-component component-id) 'cyan)
-     (cyan (colour-as-cmy col)))
-    ((eq? (get-colour-component component-id) 'magenta)
-     (magenta (colour-as-cmy col)))
-    ((eq? (get-colour-component component-id) 'yellow)
-     (yellow (colour-as-cmy col)))
-    ((eq? (get-colour-component component-id) 'red)
-     (red (colour-as-rgb col)))
-    ((eq? (get-colour-component component-id) 'green)
-     (green (colour-as-rgb col)))
-    ((eq? (get-colour-component component-id) 'blue)
-     (blue (colour-as-rgb col)))
-    (else (raise-exception (make-exception
-                             (make-exception-with-message
-                               "Invalid colour component ID")
-                             (make-exception-with-irritants
-                               (get-colour-component component-id)))))))
diff --git a/guile/starlet/engine.scm b/guile/starlet/engine.scm
index e729668..c63cb9b 100644
--- a/guile/starlet/engine.scm
+++ b/guile/starlet/engine.scm
@@ -22,7 +22,6 @@
   #:use-module (starlet fixture)
   #:use-module (starlet state)
   #:use-module (starlet utils)
-  #:use-module (starlet colours)
   #:use-module (starlet attributes)
   #:use-module (oop goops)
   #:use-module (ice-9 threads)
@@ -133,11 +132,6 @@
       v)))
 
 
-(define-method (current-value (fix <fixture>) (attr-name <colour-component-id>))
-  (let ((colour (current-value fix colour)))
-    (extract-colour-component colour attr-name)))
-
-
 (define (append-or-replace-named-state orig-list name new-state)
   (let ((new-list (map (lambda (st)
                          (if (eq? (get-state-name st) name)
diff --git a/guile/starlet/fixture.scm b/guile/starlet/fixture.scm
index 856a67d..2711f9e 100644
--- a/guile/starlet/fixture.scm
+++ b/guile/starlet/fixture.scm
@@ -175,10 +175,6 @@
         (get-fixture-attrs fix)))
 
 
-(define-method (find-attr (fix <fixture>) (attr-name <colour-component-id>))
-  (find-attr fix colour))
-
-
 (define-method (find-attr fix attr-name)
   (raise-exception
     (make-exception
@@ -193,12 +189,6 @@
         'fixture-does-not-have-attribute)))
 
 
-(define-method (get-attr-home-val (fix <fixture>) (attr <colour-component-id>))
-  (extract-colour-component
-    (get-attr-home-val fix colour)
-    attr))
-
-
 (define (continuous-attribute? aobj)
   (eq? 'continuous
        (get-attr-type aobj)))
diff --git a/guile/starlet/scanout.scm b/guile/starlet/scanout.scm
index aca9fe6..df6245d 100644
--- a/guile/starlet/scanout.scm
+++ b/guile/starlet/scanout.scm
@@ -23,7 +23,6 @@
   #:use-module (starlet fixture)
   #:use-module (starlet state)
   #:use-module (starlet utils)
-  #:use-module (starlet colours)
   #:use-module (starlet attributes)
   #:use-module (starlet guile-ola)
   #:use-module (oop goops)
@@ -54,10 +53,6 @@
       v)))
 
 
-(define-method (get-attr (attr-name <colour-component-id>))
-  (extract-colour-component (get-attr colour) attr-name))
-
-
 (define (set-dmx universe addr value)
   (ensure-number value (list universe addr value))
 
diff --git a/guile/starlet/state.scm b/guile/starlet/state.scm
index 5844b3f..a66c342 100644
--- a/guile/starlet/state.scm
+++ b/guile/starlet/state.scm
@@ -20,7 +20,6 @@
 ;;
 (define-module (starlet state)
   #:use-module (starlet fixture)
-  #:use-module (starlet colours)
   #:use-module (starlet utils)
   #:use-module (starlet attributes)
   #:use-module (starlet selection)
@@ -113,65 +112,6 @@
   #f)
 
 
-(define-method (set-in-state! (state <starlet-state>)
-                              (fix <fixture>)
-                              (attr <colour-component-id>)
-                              new-val
-                              source)
-  (let ((current-colour (find-colour state fix))
-        (colour-component (get-colour-component attr)))
-
-    (cond
-
-      ((eq? colour-component 'cyan)
-       (let ((orig-colour (colour-as-cmy current-colour)))
-         (set-in-state! state fix colour
-                        (cmy new-val
-                             (magenta orig-colour)
-                             (yellow orig-colour))
-                        source)))
-
-      ((eq? colour-component 'magenta)
-       (let ((orig-colour (colour-as-cmy current-colour)))
-         (set-in-state! state fix colour
-                        (cmy (cyan orig-colour)
-                             new-val
-                             (yellow orig-colour))
-                        source)))
-
-      ((eq? colour-component 'yellow)
-       (let ((orig-colour (colour-as-cmy current-colour)))
-         (set-in-state! state fix colour
-                        (cmy (cyan orig-colour)
-                             (magenta orig-colour)
-                             new-val)
-                        source)))
-
-      ((eq? colour-component 'red)
-       (let ((orig-colour (colour-as-rgb current-colour)))
-         (set-in-state! state fix colour
-                        (rgb new-val
-                             (green orig-colour)
-                             (blue orig-colour))
-                        source)))
-
-      ((eq? colour-component 'green)
-       (let ((orig-colour (colour-as-rgb current-colour)))
-         (set-in-state! state fix colour
-                        (rgb (red orig-colour)
-                             new-val
-                             (blue orig-colour))
-                        source)))
-
-      ((eq? colour-component 'blue)
-       (let ((orig-colour (colour-as-rgb current-colour)))
-         (set-in-state! state fix colour
-                        (rgb (red orig-colour)
-                             (green orig-colour)
-                             new-val)
-                        source))))))
-
-
 (define-method (set-in-state! (state <starlet-state>)
                               (fix <fixture>)
                               (attr <starlet-attribute>)
@@ -199,13 +139,6 @@
   (set-in-state! state fix attr value #f))
 
 
-(define-method (set-in-state! (state <starlet-state>)
-                              (fix <fixture>)
-                              (attr <colour-component-id>)
-                              new-val)
-  (set-in-state! state fix attr new-val #f))
-
-
 ;; Set any intensity attributes in the current state to zero
 (define (blackout!)
   (let ((state (current-state)))
@@ -258,15 +191,6 @@
             'no-value))
 
 
-(define-method (state-find (fix <fixture>)
-                           (attr <colour-component-id>)
-                           (state <starlet-state>))
-  (let ((col (state-find fix colour state)))
-    (if (eq? 'no-value col)
-        'no-value
-        (extract-colour-component col attr))))
-
-
 (define (state-map->list func state)
   (hash-map->list (lambda (key value)
                     (func (car key)
-- 
cgit v1.2.3