led controller: port to teensy 3.1
[clinton/scratch.git] / fade4.scm
CommitLineData
fa726f85
CE
1;;; Load GIMP Gradients. Kind of.
2;;; 2014
3
4(use-modules (ice-9 match)
5 (ice-9 rdelim)
6
7 (rnrs enums)
8 (srfi srfi-9)
9 (srfi srfi-26))
10
11(define +default-steps+ 1024)
12
13
14;; returna list of ((#(left-pos r g b) #(right-pos r g b)))
15;; ignore alpha, blending function, midpoint... whatever, for now.
16(define (parse-gradient file-name)
17 (call-with-input-file file-name
18 (lambda (instream)
19 (read-line instream) ; Gimp Gradient
20 (let* ((name (read-line instream))
21 (segments (string->number (read-line instream))))
22 (let loop ((next-line (read-line instream))
23 (segments (list)))
24 (if (eof-object? next-line)
25 (reverse segments)
26 (let ((bits (string-split next-line #\space)))
27 (format #t "bits (~A): ~A~%" (length bits) bits)
28 (match (map string->number bits)
29 ((left-stop mid right-stop lr lg lb la rr rg rb ra blend color)
30 (loop (read-line instream)
31 (cons (list (vector left-stop lr lg lb)
32 #;(vector mid mr mg mb)
33 (vector right-stop rr rg rb))
34 segments)))))))))))
35
36(define (segment->rgb segment total-steps)
37 (match segment
38 ((#(l lr lg lb) #(r rr rg rb))
39 (linear-blend lr lg lb rr rg rb
40 (inexact->exact (floor (* total-steps (- r l))))))))
41
42(define (segments->rgb segments total-steps)
43 (apply append (map (cut segment->rgb <> total-steps) segments)))
44
45(define* (linear-blend r1 g1 b1 r2 g2 b2 steps)
46 (let ((rd (/ (- r2 r1) steps))
47 (gd (/ (- g2 g1) steps))
48 (bd (/ (- g2 g1) steps)))
49 (let loop ((remaining steps)
50 (colors (list)))
51 (if (= remaining 0)
52 (reverse colors)
53 (let ((step (- steps remaining)))
54 (loop (1- remaining)
55 (cons (vector (+ r1 (* rd step))
56 (+ g1 (* gd step))
57 (+ b1 (* bd step)))
58 colors)))))))
59
60
61(use-modules (ice-9 rdelim)
62 (ice-9 match)
63 (ice-9 receive)
64 (srfi srfi-1)
65 (ice-9 format))
66
67(system "stty -F /dev/ttyACM0 cs8 115200 ignbrk -brkint -icrnl -imaxbel -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke noflsh -ixon -crtscts")
68
69(set! *random-state* (random-state-from-platform))
70
71(define out (open-file "/dev/ttyACM0" "w0+"))
72
73(define pi 3.14159)
74
75(define (deg->rad degrees)
76 (* degrees (/ pi 180)))
77
78(define (hsv->rgb h s v)
79 (let* ((chroma (* v s))
80 (hue' (/ h (/ pi 3)))
81 (x (* chroma (- 1 (abs (- (euclidean-remainder hue' 2) 1)))))
82 (m (- v chroma)))
83 (receive (r₁ g₁ b₁)
84 (case (inexact->exact (floor hue'))
85 ((0) (values chroma x 0))
86 ((1) (values x chroma 0))
87 ((2) (values 0 chroma x))
88 ((3) (values 0 x chroma))
89 ((4) (values x 0 chroma))
90 ((5) (values chroma 0 x)))
91 (values (+ r₁ m) (+ g₁ m) (+ b₁ m)))))
92
93;; (define ts (make-termios-struct))
94;; ;; Get the current setings of the serial-device.
95;; (tc-get-attr! out ts)
96;; (cf-set-speed! ts termios-B9600)
97;; (tc-set-attr out ts)
98
99(sleep 3)
100
101(define tick-increment (/ (* 2 pi) (* 360 1)))
102
103(define (random-ticks n) (* tick-increment (random n)))
104
105(define last-pulse (car (gettimeofday)))
106
107
108(while #t
109 (for-each (lambda (color)
110 (match color
111 (#(r g b)
112 (let ((r' (inexact->exact (round (* r 255))))
113 (g' (inexact->exact (round (* g 255))))
114 (b' (inexact->exact (round (* b 255)))))
115 (format out "~A,~A,~A,0~c" r' g' b' #\return)
116 (format out "~A,~A,~A,1~c" r' g' b' #\return)
117 (usleep 450000)))))
118 (segments->rgb (parse-gradient "/usr/share/gimp/2.0/gradients/Cold_Steel.ggr") 1024)))