anchor.diff:      (format file-stream "showpage~%")
       (format file-stream "%%Page: ~D ~:*~D~%" (incf current-page))))
   
  ++
  +;;; Postscript output utilities
  +
  +(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-add-path (stream region)
  +  (:documentation
  +   "Adds REGION (if it is a path) or its boundary (if it is an area)
  +   to the current path of STREAM."))
  +
  +(defmethod postscript-add-path (stream (region (eql +nowhere+)))
  +  (declare (ignore stream region)))
  +
  +(defmethod postscript-add-path (stream (region standard-region-union))
  +  (map-over-region-set-regions (lambda (region)
  +                                 (postscript-add-path stream region))
  +                               region))
  +
  +(defmethod postscript-add-path (stream (region standard-region-intersection))
  +  (with-graphics-state (stream)
  +    #+nil (format stream "initclip~%")
  +    (loop for subregion in (region-set-regions region)
  +          do (format stream "newpath~%")
  +             (postscript-add-path stream subregion)
  +             (format stream "clip~%"))
  +    (format stream "clippath false upath~%"))
  +  (format stream "uappend~%"))
  +
  +(defmethod postscript-add-path (stream (polygon polygon))
  +  (let ((points (polygon-points polygon)))
  +    (format stream "~A ~A moveto~%"
  +            (format-postscript-number (point-x (first points)))
  +            (format-postscript-number (point-y (first points))))
  +    (loop for point in (rest points)
  +          do (format stream "~A ~A lineto~%"
  +                     (format-postscript-number (point-x point))
  +                     (format-postscript-number (point-y point))))
  +    (format stream "closepath~%")))
  +
  +(defmethod postscript-add-path (stream (ellipse ellipse))
  +  (multiple-value-bind (center-x center-y)
  +      (ellipse-center-point* ellipse)
  +    (let ((start-angle (or (ellipse-start-angle ellipse) 0))
  +          (end-angle (or (ellipse-end-angle ellipse) (* 2 pi))))
  +      (multiple-value-bind (ndx1 ndy1 ndx2 ndy2) (ellipse-normal-radii* ellipse)
  +        (let* ((angle (atan* ndx1 ndy1))
  +               (s1 (sqrt (+ (* ndx1 ndx1) (* ndy1 ndy1))))
  +               (s2 (sqrt (+ (* ndx2 ndx2) (* ndy2 ndy2))))
  +               (tr (compose-transformation-with-scaling
  +                    (make-rotation-transformation angle)
  +                    s1 s2))
  +               (start-angle (untransform-angle tr start-angle))
  +               (end-angle (untransform-angle tr end-angle)))
  +          (format stream "matrix currentmatrix~%")
  +          (format stream "~A ~A translate~%"
  +                  (format-postscript-number center-x)
  +                  (format-postscript-number center-y))
  +          (format stream "~A rotate~%"
  +                  (format-postscript-angle angle))
  +          (format stream "~A ~A scale~%"
  +                  (format-postscript-number s1) (format-postscript-number s2))
  +          (format stream "0 0 1 ~A ~A arc~%"
  +                  (format-postscript-angle start-angle)
  +                  (format-postscript-angle end-angle))
  +          ;; (when filled ; uncomment when this code will be shared
  +          ;;              ; with ...-ELLIPTICAL-ARC
  +          (format stream "0 0 lineto~%")
  +          ;;)
  +          (format stream "closepath~%")
  +          (format stream "setmatrix~%"))))))
  +
  ++
  +;;; Graphics state
  +
  +(defgeneric postscript-set-graphics-state (stream medium kind))
  +
  +(defun postscript-actualize-graphics-state (stream medium &rest states)
  +  "Sets graphics parameters named in STATES."
  +  (loop for state in (cons :clipping-region states)
  +        ;; every drawing function depends on clipping region
  +        do (postscript-set-graphics-state stream medium state)))
  +
   (defconstant +postscript-line-joints+ '(:miter 0
                                           :round 1
                                           :bevel 2
  
positive.code: (defmethod medium-draw-rectangle* ((medium postscript-medium) x1 y1 x2 y2 filled)
    (let ((stream (postscript-medium-file-stream medium)))
      (with-graphics-state (stream)
        (format stream "~A ~A moveto ~A ~A lineto ~A ~A lineto ~A ~A lineto~%"
                (format-postscript-number x1) (format-postscript-number y1)
                (format-postscript-number x2) (format-postscript-number y1)
                (format-postscript-number x2) (format-postscript-number y2)
                (format-postscript-number x1) (format-postscript-number y2))
        (format stream "closepath~%")
        (postscript-line-style-and-color stream medium)
        (format stream (if filled
                           "fill~%"
                           "stroke~%")))))
  
negative.code:   (assert (evenp (length position-seq)))
    (let ((stream (postscript-medium-file-stream medium)))
      (with-graphics-state (stream)
        (postscript-actualize-graphics-state stream medium :line-style :color)
        (format stream "newpath~%")
        (loop for (x1 y1 x2 y2) on position-seq by #'cddddr
              do (format stream "~A ~A moveto ~A ~A lineto ~A ~A lineto ~A ~A lineto~%"
                         (format-postscript-number x1) (format-postscript-number y1)
  