Use wrapper for OLA's C++ API instead of the web API

4 files changed, 177 insertions, 30 deletions

diff --git a/compile.sh b/compile.sh
new file mode 100755
index 0000000..a66ccf7
--- /dev/null
+++ b/compile.sh
@@ -0,0 +1,7 @@
+#!/bin/sh
+
+set -x
+g++ guile-ola.cpp -o libguile-ola.so -lola --shared -fPIC \
+                  `pkg-config --cflags --libs guile-3.0`
+
+echo Now run: sudo cp libguile-ola.so /usr/local/lib64/
diff --git a/guile-ola.cpp b/guile-ola.cpp
new file mode 100644
index 0000000..1f78e7a
--- /dev/null
+++ b/guile-ola.cpp
@@ -0,0 +1,142 @@
+/*
+ * guile-ola.cpp
+ *
+ * A very thin Guile wrapper for OLA StreamingClient
+ *
+ */
+
+#include <iostream>
+#include <ola/DmxBuffer.h>
+#include <ola/Logging.h>
+#include <ola/client/StreamingClient.h>
+#include <libguile.h>
+
+using ola::client::StreamingClient;
+
+
+static SCM dmxbuffer_type;
+static SCM streamingclient_type;
+
+
+static SCM make_ola_dmx_buffer()
+{
+	ola::DmxBuffer *buf = new ola::DmxBuffer;
+	buf->Blackout();
+	return scm_make_foreign_object_1(dmxbuffer_type, buf);
+}
+
+
+static void finalize_dmxbuffer(SCM obj)
+{
+	void *vp;
+	scm_assert_foreign_object_type(dmxbuffer_type, obj);
+	vp = scm_foreign_object_ref(obj, 0);
+	ola::DmxBuffer *buf = static_cast<ola::DmxBuffer*>(vp);
+	delete buf;
+}
+
+
+static SCM set_ola_dmx_buffer(SCM obj1, SCM obj2, SCM obj3)
+{
+	void *vp;
+	scm_assert_foreign_object_type(dmxbuffer_type, obj1);
+	vp = scm_foreign_object_ref(obj1, 0);
+	ola::DmxBuffer *buf = static_cast<ola::DmxBuffer*>(vp);
+	buf->SetChannel(scm_to_int(obj2), scm_to_int(obj3));
+	return obj3;
+}
+
+
+static SCM ola_dmx_buffers_equal_p(SCM obj1, SCM obj2)
+{
+	void *vp1;
+	void *vp2;
+	scm_assert_foreign_object_type(dmxbuffer_type, obj1);
+	scm_assert_foreign_object_type(dmxbuffer_type, obj2);
+	vp1 = scm_foreign_object_ref(obj1, 0);
+	vp2 = scm_foreign_object_ref(obj2, 0);
+	ola::DmxBuffer *buf1 = static_cast<ola::DmxBuffer*>(vp1);
+	ola::DmxBuffer *buf2 = static_cast<ola::DmxBuffer*>(vp2);
+	return scm_from_bool(*buf1 == *buf2);
+}
+
+
+static SCM make_ola_streaming_client()
+{
+	StreamingClient *cl;
+	StreamingClient::Options *opts;
+
+	ola::InitLogging(ola::OLA_LOG_WARN, ola::OLA_LOG_STDERR);
+	opts = new StreamingClient::Options;
+	cl = new StreamingClient(opts);
+
+	if ( !cl->Setup() ) {
+		std::cerr << "Setup failed" << std::endl;
+		return SCM_BOOL_F;
+	} else {
+		std::cerr << "Setup OK" << std::endl;
+		return scm_make_foreign_object_1(streamingclient_type, cl);
+	}
+}
+
+
+static void finalize_streamingclient(SCM obj)
+{
+	void *vp;
+	scm_assert_foreign_object_type(streamingclient_type, obj);
+	vp = scm_foreign_object_ref(obj, 0);
+	StreamingClient *cl = static_cast<StreamingClient*>(vp);
+	delete cl;
+}
+
+
+static SCM send_streaming_dmx_data(SCM obj1, SCM obj2, SCM obj3)
+{
+	void *vp1;
+	void *vp3;
+	scm_assert_foreign_object_type(streamingclient_type, obj1);
+	scm_assert_foreign_object_type(dmxbuffer_type, obj3);
+	vp1 = scm_foreign_object_ref(obj1, 0);
+	vp3 = scm_foreign_object_ref(obj3, 0);
+	StreamingClient *cl = static_cast<StreamingClient*>(vp1);
+	ola::DmxBuffer *buf = static_cast<ola::DmxBuffer*>(vp3);
+	if ( !cl->SendDmx(scm_to_int(obj2), *buf) ) {
+		std::cerr << "DMX send failed" << std::endl;
+	}
+	return SCM_UNSPECIFIED;
+}
+
+
+extern "C" void init_guile_ola()
+{
+	SCM name, slots;
+
+	name = scm_from_utf8_symbol("OlaDmxBuffer");
+	slots = scm_list_1(scm_from_utf8_symbol("data"));
+	dmxbuffer_type = scm_make_foreign_object_type(name,
+	                                              slots,
+	                                              finalize_dmxbuffer);
+	scm_c_define_gsubr("make-ola-dmx-buffer",
+	                   0, 0, 0,
+	                   reinterpret_cast<scm_t_subr>(make_ola_dmx_buffer));
+	scm_c_define_gsubr("set-ola-dmx-buffer!",
+	                   3, 0, 0,
+	                   reinterpret_cast<scm_t_subr>(set_ola_dmx_buffer));
+	scm_c_define_gsubr("ola-dmx-buffers-equal?",
+	                   2, 0, 0,
+	                   reinterpret_cast<scm_t_subr>(ola_dmx_buffers_equal_p));
+
+	name = scm_from_utf8_symbol("OlaStreamingClient");
+	slots = scm_list_1(scm_from_utf8_symbol("data"));
+	streamingclient_type = scm_make_foreign_object_type(name,
+	                                                    slots,
+	                                                    finalize_streamingclient);
+	scm_c_define_gsubr("make-ola-streaming-client",
+	                   0, 0, 0,
+	                   reinterpret_cast<scm_t_subr>(make_ola_streaming_client));
+	scm_c_define_gsubr("send-streaming-dmx-data!",
+	                   3, 0, 0,
+	                   reinterpret_cast<scm_t_subr>(send_streaming_dmx_data));
+
+	scm_add_feature("guile-ola");
+}
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"))
+