From 90987af8285ce1dc05eaeeff8b8dc9db4d3f4492 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Mon, 28 Nov 2022 22:28:58 +0100
Subject: WIP: Scanout from UDP data

---
 guile/starlet/scanout.scm | 119 +++++++++++++++++++++++++++-------------------
 1 file changed, 70 insertions(+), 49 deletions(-)

diff --git a/guile/starlet/scanout.scm b/guile/starlet/scanout.scm
index a18949d..baec1b2 100644
--- a/guile/starlet/scanout.scm
+++ b/guile/starlet/scanout.scm
@@ -28,6 +28,7 @@
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 exceptions)
   #:use-module (srfi srfi-1)
+  #:use-module (rnrs bytevectors)
   #:export (start-ola-output
              scanout-freq
              get-attr
@@ -87,42 +88,59 @@
   (set-chan8 (+ relative-channel-number 1) (lsb value)))
 
 
+(define input-socket
+  (socket PF_INET (logior SOCK_DGRAM SOCK_NONBLOCK) 0))
+
+
 (define (scanout-loop ola-client start-time count previous-universes)
 
-  (let ((universes '()))
-
-    (for-each
-      (lambda (fix)
-
-        ;; Ensure the DMX array exists for this fixture's universe
-        (unless (assq (get-fixture-universe fix) universes)
-          (set! universes (acons (get-fixture-universe fix)
-                                 (make-ola-dmx-buffer)
-                                 universes)))
-
-        (parameterize
-          ((current-scanout-fixture fix)
-           (current-scanout-universe (assq-ref
-                                       universes
-                                       (get-fixture-universe fix)))
-           (current-scanout-addr (get-fixture-addr fix)))
-          (scanout-fixture fix)))
-      (atomic-box-ref fixtures))
-
-    ;; Send everything to OLA
-    (for-each (lambda (uni-buf-pair)
-                (let ((uni (car uni-buf-pair))
-                      (buf (cdr uni-buf-pair)))
-                  (let ((prev-buf (assv-ref previous-universes uni)))
-
-                    ;; Do not send exactly the same data every time,
-                    ;; but do send an update once every 100 loops, just to
-                    ;; make sure OLA does not forget about us.
-                    (unless (and prev-buf
-                                 (ola-dmx-buffers-equal? buf prev-buf)
-                                 (not (= count 0)))
-                      (send-streaming-dmx-data! ola-client uni buf)))))
-              universes)
+  (let ((universes '())
+        (buf (make-bytevector 2048))
+        (err #f))
+
+    (with-exception-handler
+      (lambda (exn)
+        (set! err #t))
+      (lambda ()
+        (recv! input-socket buf))
+      #:unwind? #t)
+
+    (unless err
+
+      (display "Got it!\n")
+
+      (for-each
+        (lambda (fix)
+
+          ;; Ensure the DMX array exists for this fixture's universe
+          (unless (assq (get-fixture-universe fix) universes)
+            (set! universes (acons (get-fixture-universe fix)
+                                   (make-ola-dmx-buffer)
+                                   universes)))
+
+          (parameterize
+            ((current-scanout-fixture fix)
+             (current-scanout-universe (assq-ref
+                                         universes
+                                         (get-fixture-universe fix)))
+             (current-scanout-addr (get-fixture-addr fix)))
+            (scanout-fixture fix)))
+        (atomic-box-ref fixtures))
+
+      ;; Send everything to OLA
+      (for-each (lambda (uni-buf-pair)
+                  (let ((uni (car uni-buf-pair))
+                        (buf (cdr uni-buf-pair)))
+                    (let ((prev-buf (assv-ref previous-universes uni)))
+
+                      ;; Do not send exactly the same data every time,
+                      ;; but do send an update once every 100 loops, just to
+                      ;; make sure OLA does not forget about us.
+                      (unless (and prev-buf
+                                   (ola-dmx-buffers-equal? buf prev-buf)
+                                   (not (= count 0)))
+                        (send-streaming-dmx-data! ola-client uni buf)))))
+                universes))
 
     (usleep 10000)
 
@@ -138,21 +156,24 @@
 
 (define (start-ola-output)
   (if ola-thread
-      (format #t "OLA output already running\n")
-      (let* ((ola-client (make-ola-streaming-client))
-             (start-time (hirestime)))
-
-        (set! ola-thread
-          (begin-thread
-            (with-exception-handler
-              (lambda (exn)
-                (display "Error in OLA output thread:\n")
-                (set! ola-thread #f)
-                (backtrace)
-                (raise-exception exn))
-              (lambda ()
-                (scanout-loop ola-client start-time 0 '()))
-              #:unwind? #f))))))
+    (format #t "OLA output already running\n")
+    (let* ((ola-client (make-ola-streaming-client))
+           (start-time (hirestime))
+           (input-socket (socket PF_INET SOCK_DGRAM 0)))
+
+      (set! ola-thread
+        (begin-thread
+          (with-exception-handler
+            (lambda (exn)
+              (display "Error in OLA output thread:\n")
+              (set! ola-thread #f)
+              (backtrace)
+              (raise-exception exn))
+            (lambda ()
+              (bind input-socket AF_INET (inet-pton AF_INET "0.0.0.0") 5749)
+              (setsockopt input-socket SOL_SOCKET SO_REUSEADDR 1)
+              (scanout-loop ola-client start-time 0 '()))
+            #:unwind? #f))))))
 
 
 (start-ola-output)
-- 
cgit v1.2.3