(rnrs io ports)
(srfi srfi-1)
(srfi srfi-4)
+ (srfi srfi-26)
(ice-9 format)
;;; 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))
(define serial-lock (make-mutex))
(define pi 3.141592653589793)
+(define tau (* 2 pi))
(define (deg->rad degrees)
(* degrees (/ pi 180)))
(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
(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)
(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))))))
+
+