X-Git-Url: http://git.kpe.io/?p=kmrcl.git;a=blobdiff_plain;f=color.lisp;h=b18bd2d00df115ff22f15408165e38426e0549b1;hp=77741f2afbded1864452ed404f4aeb2b512e9ffe;hb=03712fbb06acbb103602bae10f41aeae7fa05127;hpb=739b14ee8844dc777b174105646df3abcb865282

diff --git a/color.lisp b/color.lisp
index 77741f2..b18bd2d 100644
--- a/color.lisp
+++ b/color.lisp
@@ -32,7 +32,7 @@
 ;; point in the plane. The disks on the right show this for various
 ;; values.
 
-(defun hsv->rgb (h s v) 
+(defun hsv->rgb (h s v)
   (declare (optimize (speed 3) (safety 0)))
   (when (zerop s)
     (return-from hsv->rgb (values v v v)))
@@ -41,7 +41,7 @@
          (incf h 360))
   (while (>= h 360)
          (decf h 360))
-  
+
   (let ((h-pos (/ h 60)))
     (multiple-value-bind (h-int h-frac) (truncate h-pos)
       (declare (fixnum h-int))
@@ -49,11 +49,11 @@
             (q (* v (- 1 (* s h-frac))))
             (t_ (* v (- 1 (* s (- 1 h-frac)))))
             r g b)
-        
+
         (cond
          ((zerop h-int)
           (setf r v
-                g t_  
+                g t_
                 b p))
          ((= 1 h-int)
           (setf r q
@@ -78,7 +78,7 @@
         (values r g b)))))
 
 
-(defun hsv255->rgb255 (h s v) 
+(defun hsv255->rgb255 (h s v)
   (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))
 
   (when (zerop s)
@@ -89,7 +89,7 @@
       (incf h 360))
     (while (>= h 360)
       (decf h 360))
-    
+
     (let ((h-pos (/ h 60)))
       (multiple-value-bind (h-int h-frac) (truncate h-pos)
         (declare (fixnum h-int))
@@ -99,11 +99,11 @@
                (q (round (* 255 fv (- 1 (* fs h-frac)))))
                (t_ (round (* 255 fv (- 1 (* fs (- 1 h-frac))))))
                r g b)
-          
+
           (cond
            ((zerop h-int)
             (setf r v
-                  g t_  
+                  g t_
                   b p))
            ((= 1 h-int)
             (setf r q
@@ -131,7 +131,7 @@
 
 (defun rgb->hsv (r g b)
   (declare (optimize (speed 3) (safety 0)))
-  
+
   (let* ((min (min r g b))
          (max (max r g b))
          (delta (- max min))
@@ -153,7 +153,7 @@
       (setq h (the fixnum (* 60 h)))
       (when (minusp h)
         (incf h 360)))
-    
+
     (values h s v)))
 
 (defun rgb255->hsv255 (r g b)
@@ -169,7 +169,7 @@
          (h nil))
     (declare (fixnum min max delta v s)
              (type (or null fixnum) h))
-    
+
     (when (plusp max)
       (setq s (truncate (the fixnum (* 255 delta)) max)))
 
@@ -185,14 +185,14 @@
                      (+ 240 (truncate (the fixnum (* 60 (the fixnum (- r g)))) delta))))))
       (when (minusp h)
         (incf h 360)))
-    
+
     (values h s v)))
 
 
 (defun hsv-equal (h1 s1 v1 h2 s2 v2 &key (limit .001))
   (declare (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))
   (flet ((~= (a b)
-           (cond 
+           (cond
             ((and (null a) (null b))
              t)
             ((or (null a) (null b))
@@ -215,7 +215,7 @@
            (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))
   (flet ((~= (a b)
            (declare (type (or null fixnum) a b))
-           (cond 
+           (cond
             ((and (null a) (null b))
              t)
             ((or (null a) (null b))
@@ -232,7 +232,7 @@
       (when (~= h1 h2) (~= s1 s2) (~= v1 v2)
         t)))))
 
-(defun hsv-similar (h1 s1 v1 h2 s2 v2 &key 
+(defun hsv-similar (h1 s1 v1 h2 s2 v2 &key
                        (hue-range 15) (value-range .2) (saturation-range 0.2)
                        (gray-limit 0.3) (black-limit 0.3))
   "Returns T if two HSV values are similar."
@@ -251,7 +251,7 @@
       t))))
 
 
-(defun hsv255-similar (h1 s1 v1 h2 s2 v2 
+(defun hsv255-similar (h1 s1 v1 h2 s2 v2
                           &key (hue-range 15) (value-range 50) (saturation-range 50)
                           (gray-limit 75) (black-limit 75))
   "Returns T if two HSV values are similar."
@@ -274,7 +274,7 @@
       t))))
 
 
-   
+
 (defun hue-difference (h1 h2)
   "Return difference between two hues around 360 degree circle"
   (cond
@@ -292,8 +292,8 @@
         (- (- 360 diff)))
        (t
         diff))))))
- 
-  
+
+
 (defun hue-difference-fixnum (h1 h2)
   "Return difference between two hues around 360 degree circle"
   (cond
@@ -312,4 +312,4 @@
           (- (- 360 diff)))
          (t
           diff)))))))
- 
+