From: Clinton Ebadi <clinton@unknownlamer.org>
Date: Wed, 26 Nov 2014 00:57:12 +0000 (-0500)
Subject: led-controller: improve driver loop
X-Git-Url: http://git.hcoop.net/clinton/scratch.git/commitdiff_plain/87f0622b1a3c2c33cc9c45d3bdb7023b5a5f3452?ds=sidebyside

led-controller: improve driver loop

`fx-driver' runs an fx function, passing time + delta time. Updated
simple hsv loop to run from `fx-driver'.

Miscellaneous code cleanup. Define tau, move all initialization to the
top of the program, kill some dead code. Defer delivery of interrupts
while communicating with the serial device.
---

diff --git a/led-controller.scm b/led-controller.scm
index a417fe2..fa75278 100644
--- 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))))))
+
+