anchor.diff:  
   ;;;  (c) copyright 1998,1999,2000 by Michael McDonald (mikemac@mikemac.com)
   ;;;  (c) copyright 2000 by Robert Strandh (strandh@labri.u-bordeaux.fr)
  +;;;  (c) copyright 2002 by Gilbert Baumann <unk6@rz.uni-karlsruhe.de>
   
   ;;; This library is free software; you can redistribute it and/or
   ;;; modify it under the terms of the GNU Library General Public
  
positive.code:     (or (gethash key *color-hash-table*)
  	(setf (gethash key *color-hash-table*)
  	      (make-instance 'named-color :red red :green green :blue blue)))))
  
  (defun make-named-color (name red green blue)
    (let* ((key (compute-color-key red green blue))
  
negative.code: 	  (t (setf (gethash key *color-hash-table*)
  		   (make-instance 'named-color :name name :red red :green green :blue blue))))))
  
  ;;;    ;;; For ihs to rgb conversion, we use the formula 
  ;;;    ;;;  i = (r+g+b)/3
  ;;;    ;;;  s = 1-min(r,g,b)/i
  ;;;    ;;;  h =     60(g-b)/(max(r,g,b)-min(r,g,b)) if r >= g,b
  ;;;    ;;;      120+60(b-r)/(max(r,g,b)-min(r,g,b)) if g >= r,b
  ;;;    ;;;      240+60(r-g)/(max(r,g,b)-min(r,g,b)) if b >= r,g
  ;;;    ;;; First, we introduce colors x, y, z such that x >= y >= z
  ;;;    ;;; We compute x, y, and z and then determine the correspondance
  ;;;    ;;; between x, y, and z on the one hand and r, g, and b on the other. 
  ;;;    (defun make-ihs-color (i h s)
  ;;;      (assert (and (<= 0 i 1)
  ;;;                 (<= 0 s 1)
  ;;;                 (<= 0 h 360)))
  ;;;      (let ((ah (/ (abs (cond ((<= h 60) h)
  ;;;                            ((<= h 180) (- h 120))
  ;;;                            ((<= h 300) (- h 240))
  ;;;                            (t (- h 360))))
  ;;;                 60)))
  ;;;        (let* ((z (* i (- 1 s)))
  ;;;             (y (/ (+ (* ah (- (* 3 i) (* 2 z))) z) (+ 1 ah)))
  ;;;             (x (- (* 3 i) y z)))
  ;;;          (assert (and (<= 0 x 1)
  ;;;                     (<= 0 y 1)
  ;;;                     (<= 0 z 1)))
  ;;;          (cond ((<= h 60) (make-rgb-color x y z))
  ;;;              ((<= h 120) (make-rgb-color y x z))
  ;;;              ((<= h 180) (make-rgb-color z x y))
  ;;;              ((<= h 240) (make-rgb-color z y x))
  ;;;              ((<= h 300) (make-rgb-color y z x))
  ;;;              (t (make-rgb-color x z y))))))
  ;;;    
  ;;;    (defmethod color-ihs ((color color))
  ;;;      (multiple-value-bind (r g b) (color-rgb color)
  ;;;        (let ((max (max r g b))
  ;;;            (min (min r g b))
  ;;;            (intensity (/ (+ r g b) 3)))
  ;;;          (if (= max min)
  ;;;            (values intensity 0 0)
  ;;;            (let* ((saturation (- 1 (/ min intensity)))
  ;;;                   (diff (- max min))
  ;;;                   (hue (* 60 (cond ((= max r) (/ (- g b) diff))
  ;;;                                    ((= max g) (+ 2 (/ (- b r) diff)))
  ;;;                                    (t (+ 4 (/ (- r g) diff)))))))
  ;;;              (when (< hue 0)
  ;;;                (incf hue 360))
  ;;;	    (values intensity hue saturation))))))
  
  ;;;
  ;;; Below is a literal translation from Dylan's DUIM source code,
  ;;; which was itself probably literal translation from some Lisp code.
  ;;;
  
  (defconstant +ihs-rgb-c1+ (sqrt (coerce 1/6 'double-float)))
  (defconstant +ihs-rgb-c2+ (sqrt (coerce 1/2 'double-float)))
  (defconstant +ihs-rgb-c3+ (sqrt (coerce 1/3 'double-float)))
  
  (defun ihs-to-rgb (intensity hue saturation)
    (let* ((hh (- (* (mod (- hue 1/2) 1) 2 pi) pi))
           (c3 (cos saturation))
           (s3 (sin saturation))
           (cos-hh (cos hh))
           (sin-hh (sin hh))
           (x (* +ihs-rgb-c1+ s3 cos-hh intensity))
           (y (* +ihs-rgb-c2+ s3 sin-hh intensity))
           (z (* +ihs-rgb-c3+ c3 intensity)))
      (values (max 0 (min 1 (+ x x z)))
              (max 0 (min 1 (+ y z (- x))))
              (max 0 (min 1 (- z x y))))))
  
  (defun rgb-to-ihs (red green blue)
    (let* ((x (* +ihs-rgb-c1+ (- (* 2 red) blue green)))
           (y (* +ihs-rgb-c2+ (- green blue)))
           (z (* +ihs-rgb-c3+ (+ red green blue)))
           (q (+ (* x x) (* y y)))
           (intensity (sqrt (+ q (* z z))))) ;sqrt(r^2 + g^2 + b^2)
      (if (zerop q)
          ;; A totally unsaturated color
          (values intensity 0 0)
        (let* ((hue (mod (/ (atan y x) (* 2 pi)) 1))
               (f1 (/ z intensity))
               (f2 (sqrt (- 1 (* f1 f1))))
               (saturation (atan f2 f1)))
          (values intensity hue saturation)))))
  
  (defmethod color-ihs ((color color))
    (multiple-value-call #'rgb-to-ihs (color-rgb color)))
  
  (defun make-ihs-color (i h s)
    (multiple-value-call #'make-rgb-color (ihs-to-rgb i h s)))
  
  
  (defun make-contrasting-inks (n &optional k)
    (declare (special +contrasting-colors+))
  