From 66c0777b5fa3d65f97aea4061707ff18089a60c6 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Thu, 2 Jul 2020 22:47:31 +0200
Subject: Start output manually

Starting a thread from within a module, like this, doesn't work
---
 guile/nanolight/fixture.scm | 97 +++++++++++++++++++++------------------------
 1 file 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)))))
-- 
cgit v1.2.3