| 1 | (use-modules (ice-9 rdelim) |
| 2 | (ice-9 match) |
| 3 | (ice-9 receive) |
| 4 | (srfi srfi-1) |
| 5 | (ice-9 format)) |
| 6 | |
| 7 | (system "stty -F /dev/ttyACM0 cs8 115200 ignbrk -brkint -icrnl -imaxbel -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke noflsh -ixon -crtscts") |
| 8 | |
| 9 | (set! *random-state* (random-state-from-platform)) |
| 10 | |
| 11 | (define out (open-file "/dev/ttyACM0" "w0+")) |
| 12 | |
| 13 | (define pi 3.14159) |
| 14 | |
| 15 | (define (deg->rad degrees) |
| 16 | (* degrees (/ pi 180))) |
| 17 | |
| 18 | (define (hsv->rgb h s v) |
| 19 | (let* ((chroma (* v s)) |
| 20 | (hue' (/ h (/ pi 3))) |
| 21 | (x (* chroma (- 1 (abs (- (euclidean-remainder hue' 2) 1))))) |
| 22 | (m (- v chroma))) |
| 23 | (receive (r₁ g₁ b₁) |
| 24 | (case (inexact->exact (floor hue')) |
| 25 | ((0) (values chroma x 0)) |
| 26 | ((1) (values x chroma 0)) |
| 27 | ((2) (values 0 chroma x)) |
| 28 | ((3) (values 0 x chroma)) |
| 29 | ((4) (values x 0 chroma)) |
| 30 | ((5) (values chroma 0 x))) |
| 31 | (values (+ r₁ m) (+ g₁ m) (+ b₁ m))))) |
| 32 | |
| 33 | ;; (define ts (make-termios-struct)) |
| 34 | ;; ;; Get the current setings of the serial-device. |
| 35 | ;; (tc-get-attr! out ts) |
| 36 | ;; (cf-set-speed! ts termios-B9600) |
| 37 | ;; (tc-set-attr out ts) |
| 38 | |
| 39 | (sleep 3) |
| 40 | |
| 41 | (define tick-increment (/ (* 2 pi) (* 360 1))) |
| 42 | |
| 43 | (define (random-ticks n) (* tick-increment (random n))) |
| 44 | |
| 45 | (define last-pulse (car (gettimeofday))) |
| 46 | |
| 47 | (let loop ((tick 0) |
| 48 | (saturation 0)) |
| 49 | (format #t "~A " saturation) |
| 50 | (let ((h (euclidean-remainder tick (* 2 pi)))) |
| 51 | (receive (r g b) |
| 52 | (hsv->rgb h (or 0.9 (- 1.0 (* (min saturation 10) 0.1))) 1) |
| 53 | (let ((r' (inexact->exact (round (* r 255)))) |
| 54 | (g' (inexact->exact (round (* g 255)))) |
| 55 | (b' (inexact->exact (round (* b 255))))) |
| 56 | |
| 57 | #; |
| 58 | (format #t "~A ~A ~A -> ~A ~A ~A~%" h 1 1 r' g' b') |
| 59 | (format out "~A,~A,~A,0~c" r' g' b' #\return) |
| 60 | (format out "~A,~A,~A,1~c" r' g' b' #\return) |
| 61 | #;(display (read-line out)))) |
| 62 | (usleep 450000) |
| 63 | (loop (+ tick-increment tick) |
| 64 | (if (> (- (car (gettimeofday)) last-pulse) 1) |
| 65 | (begin (set! last-pulse (car (gettimeofday))) |
| 66 | 8) |
| 67 | (if (= saturation 0) 0 (1- saturation)))))) |
| 68 | |
| 69 | #; |
| 70 | (let loop ((rt (random-ticks 128)) |
| 71 | (bt (random-ticks 128)) |
| 72 | (gt (random-ticks 128))) |
| 73 | (let ((r (inexact->exact (truncate (* 128 (+ 1 (sin rt)))))) |
| 74 | (g (- 256 (inexact->exact (truncate (* 128 (+ 1 (cos gt))))))) |
| 75 | (b (inexact->exact (truncate (* 128 (+ 1 (sin bt))))))) |
| 76 | #;(format #t "~A ~A ~A~%" r g b) |
| 77 | (format out "~A,~A,~A,4~c" r g b #\return) |
| 78 | (display (read-line out)) |
| 79 | (usleep 45000) |
| 80 | (loop (+ rt (* tick-increment (1+ (random 3)))) |
| 81 | (+ gt (* tick-increment (1+ (random 3)))) |
| 82 | (+ bt (* tick-increment (1+ (random 3))))))) |
| 83 | |