aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorThomas White <taw@physics.org>2023-06-15 22:34:51 +0200
committerThomas White <taw@physics.org>2023-06-15 22:34:51 +0200
commit1d6f430b10f90b42220125af98829b3ddbe1eed2 (patch)
tree5b63d63d359ca66dafc6a5baffeb3984dfa51243
parent7b6e2ff3388c12544fbd0ef3623f2724e40d20b9 (diff)
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.
-rw-r--r--guile/starlet/colours.scm45
-rw-r--r--guile/starlet/engine.scm6
-rw-r--r--guile/starlet/fixture.scm10
-rw-r--r--guile/starlet/scanout.scm5
-rw-r--r--guile/starlet/state.scm76
5 files changed, 1 insertions, 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)
@@ -115,65 +114,6 @@
(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>)
value
source)
@@ -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)