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: 
  (in-package :CLIM-INTERNALS)
  
  (eval-when (eval load compile)
  
    (defclass design ()
      ())
    )
  
  (defconstant +foreground-ink+ (make-instance 'design))
  (defconstant +background-ink+ (make-instance 'design))
  (defconstant +flipping-ink+ (make-instance 'design))
  
  ;;; Color class
  
  (defclass color ()
    ((red :initarg :red
  	:initform 0.0)
     (green :initarg :green
  	  :initform 0.0)
     (blue :initarg :blue
  	 :initform 0.0)
     ))
  
  (defun colorp (x)
    (typep x 'color))
  
  (defmethod print-object ((color color) stream)
    (with-slots (red green blue) color
      (print-unreadable-object (color stream :type t :identity t)
        (format stream "~,4F ~,4F ~,4F" red green blue))))
  
  (defclass named-color (color)
    ((name :initarg :name
  	 :initform "Unnamed color")
     ))
  
  (defmethod print-object ((color named-color) stream)
    (with-slots (name) color
      (print-unreadable-object (color stream :type nil :identity t)
        (format stream "COLOR ~S" name))))
  
  (defvar *color-hash-table* (make-hash-table :test #'eql))
  
  
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))
  