Automated commit for debian release 1.99-1

[kmrcl.git] / color.lisp

diff --git a/color.lisp b/color.lisp
index b18bd2d00df115ff22f15408165e38426e0549b1..52d5b46f1fd5c4b13ea366073bee62300e94c9f4 100644 (file)
--- a/color.lisp
+++ b/color.lisp
@@ -143,14 +143,10 @@
       (setq s (/ delta max)))
 
     (when (plusp delta)
-      (setq h (cond
-               ((= max r)
-                (nth-value 0 (/ (- g b) delta)))
-               ((= max g)
-                (nth-value 0 (+ 2 (/ (- b r) delta))))
-               (t
-                (nth-value 0 (+ 4 (/ (- r g) delta))))))
-      (setq h (the fixnum (* 60 h)))
+      (setq h (* 60  (cond
+                       ((= max r) (/ (- g b) delta))
+                       ((= max g) (+ 2 (/ (- b r) delta)))
+                       (t (+ 4 (/ (- r g) delta))))))
       (when (minusp h)
         (incf h 360)))
 
@@ -171,18 +167,18 @@
              (type (or null fixnum) h))
 
     (when (plusp max)
-      (setq s (truncate (the fixnum (* 255 delta)) max)))
+      (setq s (round (the fixnum (* 255 delta)) max)))
 
     (when (plusp delta)
       (setq h (cond
                ((= max r)
-                (truncate (the fixnum (* 60 (the fixnum (- g b)))) delta))
+                (round (the fixnum (* 60 (the fixnum (- g b)))) delta))
                ((= max g)
                 (the fixnum
-                     (+ 120 (truncate (the fixnum (* 60 (the fixnum (- b r)))) delta))))
+                     (+ 120 (round (the fixnum (* 60 (the fixnum (- b r)))) delta))))
                (t
                 (the fixnum
-                     (+ 240 (truncate (the fixnum (* 60 (the fixnum (- r g)))) delta))))))
+                     (+ 240 (round (the fixnum (* 60 (the fixnum (- r g)))) delta))))))
       (when (minusp h)
         (incf h 360)))