From ed9dadd2536edd84604801af816a622205a48e72 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Wed, 27 May 2020 18:19:14 +0200
Subject: Basic fixture structure

---
 guile/nanolight/fixture-library/generic.scm |  9 ++++
 guile/nanolight/fixture.scm                 | 79 ++++++++++++++++++++++++++++-
 guile/nanolight/state.scm                   |  6 ++-
 3 files changed, 91 insertions(+), 3 deletions(-)
 create mode 100644 guile/nanolight/fixture-library/generic.scm

diff --git a/guile/nanolight/fixture-library/generic.scm b/guile/nanolight/fixture-library/generic.scm
new file mode 100644
index 0000000..b593004
--- /dev/null
+++ b/guile/nanolight/fixture-library/generic.scm
@@ -0,0 +1,9 @@
+(define-module (nanolight fixture-library generic)
+  #:use-module (oop goops)
+  #:use-module (nanolight fixture)
+  #:export (generic-dimmer))
+
+
+(define (generic-dimmer)
+  (list
+    (make <fixture-attribute> #:name 'intensity #:offset 0)))
diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm
index 95bdc13..9bc0552 100644
--- a/guile/nanolight/fixture.scm
+++ b/guile/nanolight/fixture.scm
@@ -1 +1,78 @@
-(define-module (nanolight fixture))
+(define-module (nanolight fixture)
+  #:export (<fixture> <fixture-attribute>
+             patch-fixture
+             fixture-string get-address-string)
+  #:use-module (oop goops))
+
+
+(define-class <fixture-attribute> (<object>)
+
+  (name
+    #:init-value 'unnamed-attribute
+    #:init-keyword #:name
+    #:getter name)
+
+  (offset
+    #:init-value 0
+    #:init-keyword #:offset
+    #:getter offset))
+
+
+(define-class <fixture> (<object>)
+
+  (attributes
+    #:init-value '()
+    #:init-keyword #:attributes)
+
+  (universe
+    #:init-value #f
+    #:init-keyword #:uni
+    #:getter get-universe
+    #:setter set-universe!)
+
+  (start-addr
+    #:init-value #f
+    #:init-keyword #:sa
+    #:getter get-start-addr
+    #:setter set-start-addr!)
+
+  (friendly-name
+    #:init-value "Fixture"
+    #:init-keyword #:friendly-name
+    #:getter get-friendly-name
+    #:setter set-friendly-name!)
+
+  (address-string
+    #:init-value #f
+    #:allocation #:virtual
+    #:getter get-address-string
+    #:slot-ref (lambda (a)
+                 (string-append
+                   (number->string (slot-ref a 'universe))
+                   "."
+                   (number->string (slot-ref a 'start-addr))))
+    #:slot-set! (lambda (a s) #f)))
+
+
+; List of all patched fixtures (for scanout)
+(define fixtures (list))
+
+(define (add-fixture-to-roster fixture)
+  (set! fixtures (cons fixture fixtures)))
+
+
+(define (fixture-string fixture)
+  (string-append
+    (get-friendly-name fixture)
+    " at "
+    (get-address-string fixture)))
+
+
+(define (patch-fixture attributes universe start-addr friendly-name)
+  (let ((new-fixture (make <fixture>
+                       #:attributes attributes
+                       #:uni universe
+                       #:sa start-addr
+                       #:friendly-name friendly-name)))
+    (add-fixture-to-roster new-fixture)
+    new-fixture))
diff --git a/guile/nanolight/state.scm b/guile/nanolight/state.scm
index deb31cf..b12d91a 100644
--- a/guile/nanolight/state.scm
+++ b/guile/nanolight/state.scm
@@ -48,8 +48,10 @@
 (define (print-state st)
 
   (define (print-statelet a)
-    (display (car a))
-    (display " ")
+    (if (eq? (car a) #f)
+      (display "(oops! nothing)"))
+      (display (fixture-string (car a)))
+    (display " / ")
     (display (cadr a))
     (newline)
     (for-each (lambda (b)
-- 
cgit v1.2.3