;;; Led Controller,
;;; Copyright (c) 2014 Clinton Ebadi <clinton@unknownlamer.org>

;;; This program is free software: you can redistribute it and/or modify
;;; it under the terms of the GNU General Public License as published by
;;; the Free Software Foundation, either version 3 of the License, or
;;; (at your option) any later version.

;;; This program is distributed in the hope that it will be useful,
;;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
;;; GNU General Public License for more details.

;;; You should have received a copy of the GNU General Public License
;;; along with this program.  If not, see <http://www.gnu.org/licenses/>.

(use-modules (ice-9 getopt-long)
	     (ice-9 rdelim)
	     (ice-9 match)
	     (ice-9 receive)
	     (ice-9 threads)
	     (rnrs io ports)
	     (srfi srfi-1)
	     (srfi srfi-4)
             (ice-9 format)


	     (web server)
	     (web request)
	     (web response)
	     (web uri))

;;; stty is less of a pain, just be evil and system
(system "stty -F /dev/ttyACM0 cs8 115200 ignbrk -brkint -icrnl -imaxbel -opost -onlcr -isig -icanon -iexten -echo -echoe -echok -echoctl -echoke noflsh -ixon -crtscts")
(sleep 3) ; wait for arduino to finish booting

(set! *random-state* (random-state-from-platform))

(define serial-out (open-file "/dev/ttyACM0" "w0"))
(define serial-in  (open-file "/dev/ttyACM0" "r"))

(define color-lock (make-mutex 'recursive))
(define current-color (vector 0.0 1.0 1.0))

(define serial-lock (make-mutex))

(define pi 3.141592653589793)

(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 (truncate 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))
	  (else => (lambda (x) (error "Bad hue" h hue' x))))
      (values (+ r₁ m) (+ g₁ m) (+ b₁ m)))))

(define (set-led-color/primitive! r g b)
  ;; if put-bytevector is not atomic, may need to have a writer thread
  (with-mutex serial-lock
	      (put-bytevector serial-out (u8vector r g b))
	      (read-line serial-in 'concat)))

(define (set-led-hsv! h s v)
  (with-mutex color-lock
	      (set! current-color (vector h s v))
	      (receive (r g b)
		       (hsv->rgb h s v)
		       (let ((r' (inexact->exact (truncate (* (* r 1) 255))))
			     (g' (inexact->exact (truncate (* (* g 1) 255))))
			     (b' (inexact->exact (truncate (* (* b 1) 255)))))
			 (set-led-color/primitive! r' g' b')))))

(define zzz (if (and (> (length (command-line)) 1)
		     (number? (string->number (second (command-line)))))
		(string->number (second (command-line)))
		45000))

(display (command-line))

(let ((zone-out (format #f "hey man i'm getting zzzzzzzzzzooooned out ~A~%" zzz)))
  (display zone-out)
  (system (format #f "echo \"~A\" | festival --tts" zone-out)))

(define tick-increment (/ (* 2 pi) (* 360 10)))

(define (random-ticks n) (* tick-increment (random n)))

(define (hsv-fade)
  (let loop ()
    (with-mutex color-lock
		(match current-color
		       (#(h s v)
			(let ((h (euclidean-remainder (+ h tick-increment) (* 2 pi))))
			  (display (set-led-hsv! h s v) (current-error-port))))))
    (usleep zzz)
    (loop))
  
#;
  (let loop ((tick 0))
    (let ((h (euclidean-remainder tick (* 2 pi))))
      (display (set-led-hsv! h 1.0 1.0) (current-error-port))
      (usleep zzz)
      (loop (+ tick-increment tick)))))


;;; Multi-processing is for hep cats

(define running-fx #f)
(define server-thread #f)

(define (kill-fx)
  (with-mutex serial-lock
     (cancel-thread running-fx)))

(define (run-fx fx)
  (when running-fx
    (kill-fx))
  (set! running-fx (make-thread fx)))

(define (reverse-tick!)
  (set! tick-increment (- tick-increment)))


(define (led-command-handler request body)
  (match (split-and-decode-uri-path (uri-path (request-uri request)))
    (("set" "rgb" r g b)
     (set-led-color/primitive! (string->number r)
			       (string->number g)
			       (string->number b))
     (display "Set rgb\n")
     (values '((content-type . (text/plain)))
	     "rad\n"))
    (("set" "hsv" h s v)
     (set-led-hsv! (string->number h )
		   (string->number s)
		   (string->number v))
     (display "Set hsv\n")
     (values '((content-type . (text/plain)))
	     "rad\n"))
    (("fx" "kill") (kill-fx))
    (("fx" "run" "hsv-fade") (run-fx hsv-fade))
    (_
     (display "nada\n")
     (values '((content-type . (text/plain)))
	       "luser\n"))))

(set-current-error-port (open-file "/tmp/led.log" "w0"))

(define (start-led-server)
  (set! server-thread (make-thread (lambda ()  (run-server led-command-handler 'http '(#:port 58080))))))