minidsp-lcd-monitor: clear entire line when displaying preset/input

[clinton/scratch.git] / led-controller.scm

diff --git a/led-controller.scm b/led-controller.scm
index a417fe2..fa75278 100644 (file)
--- a/led-controller.scm
+++ b/led-controller.scm
@@ -22,6 +22,7 @@
             (rnrs io ports)
             (srfi srfi-1)
             (srfi srfi-4)
+            (srfi srfi-26)
              (ice-9 format)
 
 
@@ -32,7 +33,8 @@
 
 ;;; stty is less of a pain, just be evil and system
 (system "stty -F /dev/ttyACM0 cs8 115200 ignbrk -brkint -icrnl -imaxbel -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke noflsh -ixon -crtscts")
-(sleep 3) ; wait for arduino to finish booting
+(set-current-error-port (open-file "/tmp/led.log" "w0"))
+(sleep 1) ; wait for arduino to finish booting
 
 (set! *random-state* (random-state-from-platform))
 
@@ -46,6 +48,7 @@
 (define serial-lock (make-mutex))
 
 (define pi 3.141592653589793)
+(define tau (* 2 pi))
 
 (define (deg->rad degrees)
   (* degrees (/ pi 180)))
@@ -67,53 +70,42 @@
       (values (+ r₁ m) (+ g₁ m) (+ b₁ m)))))
 
 (define (set-led-color/primitive! r g b)
-  ;; if put-bytevector is not atomic, may need to have a writer thread
-  (with-mutex serial-lock
-             (put-bytevector serial-out (u8vector r g b))
-             (read-line serial-in 'concat)))
+  (call-with-blocked-asyncs (lambda ()
+                             (with-mutex serial-lock
+                               (format serial-out "~A,~A,~A~c" r g b #\return)
+                               (read-line serial-in 'concat)))))
 
 (define (set-led-hsv! h s v)
   (with-mutex color-lock
              (set! current-color (vector h s v))
              (receive (r g b)
                       (hsv->rgb h s v)
-                      (let ((r' (inexact->exact (truncate (* (* r 1) 255))))
-                            (g' (inexact->exact (truncate (* (* g 1) 255))))
-                            (b' (inexact->exact (truncate (* (* b 1) 255)))))
+                      (let ((r' (inexact->exact (truncate (* (* r 1) pwm-resolution))))
+                            (g' (inexact->exact (truncate (* (* g 1) pwm-resolution))))
+                            (b' (inexact->exact (truncate (* (* b 1) pwm-resolution)))))
                         (set-led-color/primitive! r' g' b')))))
 
 (define zzz (if (and (> (length (command-line)) 1)
                     (number? (string->number (second (command-line)))))
                (string->number (second (command-line)))
-               45000))
+               4500))
 
 (display (command-line))
 
-(let ((zone-out (format #f "hey man i'm getting zzzzzzzzzzooooned out ~A~%" zzz)))
+#;(let ((zone-out (format #f "hey man i'm getting zzzzzzzzzzooooned out ~A~%" zzz)))
   (display zone-out)
   (system (format #f "echo \"~A\" | festival --tts" zone-out)))
 
-(define tick-increment (/ (* 2 pi) (* 360 10)))
-
-(define (random-ticks n) (* tick-increment (random n)))
-
-(define (hsv-fade)
-  (let loop ()
-    (with-mutex color-lock
-               (match current-color
-                      (#(h s v)
-                       (let ((h (euclidean-remainder (+ h tick-increment) (* 2 pi))))
-                         (display (set-led-hsv! h s v) (current-error-port))))))
-    (usleep zzz)
-    (loop))
-  
-#;
-  (let loop ((tick 0))
-    (let ((h (euclidean-remainder tick (* 2 pi))))
-      (display (set-led-hsv! h 1.0 1.0) (current-error-port))
-      (usleep zzz)
-      (loop (+ tick-increment tick)))))
-
+(define (rgb-test)
+  (letrec ((loop (lambda (i fn)
+                  (cond ((= i pwm-resolution) #t)
+                        (else (display (fn i))
+                              (usleep zzz)
+                              (loop (1+ i) fn))))))
+    (while #t
+          (loop 0 (cut set-led-color/primitive! <> 0 0))
+          (loop 0 (cut set-led-color/primitive! 0 <> 0))
+          (loop 0 (cut set-led-color/primitive! 0 0 <>)))))
 
 ;;; Multi-processing is for hep cats
 
@@ -129,10 +121,6 @@
     (kill-fx))
   (set! running-fx (make-thread fx)))
 
-(define (reverse-tick!)
-  (set! tick-increment (- tick-increment)))
-
-
 (define (led-command-handler request body)
   (match (split-and-decode-uri-path (uri-path (request-uri request)))
     (("set" "rgb" r g b)
@@ -156,7 +144,31 @@
      (values '((content-type . (text/plain)))
               "luser\n"))))
 
-(set-current-error-port (open-file "/tmp/led.log" "w0"))
+
 
 (define (start-led-server)
   (set! server-thread (make-thread (lambda ()  (run-server led-command-handler 'http '(#:port 58080))))))
+
+(define (current-time/usec)
+  (let ((now (gettimeofday)))
+    (+ (* (car now) (expt 10 6)) (cdr now))))
+
+(define (fx-driver fx)
+  (let loop ((t (current-time/usec))
+            (dt 0))
+    ;; We live a moment in the past
+    (receive (h s v)
+       (fx t dt)
+      (display (set-led-hsv! h s v) (current-error-port)))
+    (let ((now (current-time/usec)))
+      (loop now (- now t)))))
+
+(define (hsv-fx t dt)
+  (define tick-increment (/ (deg->rad 1280) (expt 10 6)))
+  (with-mutex color-lock
+             (match current-color
+               (#(h s v)
+                (let ((h (euclidean-remainder (+ h (* tick-increment dt)) tau)))
+                  (values h s v))))))
+
+