r11859: Canonicalize whitespace
[kmrcl.git] / color.lisp
index 77741f2afbded1864452ed404f4aeb2b512e9ffe..b18bd2d00df115ff22f15408165e38426e0549b1 100644 (file)
@@ -32,7 +32,7 @@
 ;; point in the plane. The disks on the right show this for various
 ;; values.
 
 ;; 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)))
   (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))
          (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))
   (let ((h-pos (/ h 60)))
     (multiple-value-bind (h-int h-frac) (truncate h-pos)
       (declare (fixnum h-int))
             (q (* v (- 1 (* s h-frac))))
             (t_ (* v (- 1 (* s (- 1 h-frac)))))
             r g b)
             (q (* v (- 1 (* s h-frac))))
             (t_ (* v (- 1 (* s (- 1 h-frac)))))
             r g b)
-        
+
         (cond
          ((zerop h-int)
           (setf r v
         (cond
          ((zerop h-int)
           (setf r v
-                g t_  
+                g t_
                 b p))
          ((= 1 h-int)
           (setf r q
                 b p))
          ((= 1 h-int)
           (setf r q
@@ -78,7 +78,7 @@
         (values r g b)))))
 
 
         (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)
   (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))
       (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))
     (let ((h-pos (/ h 60)))
       (multiple-value-bind (h-int h-frac) (truncate h-pos)
         (declare (fixnum h-int))
                (q (round (* 255 fv (- 1 (* fs h-frac)))))
                (t_ (round (* 255 fv (- 1 (* fs (- 1 h-frac))))))
                r g b)
                (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
           (cond
            ((zerop h-int)
             (setf r v
-                  g t_  
+                  g t_
                   b p))
            ((= 1 h-int)
             (setf r q
                   b p))
            ((= 1 h-int)
             (setf r q
 
 (defun rgb->hsv (r g b)
   (declare (optimize (speed 3) (safety 0)))
 
 (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))
   (let* ((min (min r g b))
          (max (max r g b))
          (delta (- max min))
       (setq h (the fixnum (* 60 h)))
       (when (minusp h)
         (incf h 360)))
       (setq h (the fixnum (* 60 h)))
       (when (minusp h)
         (incf h 360)))
-    
+
     (values h s v)))
 
 (defun rgb255->hsv255 (r g b)
     (values h s v)))
 
 (defun rgb255->hsv255 (r g b)
          (h nil))
     (declare (fixnum min max delta v s)
              (type (or null fixnum) h))
          (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)))
 
     (when (plusp max)
       (setq s (truncate (the fixnum (* 255 delta)) max)))
 
                      (+ 240 (truncate (the fixnum (* 60 (the fixnum (- r g)))) delta))))))
       (when (minusp h)
         (incf h 360)))
                      (+ 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)
     (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))
             ((and (null a) (null b))
              t)
             ((or (null a) (null b))
            (optimize (speed 3) (safety 0) (space 0) (compilation-speed 0)))
   (flet ((~= (a b)
            (declare (type (or null fixnum) a b))
            (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))
             ((and (null a) (null b))
              t)
             ((or (null a) (null b))
       (when (~= h1 h2) (~= s1 s2) (~= v1 v2)
         t)))))
 
       (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."
                        (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."
       t))))
 
 
       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."
                           &key (hue-range 15) (value-range 50) (saturation-range 50)
                           (gray-limit 75) (black-limit 75))
   "Returns T if two HSV values are similar."
       t))))
 
 
       t))))
 
 
-   
+
 (defun hue-difference (h1 h2)
   "Return difference between two hues around 360 degree circle"
   (cond
 (defun hue-difference (h1 h2)
   "Return difference between two hues around 360 degree circle"
   (cond
         (- (- 360 diff)))
        (t
         diff))))))
         (- (- 360 diff)))
        (t
         diff))))))
-  
+
+
 (defun hue-difference-fixnum (h1 h2)
   "Return difference between two hues around 360 degree circle"
   (cond
 (defun hue-difference-fixnum (h1 h2)
   "Return difference between two hues around 360 degree circle"
   (cond
           (- (- 360 diff)))
          (t
           diff)))))))
           (- (- 360 diff)))
          (t
           diff)))))))
+