;; values.\r
\r
(defun hsv->rgb (h s v) \r
+ (declare (optimize (speed 3) (safety 0)))\r
+ (when (zerop s)\r
+ (return-from hsv->rgb (values v v v)))\r
+\r
(while (minusp h)\r
(incf h 360))\r
- (while (> h 360)\r
+ (while (>= h 360)\r
(decf h 360))\r
\r
- (let (r g b)\r
- (cond\r
- ((< h 120)\r
- (setf r (/ (- 120 h) 60)\r
- g (/ h 60)\r
- b 0))\r
- ((< h 240)\r
- (setf r 0\r
- g (/ (- 240 h) 60)\r
- b (/ (- h 120) 60)))\r
- (t\r
- (setf r (/ (- h 240) 60)\r
- g 0\r
- b (/ (- 360 h) 60))))\r
- (setf r (min r 1)\r
- g (min g 1)\r
- b (min b 1))\r
+ (let ((h-pos (/ h 60))\r
+ r g b)\r
+ (multiple-value-bind (h-int h-frac) (truncate h-pos)\r
+ (declare (fixnum h-int))\r
+ (let ((p (* v (- 1 s)))\r
+ (q (* v (- 1 (* s h-frac))))\r
+ (t_ (* v (- 1 (* s (- 1 h-frac))))))\r
\r
- (values (* (+ 1 (* s r) (- s)) v)\r
- (* (+ 1 (* s g) (- s)) v)\r
- (* (+ 1 (* s b) (- s)) v))))\r
+ (cond\r
+ ((zerop h-int)\r
+ (setf r v\r
+ g t_ \r
+ b p))\r
+ ((= 1 h-int)\r
+ (setf r q\r
+ g v\r
+ b p))\r
+ ((= 2 h-int)\r
+ (setf r p\r
+ g v\r
+ b t_))\r
+ ((= 3 h-int)\r
+ (setf r p\r
+ g q\r
+ b v))\r
+ ((= 4 h-int)\r
+ (setf r t_\r
+ g p\r
+ b v))\r
+ ((= 5 h-int)\r
+ (setf r v\r
+ g p\r
+ b q)))))\r
+ (values r g b)))\r
\r
\r
(defun rgb->hsv (r g b)\r
+ (declare (optimize (speed 3) (safety 0)))\r
\r
(let* ((min (min r g b))\r
(max (max r g b))\r
(delta (- max min))\r
(v max)\r
(s 0)\r
- (h 0))\r
-\r
+ h)\r
+ \r
(when (plusp max)\r
(setq s (/ delta max)))\r
\r
- (when (plusp delta)\r
- (when (and (= max r) (/= max g))\r
- (incf h (/ (- g b) delta)))\r
- (when (and (= max g) (/= max b))\r
- (incf h (+ 2 (/ (- b r) delta))))\r
- (when (and (= max b) (/= max r))\r
- (incf h (+ 4 (/ (- r g) delta))))\r
- (setq h (* 60 h)))\r
+ (cond\r
+ ((zerop delta)\r
+ (setq h nil))\r
+ (t\r
+ (setq h (cond\r
+ ((= max r)\r
+ (/ (- g b) delta))\r
+ ((= max g)\r
+ (+ 2 (/ (- b r) delta)))\r
+ (t\r
+ (+ 4 (/ (- r g) delta)))))\r
+ (setq h (* 60 h))\r
+ (when (minusp h)\r
+ (incf h 360))))\r
\r
(values h s v)))\r
\r
- \r
+\r
+(defun hsv-equal (h1 s1 v1 h2 s2 v2)\r
+ (flet ((~= (a b)\r
+ (cond \r
+ ((and (null a) (null b))\r
+ t)\r
+ ((or (null a) (null b))\r
+ nil)\r
+ (t\r
+ (< (abs (- a b)) 0.000001)))))\r
+ (cond\r
+ ((and (~= 0 v1) (~= 0 v2))\r
+ t)\r
+ ((or (null h1) (null h2))\r
+ (when (and (~= 0 s1) (~= 0 s2) (~= v1 v2))\r
+ t))\r
+ (t\r
+ (when (~= h1 h2) (~= s1 s2) (~= v1 v2)\r
+ t)))))\r
+\r