anchor.diff:    (declare (ignore medium))
     (color-rgb ink))
   
  -(defun postscript-color (stream medium)
  -  (multiple-value-bind (r g b) (medium-color-rgb medium (medium-ink medium))
  +(defmethod postscript-set-graphics-state (stream medium (kind (eql :color)))
  +  (multiple-value-bind (r g b)
  +      (medium-color-rgb medium (medium-ink medium))
       (format stream "~,3F ~,3F ~,3F setrgbcolor~%" r g b)))
   
   (defun postscript-line-style-and-color (stream medium)
     (postscript-line-style stream medium)
     (postscript-color stream medium))
   
  -(defmacro with-graphics-state ((stream) &body body)
  -  (let ((gstream (gensym)))
  -    `(let ((,gstream ,stream))
  -      (format ,gstream "gsave~%")
  -      ,@body
  -      (format ,gstream "grestore~%"))))
  -
  -(defun format-postscript-number (number)
  -  (if (not (integerp number))
  -      (coerce number 'single-float)
  -      number))
  -
  -(defun format-postscript-angle (angle)
  -  (format-postscript-number (* angle (/ 180 pi))))
  +(defgeneric postscript-set-clipping-region (stream region))
  +
  +(defmethod postscript-set-clipping-region (stream region)
  +  (format stream "newpath~%")
  +  (postscript-add-path stream region)
  +  (format stream "clip~%"))
  +
  +(defmethod postscript-set-clipping-region (stream (region (eql +everywhere+)))
  +  (declare (ignore stream region)))
  +
  +(defmethod postscript-set-clipping-region (stream (region (eql +nowhere+)))
  +  (declare (ignore region))
  +  (format stream "~@
  +newpath
  +0 0 moveto
  +closepath
  +clip
  +"))
  +
  +(defmethod postscript-set-graphics-state (stream medium
  +                                          (kind (eql :clipping-region)))
  +  (postscript-set-clipping-region stream
  +                                  (medium-clipping-region medium)))
  +
  ++
  +;;; Medium drawing functions
  +
  +;;; FIXME: the following methods should share code with POSTSCRIPT-ADD-PATH
   
   (defmethod medium-draw-point* ((medium postscript-medium) x y)
     (let ((stream (postscript-medium-file-stream medium)))
       (with-graphics-state (stream)
  +      (postscript-actualize-graphics-state stream medium :color)
  +      (format stream "newpath~%")
         (format stream "~A ~A ~A 0 360 arc~%"
   	      (format-postscript-number x) (format-postscript-number y)
                 (format-postscript-number
                  (/ (line-style-thickness (medium-line-style medium)) 2)))
         (format stream "0 setlinewidth~%")
  -      (postscript-color stream medium)
         (format stream "fill~%"))))
   
   (defmethod medium-draw-points* ((medium postscript-medium) coord-seq)
     (let ((stream (postscript-medium-file-stream medium)))
       (with-graphics-state (stream)
         (format stream "0 setlinewidth~%")
  -      (postscript-color stream medium)
         (loop with radius = (/ (line-style-thickness (medium-line-style medium)) 2)
   	    for (x y) on coord-seq by #'cddr
   	    do (progn
  +                 (format stream "newpath~%")
   		 (format stream "~A ~A ~A 0 360 arc~%"
                            (format-postscript-number x) (format-postscript-number y)
                            (format-postscript-number radius))
  -		 (format stream "fill~%")
  -		 (format stream "newpath~%"))))))
  +		 (format stream "fill~%"))))))
   
   (defmethod medium-draw-line* ((medium postscript-medium) x1 y1 x2 y2)
     (let ((stream (postscript-medium-file-stream medium)))
       (with-graphics-state (stream)
  -      (postscript-line-style-and-color stream medium)
  +      (postscript-actualize-graphics-state stream medium :line-style :color)
  +      (format stream "newpath~%")
         (format stream "~A ~A moveto ~A ~A lineto~%"
                 (format-postscript-number x1) (format-postscript-number y1)
                 (format-postscript-number x2) (format-postscript-number y2))
  
positive.code: 
  (defconstant +postscript-default-line-dashes+ '(3 3))
  
  (defun postscript-line-style (stream medium)
    (let ((line-style (medium-line-style medium)))
      (format stream "~A setlinewidth ~A setlinejoin ~A setlinecap~%"
              (line-style-thickness line-style)
  
negative.code:                   (format-postscript-angle angle))
            (format stream "~A ~A scale~%"
                    (format-postscript-number s1) (format-postscript-number s2))
            (format stream "newpath~%")
            (format stream "0 0 1 ~A ~A arc~%"
                    (format-postscript-angle start-angle)
                    (format-postscript-angle end-angle))
            (when filled
              (format stream "0 0 lineto~%"))
            (format stream "setmatrix~%")
            (format stream (if filled
                               "fill~%"
                             "stroke~%")))))))
  