From 7c093890069633f93d6641b9297af22aafd068d9 Mon Sep 17 00:00:00 2001
From: Thomas White <taw@physics.org>
Date: Sun, 26 Jul 2020 21:17:30 +0200
Subject: Add effects

---
 guile/starlet/base.scm    | 38 ++++++++++++++++++++++++++++----------
 guile/starlet/effects.scm | 16 ++++++++++++++++
 2 files changed, 44 insertions(+), 10 deletions(-)
 create mode 100644 guile/starlet/effects.scm

diff --git a/guile/starlet/base.scm b/guile/starlet/base.scm
index 4e9afd5..fff9ef7 100644
--- a/guile/starlet/base.scm
+++ b/guile/starlet/base.scm
@@ -205,7 +205,7 @@
                           (set-in-state! combined-state
                                          fix
                                          attr
-                                         (merge-rule current-value value))
+                                         (wrap-merge merge-rule current-value value))
                           (set-in-state! combined-state
                                          fix
                                          attr
@@ -213,22 +213,32 @@
                  new))
 
 
-(define (merge-rule-ltp a b) b)
+(define (value->number val time)
+  (if (procedure? val)
+      (val time)
+      val))
+
+
+(define (wrap-merge merge-rule a b)
+  (lambda (time)
+    (merge-rule (value->number a time)
+                (value->number b time))))
+
+
+(define (merge-rule-ltp a b)
+  b)
 
 (define (merge-rule-htp a b)
-  (if (> a b)
-      a
-      b))
+  (max a b))
 
 
 ;; Combine states
 (define (merge-states merge-rule list-of-workspaces)
   (let ((combined-state (make <starlet-state>)))
     (for-each (lambda (workspace)
-                (add-state-to-state
-                 merge-rule
-                 workspace
-                 combined-state))
+                (add-state-to-state merge-rule
+                                    workspace
+                                    combined-state))
               list-of-workspaces)
     combined-state))
 
@@ -257,6 +267,14 @@
                           "&d="
                           (bytevec->string (cdr universe)))))
 
+
+(define (hirestime)
+  (let ((a (gettimeofday)))
+    (+ (car a)
+       (/ (cdr a)
+          1000000))))
+
+
 (define (start-ola-output)
   (letrec* ((ola-uri (build-uri 'http
                                 #:host "127.0.0.1"
@@ -292,7 +310,7 @@
                             (let ((trans (get-attr-translator attr)))
                               (trans (get-fixture-universe fix)
                                      (get-fixture-addr fix)
-                                     value
+                                     (value->number value (hirestime))
                                      set-dmx)))
 
                           (merge-states merge-rule-htp
diff --git a/guile/starlet/effects.scm b/guile/starlet/effects.scm
new file mode 100644
index 0000000..d908a52
--- /dev/null
+++ b/guile/starlet/effects.scm
@@ -0,0 +1,16 @@
+(define-module (starlet effects)
+  #:use-module (starlet base)
+  #:export (flash))
+
+
+(define pi (* 2 (acos 0)))
+
+(define (square-wave time hz)
+  (if (> (sin (* 2 pi hz time))
+         0)
+      100
+      0))
+
+(define (flash hz)
+  (lambda (time)
+    (square-wave time hz)))
-- 
cgit v1.2.3