anchor.diff:      (or (gethash key *color-hash-table*)
   	(setf (gethash key *color-hash-table*)
   	      (make-instance 'named-color :red red :green green :blue blue)))))
  +
  +(defun make-gray-color (intensity)
  +  (make-rgb-color intensity intensity intensity))
   
   (defun make-named-color (name red green blue)
     (let* ((key (compute-color-key red green blue))
  
positive.code:       (subseq +contrasting-colors+ n)
      (aref +contrasting-colors+ k)))
  
  #|
  ;;; I used this function to generate the predefined colors and names - mikemac@mikemac.com
  
  (defun generate-named-colors ()
  
negative.code: 		  (format out "~%           )))~%")
  	     ))))
  
  ||#
  
  ;;;;
  ;;;; 13.4 Opacity
  ;;;;
  
  (define-protocol-class opacity (design))
  
  ;; Note: Though tempting, opacity is not a uniform-design!
  
  (defclass standard-opacity (opacity)
    ((value :initarg :value
            :type (real 0 1)
            :reader opacity-value)))
  
  (defvar +transparent-ink+ 
      (load-time-value (make-instance 'standard-opacity :value 0)))
  
  (defun make-opacity (value)
    (setf value (clamp value 0 1))        ;defensive programming
    (cond ((= value 0)
           +transparent-ink+)
          ((= value 1)
           +foreground-ink+)
          (t
           (make-instance 'standard-opacity :value value))))
  
  ;;;;
  ;;;; 13.6 Indirect Inks
  ;;;;
  
  (defclass indirect-ink (design) ())
  
  (defvar +foreground-ink+ (load-time-value (make-instance 'indirect-ink)))
  (defvar +background-ink+ (load-time-value (make-instance 'indirect-ink)))
  
  (defmethod print-object ((ink (eql +foreground-ink+)) stream)
    (format stream "#.~S" '+foreground-ink+))
  
  (defmethod print-object ((ink (eql +background-ink+)) stream)
    (format stream "#.~S" '+background-ink+))
  
  ;;;;
  ;;;; 13.7 Flipping Ink
  ;;;;
  
  (defclass standard-flipping-ink (design)
    ((design1 :initarg :design1
              :type design)
     (design2 :initarg :design2
              :type design)))
  
  (defvar +flipping-ink+ (load-time-value   (make-instance 'standard-flipping-ink 
                                              :design1 +foreground-ink+
                                              :design2 +background-ink+)))
  
  (defmethod print-object ((ink (eql +flipping-ink+)) stream)
    (format stream "#.~S" '+flipping-ink+))
  
  (defmethod print-object ((flipper standard-flipping-ink) stream)
    (with-slots (design1 design2) flipper
      (print-unreadable-object (flipper stream :identity nil :type t)
        (format stream "~S ~S" design1 design2))))
  
  (defmethod make-flipping-ink ((design1 design) (design2 design))
    (make-instance 'standard-flipping-ink :design1 design1 :design2 :design2))
  
  (defmethod make-flipping-ink ((design1 (eql +foreground-ink+)) 
                                (design2 (eql +background-ink+)))
    +flipping-ink+)
  
  (defmethod make-flipping-ink ((design1 (eql +background-ink+)) 
                                (design2 (eql +foreground-ink+)))
    +flipping-ink+)
  
  ;;;;
  ;;;; 14 General Designs
  ;;;;
  
  (defgeneric compose-over (design1 design2))
  (defgeneric compose-in (ink mask))
  (defgeneric compose-out (ink mask))
  
  (defclass pattern (design)
    ((array :initarg :array)
     (designs :initarg :designs)))
     
  (defun make-pattern (array designs)
    (make-instance 'pattern :array array :designs designs))
  
  (defun pattern-width (pattern)
    (nyi))
  
  (defun pattern-height (pattern)
    (nyi))
  
  (defun make-stencil (array)
    (nyi))
  
  (defclass rectangular-tile (design)
    ((width  :initarg :width      :reader rectangular-tile-width)
     (height :initarg :height     :reader rectangular-tile-height)
     (design :initarg :design     :reader rectangular-tile-design)))
  
  (defun make-rectangular-tile (design width height)
    (make-instance 'rectangular-tile
      :width width
      :height height
      :design design))
  