From fde532557f4b42d8ea24404543156291ddbce147 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 7 Jun 2020 16:56:26 +0200
Subject: Send DMX to OLA

---
 guile/nanolight/fixture.scm | 44 ++++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 42 insertions(+), 2 deletions(-)

diff --git a/guile/nanolight/fixture.scm b/guile/nanolight/fixture.scm
index 96e4820..b532e8b 100644
--- a/guile/nanolight/fixture.scm
+++ b/guile/nanolight/fixture.scm
@@ -1,6 +1,9 @@
 (define-module (nanolight fixture)
   #:use-module (oop goops)
   #:use-module (ice-9 threads)
+  #:use-module (web client)
+  #:use-module (web http)
+  #:use-module (web uri)
   #:export (<fixture> <fixture-attribute>
              make-output patch-fixture
              fixture-string fixture-address-string
@@ -123,8 +126,40 @@
   (- (+ channel start-addr) 1))
 
 
+(define (bytevec->string bv)
+  (string-join
+    (map
+      number->string
+      (u8vector->list bv))
+    ","))
+
+
+(define (send-to-ola ola-uri ola-socket universe)
+  (http-post
+    ola-uri
+    #:port ola-socket
+    #:keep-alive? #t
+    #:headers (acons 'content-type
+                (parse-header
+                  'content-type
+                  "application/x-www-form-urlencoded")
+                '())
+    #:body (string-append
+             "u="
+             (number->string (car universe))
+             "&d="
+             (bytevec->string (cdr universe)))))
+
+
 (define (make-output)
-  (let ((fixtures '()))
+  (letrec* (
+             (fixtures '())
+             (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 '()))
@@ -158,7 +193,12 @@
                                     set-dmx)))
                       (attributes fix)))
 
-          fixtures))
+          fixtures)
+
+        ;; Send everything to OLA
+        (for-each (lambda (a)
+                    (send-to-ola ola-uri ola-socket a))
+          universes))
 
       (yield)
       (run-scanout))
-- 
cgit v1.2.3