虹色zone

zone-pgm-rainbow

;; zone-pgm-rainbow

(defun decimal->hex  (n)
  (format "%02X" n))

(defun hsv->rgb (h s v)
  (let ((h (max 0 (min 360 h)))
        (s (/ (max 0 (min 100 s)) 100.0))
        (v (/ (max 0 (min 100 v)) 100.0)))
    (if (= 0 s)
        (list (round v) (round v) (round v))
      (let* ((h (/ h 60.0))
            (i (floor h))
            (f (- h i))
            (p (* v (- 1 s)))
            (q (* v (- 1 (* s f))))
            (tt (* v (- 1 (* s (- 1 f))))))
        (cond
         ((= (floor i) 0) (list v tt p))
         ((= (floor i) 1) (list q v p))
         ((= (floor i) 2) (list p v tt))
         ((= (floor i) 3) (list p q v))
         ((= (floor i) 4) (list tt p v))
         ((= (floor i) 5) (list v p q)))))))

(defun html-hsv-color (h s v)
  (let ((color (to255-color (hsv->rgb h s v))))
    (format "#%s%s%s"
            (decimal->hex (car color))
            (decimal->hex (cadr color))
            (decimal->hex (caddr color)))))

(defun to255-color (color)
  (list (floor (* 255 (car color)))
        (floor (* 255 (cadr color)))
        (floor (* 255 (caddr color)))))

(defun zone-pgm-rainbow ()
  (let ((k 0))
    (while (not (input-pending-p))
      (dotimes (i (- (point-max) 2))
        (add-text-properties (1+ i) (+ 2 i) `(face ((foreground-color . ,(html-hsv-color (* 10 (% (+ i k) 36)) 70 70))))))
      (setq k (+ 1 k))
      (sit-for 0.2))))

(defun zone-choose (pgm)
  "Choose a PGM to run for `zone'."
  (interactive
   (list
    (completing-read
     "Program: "
     (mapcar 'symbol-name zone-programs))))
  (let ((zone-programs (list (intern pgm))))
    (zone)))


;(zone-choose "zone-pgm-rainbow")