color-picker.lisp

   1 (defun luminance (r g b)
   2   (+ (* r 0.299) (* g 0.587) (* b 0.114)))
   3
   4 (defun std-pick-color-html-fn ()
   5   (flet ((color-td (r g b)
   6            (let ((color (format nil "#~2,'0x~2,'0x~2,'0x" r g b)))
   7              (html ((:td :bgcolor color
   8                          :fformat (:onclick "f42('~a');"
   9                                             color))"&nbsp;&nbsp;&nbsp;")))))
  10     (let* ((colors nil))
  11       (dotimes (r 6)
  12         (dotimes (g 6)
  13           (dotimes (b 6)
  14             (push (list (* r 51) (* g 51) (* b 51)(luminance r g b))
  15                   colors))))
  16       (setf colors (sort colors #'> :key 'fourth))
  17       (html
  18        (:head
  19         (:title "Choose a color")
  20         ((:link :rel "stylesheet" :type "text/css" :href "/pcol.css")))
  21        (:body
  22         :br
  23         (:h1 "Choose a color")
  24         (:jscript "function
  25 f42(d){window.opener.change_color(d);window.close();};")
  26         ((:table :class "pcolt" :align "center")
  27          (loop for x below 18
  28                for row = (loop repeat 12 collect (pop colors))
  29                for bl = (round (* 255 (- 1 (/ x 17))))
  30                do
  31                (html
  32                 (:tr
  33                  (color-td  bl bl bl)
  34                  (color-td  bl  0  0)
  35                  (color-td   0 bl  0)
  36                  (color-td   0  0 bl)
  37                  (color-td   0 bl bl)
  38                  (color-td  bl  0 bl)
  39                  (color-td  bl bl  0)
  40                  (loop for (r g b l) in row
  41                        do (color-td r g b))))))
  42         :br
  43         ((:div :align "center")
  44          ((:a :class "call" :href "javascript:window.close();")
  45           "Close")))))))
  46