From c51d80b3411d482286b8ecd4da407ab59563233e Mon Sep 17 00:00:00 2001 From: Thomas White Date: Fri, 5 Jun 2020 10:41:11 +0200 Subject: WIP --- examples/demo.scm | 62 ++++++++++++++++++++++++++++++++ guile/nanolight/fixture-library/robe.scm | 38 ++++++++++++++++++++ guile/nanolight/fixture.scm | 22 +++--------- guile/nanolight/state.scm | 11 +++++- 4 files changed, 115 insertions(+), 18 deletions(-) create mode 100644 examples/demo.scm create mode 100644 guile/nanolight/fixture-library/robe.scm diff --git a/examples/demo.scm b/examples/demo.scm new file mode 100644 index 0000000..72eadbb --- /dev/null +++ b/examples/demo.scm @@ -0,0 +1,62 @@ +(add-to-load-path "/home/taw/nanolight/guile") + +(use-modules + (nanolight fixture) + (nanolight fixture-library generic) + (nanolight fixture-library robe) + (nanolight state) + (ice-9 textual-ports)) + +(define output (make-output)) + +(define mh1 (patch-fixture output (robe-dl7s-profile-mode1) 1 1 "Robe DL7S")) +(define mh2 (patch-fixture output (robe-dl7s-profile-mode1) 1 52 "Robe DL7S")) +(define mh3 (patch-fixture output (robe-dl7s-profile-mode1) 1 103 "Robe DL7S")) +(define mh4 (patch-fixture output (robe-dl7s-profile-mode1) 1 154 "Robe DL7S")) + +(define dim1 (patch-fixture output (generic-dimmer) 1 256 "Dimmer")) +(define dim2 (patch-fixture output (generic-dimmer) 1 257 "Dimmer")) +(define dim3 (patch-fixture output (generic-dimmer) 1 258 "Dimmer")) +(define dim4 (patch-fixture output (generic-dimmer) 1 259 "Dimmer")) +(define dim5 (patch-fixture output (generic-dimmer) 1 260 "Dimmer")) +(define dim6 (patch-fixture output (generic-dimmer) 1 261 "Dimmer")) + +(define-state exstate + (flash 2 mh1) + (int 0 mh2) + (int (+ 30 30) mh3) + (int 32 mh4) + (int 50 dim1) + (int 12 dim2)) + +(print-state exstate) +(show-state output exstate) + +; (def-cue lx5.7 +; (xf 'up 10 'down 5 example-state)) + +(display "Press enter to continue\n") +(get-char (current-input-port)) + +(define-state exstate2 + exstate + (int 100 mh1) + (int 0 mh4)) + +(print-state exstate2) +(show-state output exstate2) + +(display "Press enter to continue\n") +(get-char (current-input-port)) + +(define-state exstate3 + (merge-ltp + exstate + (int 5 mh1) + (int 5 mh4))) + +(print-state exstate3) +(show-state output exstate3) + +(display "Press enter to continue\n") +(get-char (current-input-port)) diff --git a/guile/nanolight/fixture-library/robe.scm b/guile/nanolight/fixture-library/robe.scm new file mode 100644 index 0000000..dcdd30b --- /dev/null +++ b/guile/nanolight/fixture-library/robe.scm @@ -0,0 +1,38 @@ +(define-module (nanolight fixture-library robe) + #:use-module (oop goops) + #:use-module (nanolight fixture) + #:export (robe-dl7s-profile-mode1)) + + +(define (robe-dl7s-profile-mode1) + (list + + (make #:name 'pan + #:range '(0 540) #:type 'continuous #:home-value 270 + #:translator (lambda (universe start-addr value set-dmx) + (set-dmx universe (+ 0 start-addr) 2 + (percent->dmxval value)))) + + (make #:name 'tilt + #:range '(0 270) #:type 'continuous #:home-value 135 + #:translator (lambda (universe start-addr value set-dmx) + (set-dmx universe (+ 2 start-addr) 2 + (percent->dmxval value)))) + + (make #:name 'strobe + #:range '(#f #t) #:type 'step #:home-value #f + #:translator (lambda (universe start-addr value set-dmx) + (set-dmx universe (+ 48 start-addr) 1 + (if value 95 32)))) + + (make #:name 'intensity + #:range '(0 100) #:type 'continuous #:home-value 0 + #:translator (lambda (universe start-addr value set-dmx) + (set-dmx universe (+ 49 start-addr) 2 + (percent->dmxval value)))) + + (make #:name 'prism + #:range '(#f #t) #:type 'step #:home-value #f + #:translator (lambda (universe start-addr value set-dmx) + (set-dmx universe (+ 27 start-addr) 1 + (if value 50 0)))))) diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm index 4a530f7..df4b168 100644 --- a/guile/nanolight/fixture.scm +++ b/guile/nanolight/fixture.scm @@ -1,10 +1,9 @@ (define-module (nanolight fixture) #:use-module (oop goops) - #:use-module (nanolight state) #:use-module (ice-9 threads) #:export ( make-output - patch-fixture show-state + patch-fixture fixture-string get-address-string percent->dmxval get-start-addr get-universe)) @@ -112,8 +111,7 @@ (define (make-output) - (let ((fixtures '()) - (current-state '())) + (let ((fixtures '())) (define (run-scanout) @@ -128,19 +126,13 @@ universes))) (u8vector-set! (assq-ref universes universe) - addr (round-dmx value))) - - (define (execute-state-assignment state-assignment) - (let ((attr (find-attribute - (fixture state-assignment) - (attribute state-assignment)))) - (when attr - (let ((trans (translator attr))) + addr (round-dmx value) + (trans (get-universe (fixture state-assignment)) (get-start-addr (fixture state-assignment)) ((value-func state-assignment)) - set-dmx))))) + set-dmx))) (for-each execute-state-assignment current-state) @@ -155,16 +147,12 @@ (make-thread run-scanout) ; Method functions - (define (show-state state) - (set! current-state state)) - (define (add-fixture fixture) (set! fixtures (cons fixture fixtures))) (lambda args (apply (case (car args) - ((show-state) show-state) ((add-fixture) add-fixture) (else => (error "Invalid method"))) (cdr args))))) diff --git a/guile/nanolight/state.scm b/guile/nanolight/state.scm index 405a19c..bddff72 100644 --- a/guile/nanolight/state.scm +++ b/guile/nanolight/state.scm @@ -1,6 +1,6 @@ (define-module (nanolight state) #:use-module (oop goops) - #:export (print-state define-state + #:export (print-state define-state show-state merge-states merge-rule-htp merge-rule-ltp merge-htp merge-ltp int flash pan tilt @@ -97,6 +97,15 @@ '() (apply append list-of-states))) +(define (show-state state) + (for-each (lambda (a) + (set-value-func! + (let ((attr (find-attribute) + (fixture state-assignment) + (attribute state-assignment)))))) + (when attr + (let ((trans (translator attr))))))) + (define (compare-addr a b) (or (< (get-universe (fixture a)) (get-universe (fixture b))) -- cgit v1.2.3