From f040a936d8f39148e81b9cd7716b1b0c466b65dd Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 2 May 2021 17:08:21 +0200
Subject: Use wrapper for OLA's C++ API instead of the web API

---
 guile/starlet/base.scm      | 45 +++++++++++++++------------------------------
 guile/starlet/guile-ola.scm | 13 +++++++++++++
 2 files changed, 28 insertions(+), 30 deletions(-)
 create mode 100644 guile/starlet/guile-ola.scm

(limited to 'guile')

diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index d9c7dd7..57d7664 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -1,15 +1,13 @@
 (define-module (starlet base)
   #:use-module (starlet utils)
   #:use-module (starlet colours)
+  #:use-module (starlet guile-ola)
   #:use-module (oop goops)
   #:use-module (ice-9 threads)
   #:use-module (ice-9 atomic)
   #:use-module (ice-9 receive)
   #:use-module (ice-9 pretty-print)
   #:use-module (ice-9 exceptions)
-  #:use-module (web client)
-  #:use-module (web http)
-  #:use-module (web uri)
   #:use-module (srfi srfi-1)
   #:use-module (srfi srfi-9)
   #:export (<fixture>
@@ -437,19 +435,10 @@ pre-existing contents."
     ","))
 
 
-(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 (send-to-ola ola-client universe-buffer-pair)
+  (let ((uni (car universe-buffer-pair))
+        (buf (cdr universe-buffer-pair)))
+  (send-streaming-dmx-data! ola-client uni buf)))
 
 
 (define (hirestime)
@@ -470,7 +459,7 @@ pre-existing contents."
 
 (define-generic scanout-fixture)
 
-(define (scanout-loop ola-uri ola-socket start-time count)
+(define (scanout-loop ola-client start-time count)
 
   (let ((universes '()))
 
@@ -481,12 +470,12 @@ pre-existing contents."
       ;; Create DMX array for universe if it doesn't exist already
       (unless (assq universe universes)
         (set! universes (acons universe
-                               (make-u8vector 512 0)
+                               (make-ola-dmx-buffer)
                                universes)))
 
-      (u8vector-set! (assq-ref universes universe)
-                     (- addr 1)                   ; u8vector-set indexing starts from zero
-                     (round-dmx value)))
+      (set-ola-dmx-buffer! (assq-ref universes universe)
+                           (- addr 1)                   ; OLA indexing starts from zero
+                           (round-dmx value)))
 
     (for-each
       (lambda (fix)
@@ -516,7 +505,7 @@ pre-existing contents."
 
     ;; Send everything to OLA
     (for-each (lambda (a)
-                (send-to-ola ola-uri ola-socket a))
+                (send-to-ola ola-client a))
               universes)
 
     (usleep 10000)
@@ -527,18 +516,14 @@ pre-existing contents."
           (set! scanout-freq
             (exact->inexact (/ 100
                                (- (hirestime) start-time))))
-          (scanout-loop ola-uri ola-socket (hirestime) 0))
-        (scanout-loop ola-uri ola-socket start-time (+ count 1)))))
+          (scanout-loop ola-client (hirestime) 0))
+        (scanout-loop ola-client start-time (+ count 1)))))
 
 (define ola-thread #f)
 
 (define (start-ola-output)
   (unless ola-thread
-    (let* ((ola-uri (build-uri 'http
-                               #:host "127.0.0.1"
-                               #:port 9090
-                               #:path "/set_dmx"))
-           (ola-socket (open-socket-for-uri ola-uri))
+    (let* ((ola-client (make-ola-streaming-client))
            (start-time (hirestime)))
 
       (set! ola-thread
@@ -550,7 +535,7 @@ pre-existing contents."
               (backtrace)
               (raise-exception exn))
             (lambda ()
-              (scanout-loop ola-uri ola-socket start-time 0))
+              (scanout-loop ola-client start-time 0))
             #:unwind? #f))))))
 
 
diff --git a/guile/starlet/guile-ola.scm b/guile/starlet/guile-ola.scm
new file mode 100644
index 0000000..5ec4fc7
--- /dev/null
+++ b/guile/starlet/guile-ola.scm
@@ -0,0 +1,13 @@
+(define-module (starlet guile-ola)
+  #:export (<OlaDmxBuffer>
+             <OlaStreamingClient>
+             send-streaming-dmx-data!
+             make-ola-dmx-buffer
+             set-ola-dmx-buffer!
+             make-ola-streaming-client
+             ola-dmx-buffers-equal?))
+
+(if (not (provided? 'guile-ola))
+    (load-extension "libguile-ola"
+                    "init_guile_ola"))
+
-- 
cgit v1.2.3