diff options
| -rw-r--r-- | guile/nanolight/fixture.scm | 97 |
1 files changed, 45 insertions, 52 deletions
diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm index cad2ba5..90abf6a 100644 --- a/guile/nanolight/fixture.scm +++ b/guile/nanolight/fixture.scm @@ -5,7 +5,7 @@ #:use-module (web http) #:use-module (web uri) #:export (<fixture> <fixture-attribute> - patch-fixture patch-many + start-ola-output patch-fixture patch-many fixture-string fixture-address-string percent->dmxval msb lsb chan get-fixture-start-addr get-fixture-universe @@ -131,9 +131,6 @@ (get-attributes fix))) -(define output #f) - - (define* (patch-fixture fixture-name attribute-generator start-addr @@ -144,8 +141,6 @@ #:sa start-addr #:friendly-name friendly-name))) (home-all-attributes new-fixture) - (unless output - (set! output (make-output))) ; Start output if not already running (set! fixtures (acons fixture-name new-fixture fixtures)))) @@ -212,55 +207,53 @@ "&d=" (bytevec->string (cdr universe))))) -(define (make-output) +(define (start-ola-output) (letrec* ((ola-uri (build-uri 'http #:host "127.0.0.1" #:port 9090 #:path "/set_dmx")) (ola-socket (open-socket-for-uri ola-uri))) - (define (run-scanout) - (let ((universes '())) - - ;; Helper function called by attribute translators - ;; to set individual DMX values - (define (set-dmx universe addr value) - - ;; Create DMX array for universe if it doesn't exist already - (unless (assq universe universes) - (set! universes (acons universe - (make-u8vector 512 0) - universes))) - - ;; Set the value in the DMX array - (u8vector-set! (assq-ref universes universe) - (- addr 1) ; u8vector-set indexing starts from zero - (round-dmx value))) - - ;; Scan out all fixtures - (for-each (lambda (fix-assoc-entry) - - ;; Scan out one fixture - (let ((fix (cdr fix-assoc-entry))) - (for-each (lambda (attr) - (let ((trans (translator attr))) - (trans (get-universe fix) - (get-start-addr fix) - ((value-func attr)) - set-dmx))) - (get-attributes fix)))) - - fixtures) - - ;; Send everything to OLA - (for-each (lambda (a) - (send-to-ola ola-uri - ola-socket - a)) - universes)) - - (yield) - (run-scanout)) - - ;; Start sending output - (make-thread run-scanout))) + (begin-thread + (let scanout-loop () + + (let ((universes '())) + + + ;; Helper function called by attribute translators + ;; to set individual DMX values + (define (set-dmx universe addr value) + + ;; Create DMX array for universe if it doesn't exist already + (unless (assq universe universes) + (set! universes (acons universe + (make-u8vector 512 0) + universes))) + + ;; Set the value in the DMX array + (u8vector-set! (assq-ref universes universe) + (- addr 1) ; u8vector-set indexing starts from zero + (round-dmx value))) + + ;; Scan out all fixtures + (for-each (lambda (fix-assoc-entry) + + ;; Scan out one fixture + (let ((fix (cdr fix-assoc-entry))) + (for-each (lambda (attr) + (let ((trans (translator attr))) + (trans (get-universe fix) + (get-start-addr fix) + ((value-func attr)) + set-dmx))) + (get-attributes fix)))) + + fixtures) + + ;; Send everything to OLA + (for-each (lambda (a) + (send-to-ola ola-uri ola-socket a)) + universes)) + + (yield) + (scanout-loop))))) |