minidsp-lcd-monitor: clear entire line when displaying preset/input

[clinton/scratch.git] / fade4.scm

;;; 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)))