color-picker.lisp

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