;;; Peter Salvi, 2014.12.18.
;;; based (and partly built) on http://whatcolourisit.scn9a.org/

(in-package #:cl-user)

(defpackage #:color-clock
  (:use #:common-lisp #:cl-who #:parenscript))

(in-package #:color-clock)

(with-open-file (s "color-clock.html" :direction :output :if-exists :supersede)
  (with-html-output (s nil :prologue t :indent t)
    (:html
     (:head
      (:title "Color Clock")
      ;; (:link :rel "stylesheet" :type "text/css" :href "color-clock.css")
      (:style "

h1 {
  font-family: 'open sans';
  font-size: 40px;
  font-weight: 300;
}

h2 {
  font-family: 'open sans';
  font-size: 20px;
  font-weight: 300;
}

table {
  position: absolute;
  width: 100%;
  height: 100%;
  top: 0px;
  left: 0px;
}

       ")
      (:script :type "text/javascript" (str (ps 

;;; JavaScript

(defun two-digit (n)
  (+ (if (< n 10) "0" "") n))

(defun zero-pad (n k)
  (if (< (chain n length) k)
      (zero-pad (+ 0 n))
      n))

(defun rgb-to-hex (r g b)
  (flet ((pad (z)
           (zero-pad (chain (*math.round (* z 255))
                            (to-string 16))
                     2)))
    (+ "#" (pad r) (pad g) (pad b))))

(defun hsv-to-rgb (h s v)
  (let* ((i (*math.floor (* h 6)))
         (f (- (* h 6) i))
         (p (* v (- 1 s)))
         (q (* v (- 1 (* f s))))
         (u (* v (- 1 (* (- 1 f) s))))
         (m (% i 6))
         (r (elt (list v q p p u v) m))
         (g (elt (list u v v q p p) m))
         (b (elt (list p p u v v q) m)))
    (rgb-to-hex r g b)))

(defun compute-color (h m s)
  (let ((hi (/ h 24))
        (mi (/ m 60))
        (si (/ s 60)))
    (hsv-to-rgb hi si mi)))

(defun invert-color (c)
  (+ "#" (zero-pad (chain (- "0xffffff" (+ "0x" (chain c (slice 1))))
                          (to-string 16))
                   6)))

(defun init ()
  (let* ((d (new (*date)))
         (hours (chain d (get-hours)))
         (mins (chain d (get-minutes)))
         (secs (chain d (get-seconds)))
         (time (+ (two-digit hours) " : " (two-digit mins) " : " (two-digit secs)))
         (bg-color (compute-color hours mins secs))
         (fg-color (invert-color bg-color)))
    (setf (chain document (get-element-by-id "t") inner-h-t-m-l) time
          (chain document (get-element-by-id "t") style color) fg-color
          (chain document (get-element-by-id "h") inner-h-t-m-l) bg-color
          (chain document (get-element-by-id "h") style color) fg-color
          (chain document body style background) bg-color))
  (set-timeout (lambda () (init)) 500))))))

;;; HTML
     (:body :onload (ps (init))
      (:table
       (:td :height "100%" :width "100%" :align "center" :valign "middle"
        (:h1 :id "t")
        (:h2 :id "h")))
      (:noscript "You need JavaScript to view this page.")))))