Version 1.102 (other changes not in last commit)

[kmrcl.git] / color.lisp

diff --git a/color.lisp b/color.lisp
index b18bd2d00df115ff22f15408165e38426e0549b1..aa3caae12edab769d516174af2315dcb3759f6eb 100644 (file)
--- a/color.lisp
+++ b/color.lisp
@@ -1,4 +1,4 @@
-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
 ;;;; *************************************************************************
 ;;;; FILE IDENTIFICATION
 ;;;;
@@ -7,8 +7,6 @@
 ;;;; Programmer:    Kevin M. Rosenberg
 ;;;; Date Started:  Oct 2003
 ;;;;
-;;;; $Id$
-;;;;
 ;;;; This file, part of KMRCL, is Copyright (c) 2002-2003 by Kevin M. Rosenberg
 ;;;;
 ;;;; KMRCL users are granted the rights to distribute and use this software
@@ -143,14 +141,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 +165,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)))