Commit | Line | Data |
---|---|---|
fa726f85 CE |
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 |