;;; Load GIMP Gradients. Kind of. ;;; 2014 (use-modules (ice-9 match) (ice-9 rdelim) (rnrs enums) (srfi srfi-9) (srfi srfi-26)) (define +default-steps+ 1024) ;; returna list of ((#(left-pos r g b) #(right-pos r g b))) ;; ignore alpha, blending function, midpoint... whatever, for now. (define (parse-gradient file-name) (call-with-input-file file-name (lambda (instream) (read-line instream) ; Gimp Gradient (let* ((name (read-line instream)) (segments (string->number (read-line instream)))) (let loop ((next-line (read-line instream)) (segments (list))) (if (eof-object? next-line) (reverse segments) (let ((bits (string-split next-line #\space))) (format #t "bits (~A): ~A~%" (length bits) bits) (match (map string->number bits) ((left-stop mid right-stop lr lg lb la rr rg rb ra blend color) (loop (read-line instream) (cons (list (vector left-stop lr lg lb) #;(vector mid mr mg mb) (vector right-stop rr rg rb)) segments))))))))))) (define (segment->rgb segment total-steps) (match segment ((#(l lr lg lb) #(r rr rg rb)) (linear-blend lr lg lb rr rg rb (inexact->exact (floor (* total-steps (- r l)))))))) (define (segments->rgb segments total-steps) (apply append (map (cut segment->rgb <> total-steps) segments))) (define* (linear-blend r1 g1 b1 r2 g2 b2 steps) (let ((rd (/ (- r2 r1) steps)) (gd (/ (- g2 g1) steps)) (bd (/ (- g2 g1) steps))) (let loop ((remaining steps) (colors (list))) (if (= remaining 0) (reverse colors) (let ((step (- steps remaining))) (loop (1- remaining) (cons (vector (+ r1 (* rd step)) (+ g1 (* gd step)) (+ b1 (* bd step))) colors))))))) (use-modules (ice-9 rdelim) (ice-9 match) (ice-9 receive) (srfi srfi-1) (ice-9 format)) (system "stty -F /dev/ttyACM0 cs8 115200 ignbrk -brkint -icrnl -imaxbel -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke noflsh -ixon -crtscts") (set! *random-state* (random-state-from-platform)) (define out (open-file "/dev/ttyACM0" "w0+")) (define pi 3.14159) (define (deg->rad degrees) (* degrees (/ pi 180))) (define (hsv->rgb h s v) (let* ((chroma (* v s)) (hue' (/ h (/ pi 3))) (x (* chroma (- 1 (abs (- (euclidean-remainder hue' 2) 1))))) (m (- v chroma))) (receive (r₁ g₁ b₁) (case (inexact->exact (floor hue')) ((0) (values chroma x 0)) ((1) (values x chroma 0)) ((2) (values 0 chroma x)) ((3) (values 0 x chroma)) ((4) (values x 0 chroma)) ((5) (values chroma 0 x))) (values (+ r₁ m) (+ g₁ m) (+ b₁ m))))) ;; (define ts (make-termios-struct)) ;; ;; Get the current setings of the serial-device. ;; (tc-get-attr! out ts) ;; (cf-set-speed! ts termios-B9600) ;; (tc-set-attr out ts) (sleep 3) (define tick-increment (/ (* 2 pi) (* 360 1))) (define (random-ticks n) (* tick-increment (random n))) (define last-pulse (car (gettimeofday))) (while #t (for-each (lambda (color) (match color (#(r g b) (let ((r' (inexact->exact (round (* r 255)))) (g' (inexact->exact (round (* g 255)))) (b' (inexact->exact (round (* b 255))))) (format out "~A,~A,~A,0~c" r' g' b' #\return) (format out "~A,~A,~A,1~c" r' g' b' #\return) (usleep 450000))))) (segments->rgb (parse-gradient "/usr/share/gimp/2.0/gradients/Cold_Steel.ggr") 1024)))