-;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10; Package: kmrcl -*-
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*-
;;;; *************************************************************************
;;;; FILE IDENTIFICATION
;;;;
;;;; 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
(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)))
(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)))