`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.
(rnrs io ports)
(srfi srfi-1)
(srfi srfi-4)
(rnrs io ports)
(srfi srfi-1)
(srfi srfi-4)
;;; 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")
;;; 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))
(set! *random-state* (random-state-from-platform))
(define serial-lock (make-mutex))
(define pi 3.141592653589793)
(define serial-lock (make-mutex))
(define pi 3.141592653589793)
(define (deg->rad degrees)
(* degrees (/ pi 180)))
(define (deg->rad degrees)
(* degrees (/ pi 180)))
(values (+ r₁ m) (+ g₁ m) (+ b₁ m)))))
(define (set-led-color/primitive! r g b)
(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)
(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)))
(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)))
-(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)))
(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
;;; Multi-processing is for hep cats
(kill-fx))
(set! running-fx (make-thread 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)
(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"))))
(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 (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))))))
+
+