diff options
Diffstat (limited to 'guile/nanolight/fixture.scm')
-rw-r--r-- | guile/nanolight/fixture.scm | 79 |
1 files changed, 78 insertions, 1 deletions
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)) |