From 5a02170f9e1952cd335b6b097e8ce33de7bb35b1 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sat, 12 Nov 2022 11:13:53 +0100
Subject: Introduce new type for attribute names

There's a serious problem with the design so far, where symbols are used
for attribute names (intensity, strobe, colour etc), and also for
attribute values (on, off, random etc).  There's no way for 'at' to
tell the difference between the two.  For example, this form is
ambiguous:  (at myfixture 'strobe 'on)

This commit introduces a new class, <starlet-attribute>, to replace the
use of symbols here.  The attributes are enumerated in (starlet attributes),
and new ones can be added later.  The attribute objects remember their
'canonical' names, to allow states to be printed.

Apart from solving the ambiguity problem, this has two further
advantages.  First, attribute names no longer need to be quoted
everywhere.  Second, multiple names can be used to refer to the same
attribute.  For example: (define color colour).
---
 guile/starlet/fixture.scm | 16 ++++++----------
 1 file changed, 6 insertions(+), 10 deletions(-)

(limited to 'guile/starlet/fixture.scm')

diff --git a/guile/starlet/fixture.scm b/guile/starlet/fixture.scm
index 58616b3..b1a3e32 100644
--- a/guile/starlet/fixture.scm
+++ b/guile/starlet/fixture.scm
@@ -21,6 +21,7 @@
 (define-module (starlet fixture)
   #:use-module (starlet colours)
   #:use-module (starlet utils)
+  #:use-module (starlet attributes)
   #:use-module (oop goops)
   #:use-module (ice-9 exceptions)
   #:use-module (srfi srfi-1)
@@ -42,8 +43,7 @@
             get-attr-range
             get-attr-home-val
             continuous-attribute?
-            colour-attribute?
-            intensity?))
+            colour-attribute?))
 
 
 (define-class <fixture-attribute> (<object>)
@@ -138,7 +138,7 @@
   (is-a? f <fixture>))
 
 
-(define-method (find-attr (fix <fixture>) (attr-name <symbol>))
+(define-method (find-attr (fix <fixture>) (attr-name <starlet-attribute>))
   (find (lambda (a)
           (eq? (get-attr-name a)
                attr-name))
@@ -146,7 +146,7 @@
 
 
 (define-method (find-attr (fix <fixture>) (attr-name <colour-component-id>))
-  (find-attr fix 'colour))
+  (find-attr fix colour))
 
 
 (define-method (find-attr fix attr-name)
@@ -156,7 +156,7 @@
       (make-exception-with-irritants fix))))
 
 
-(define-method (get-attr-home-val (fix <fixture>) (attr <symbol>))
+(define-method (get-attr-home-val (fix <fixture>) (attr <starlet-attribute>))
   (let ((attr-obj (find-attr fix attr)))
     (if attr-obj
         (attr-home-value attr-obj)
@@ -165,14 +165,10 @@
 
 (define-method (get-attr-home-val (fix <fixture>) (attr <colour-component-id>))
   (extract-colour-component
-    (get-attr-home-val fix 'colour)
+    (get-attr-home-val fix colour)
     attr))
 
 
-(define (intensity? a)
-  (eq? 'intensity a))
-
-
 (define (continuous-attribute? aobj)
   (eq? 'continuous
        (get-attr-type aobj)))
-- 
cgit v1.2.3