--- /dev/null
+;;; Led Controller,
+;;; Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>
+
+;;; This program is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published by
+;;; the Free Software Foundation, either version 3 of the License, or
+;;; (at your option) any later version.
+
+;;; This program is distributed in the hope that it will be useful,
+;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+;;; GNU General Public License for more details.
+
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program. If not, see <http://www.gnu.org/licenses/>.
+
+(use-modules (ice-9 getopt-long)
+ (ice-9 rdelim)
+ (ice-9 match)
+ (ice-9 receive)
+ (ice-9 threads)
+ (rnrs io ports)
+ (srfi srfi-1)
+ (srfi srfi-4)
+ (ice-9 format)
+
+
+ (web server)
+ (web request)
+ (web response)
+ (web uri))
+
+;;; 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! *random-state* (random-state-from-platform))
+
+(define serial-out (open-file "/dev/ttyACM0" "w0"))
+(define serial-in (open-file "/dev/ttyACM0" "r"))
+
+(define color-lock (make-mutex 'recursive))
+(define current-color (vector 0.0 1.0 1.0))
+
+(define serial-lock (make-mutex))
+
+(define pi 3.141592653589793)
+
+(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 (truncate 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))
+ (else => (lambda (x) (error "Bad hue" h hue' x))))
+ (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)))
+
+(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)))))
+ (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))
+
+(display (command-line))
+
+(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)))))
+
+
+;;; Multi-processing is for hep cats
+
+(define running-fx #f)
+(define server-thread #f)
+
+(define (kill-fx)
+ (with-mutex serial-lock
+ (cancel-thread running-fx)))
+
+(define (run-fx fx)
+ (when running-fx
+ (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)
+ (set-led-color/primitive! (string->number r)
+ (string->number g)
+ (string->number b))
+ (display "Set rgb\n")
+ (values '((content-type . (text/plain)))
+ "rad\n"))
+ (("set" "hsv" h s v)
+ (set-led-hsv! (string->number h )
+ (string->number s)
+ (string->number v))
+ (display "Set hsv\n")
+ (values '((content-type . (text/plain)))
+ "rad\n"))
+ (("fx" "kill") (kill-fx))
+ (("fx" "run" "hsv-fade") (run-fx hsv-fade))
+ (_
+ (display "nada\n")
+ (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))))))