Experiments in controlling LEDs using Guile + Arduino

[clinton/scratch.git] / fade4.scm

diff --git a/fade4.scm b/fade4.scm
new file mode 100644 (file)
index 0000000..e90718d
--- /dev/null
+++ b/fade4.scm
@@ -0,0 +1,118 @@
+;;; Load GIMP Gradients. Kind of.
+;;; 2014
+
+(use-modules (ice-9 match)
+            (ice-9 rdelim)
+
+            (rnrs enums)
+            (srfi srfi-9)
+            (srfi srfi-26))
+
+(define +default-steps+ 1024)
+
+
+;; returna list of ((#(left-pos r g b) #(right-pos r g b)))
+;; ignore alpha, blending function, midpoint... whatever, for now.
+(define (parse-gradient file-name)
+  (call-with-input-file file-name
+    (lambda (instream)
+      (read-line instream) ; Gimp Gradient
+      (let* ((name (read-line instream))
+            (segments (string->number (read-line instream))))
+       (let loop ((next-line (read-line instream))
+                  (segments (list)))
+         (if (eof-object? next-line)
+             (reverse segments)
+             (let ((bits (string-split next-line #\space)))
+               (format #t "bits (~A): ~A~%" (length bits) bits)
+               (match (map string->number bits)
+                 ((left-stop mid right-stop lr lg lb la rr rg rb ra blend color)
+                  (loop (read-line instream)
+                        (cons (list (vector left-stop lr lg lb)
+                                    #;(vector mid mr mg mb)
+                                    (vector right-stop rr rg rb))
+                              segments)))))))))))
+
+(define (segment->rgb segment total-steps)
+  (match segment
+    ((#(l lr lg lb) #(r rr rg rb))
+     (linear-blend lr lg lb rr rg rb
+                  (inexact->exact (floor (* total-steps (- r l))))))))
+
+(define (segments->rgb segments total-steps)
+  (apply append (map (cut segment->rgb <> total-steps) segments)))
+
+(define* (linear-blend r1 g1 b1 r2 g2 b2 steps)
+  (let ((rd (/ (- r2 r1) steps))
+       (gd (/ (- g2 g1) steps))
+       (bd (/ (- g2 g1) steps)))
+    (let loop ((remaining steps)
+              (colors (list)))
+      (if (= remaining 0)
+         (reverse colors)
+         (let ((step (- steps remaining)))
+           (loop (1- remaining)
+                 (cons (vector (+ r1 (* rd step))
+                               (+ g1 (* gd step))
+                               (+ b1 (* bd step)))
+                       colors)))))))
+
+
+(use-modules (ice-9 rdelim)
+            (ice-9 match)
+            (ice-9 receive)
+            (srfi srfi-1)
+             (ice-9 format))
+
+(system "stty -F /dev/ttyACM0 cs8 115200 ignbrk -brkint -icrnl -imaxbel -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke noflsh -ixon -crtscts")
+
+(set! *random-state* (random-state-from-platform))
+
+(define out (open-file "/dev/ttyACM0" "w0+"))
+
+(define pi 3.14159)
+
+(define (deg->rad degrees)
+  (* degrees (/ pi 180)))
+
+(define (hsv->rgb h s v)
+  (let* ((chroma (* v s))
+        (hue' (/ h (/ pi 3)))
+        (x (* chroma (- 1 (abs (- (euclidean-remainder hue' 2) 1)))))
+        (m (- v chroma)))
+    (receive (r₁ g₁ b₁)
+       (case (inexact->exact (floor hue'))
+         ((0) (values chroma x 0))
+         ((1) (values x chroma 0))
+         ((2) (values 0 chroma x))
+         ((3) (values 0 x chroma))
+         ((4) (values x 0 chroma))
+         ((5) (values chroma 0 x)))
+      (values (+ r₁ m) (+ g₁ m) (+ b₁ m)))))
+
+;; (define ts (make-termios-struct))
+;; ;; Get the current setings of the serial-device.
+;; (tc-get-attr! out ts)
+;; (cf-set-speed! ts termios-B9600)
+;; (tc-set-attr out ts)
+
+(sleep 3)
+
+(define tick-increment (/ (* 2 pi) (* 360 1)))
+
+(define (random-ticks n) (* tick-increment (random n)))
+
+(define last-pulse (car (gettimeofday)))
+
+
+(while #t
+  (for-each (lambda (color)
+             (match color
+               (#(r g b)
+                (let ((r' (inexact->exact (round (* r 255))))
+                      (g' (inexact->exact (round (* g 255))))
+                      (b' (inexact->exact (round (* b 255)))))
+                  (format out "~A,~A,~A,0~c" r' g' b' #\return)
+                  (format out "~A,~A,~A,1~c" r' g' b' #\return)
+                  (usleep 450000)))))
+           (segments->rgb (parse-gradient "/usr/share/gimp/2.0/gradients/Cold_Steel.ggr") 1024)))