anchor.diff:    (with-slots (strings baseline width max-height left right start-y end-x end-y medium)
         text-record
       (if (and strings
  -	     (let ((string (last1 strings)))
  -	       (match-output-records string
  -				     :text-style text-style
  -				     :ink (medium-ink medium)
  -				     :clipping-region (medium-clipping-region
  -						       medium))))
  -	(vector-push-extend character (slot-value (last1 strings) 'string))
  -	(nconcf strings
  -		(list (make-instance
  -		       'styled-string
  -		       :start-x end-x
  -		       :text-style text-style
  -		       :medium medium	; pick up ink and clipping region
  -		       :string (make-array 1 :initial-element character
  -					   :element-type 'character
  -					   :adjustable t
  -					   :fill-pointer t)))))
  +             (let ((string (last1 strings)))
  +               (match-output-records string
  +                                     :text-style text-style
  +                                     :ink (medium-ink medium)
  +                                     :clipping-region (medium-clipping-region
  +                                                       medium))))
  +        (vector-push-extend character (slot-value (last1 strings) 'string))
  +        (nconcf strings
  +                (list (make-instance
  +                       'styled-string
  +                       :start-x end-x
  +                       :text-style text-style
  +                       :medium medium	; pick up ink and clipping region
  +                       :string (make-array 1 :initial-element character
  +                                           :element-type 'character
  +                                           :adjustable t
  +                                           :fill-pointer t)))))
       (multiple-value-bind (minx miny maxx maxy)
           (text-bounding-rectangle* medium character :text-style text-style)
         (declare (ignore miny maxy))
  
positive.code: (defun normalize-coords (dx dy &optional unit)
    (let ((norm (sqrt (+ (* dx dx) (* dy dy)))))
      (cond ((= norm 0.0d0)
  	   (values 0.0d0 0.0d0))
  	  (unit
  	   (let ((scale (/ unit norm)))
  	     (values (* dx scale) (* dy scale))))
  	  (t (values (/ dx norm) (/ dy norm))))))
  
  (defun polygon-record-bounding-rectangle
      (coord-seq closed filled line-style border miter-limit)
    (cond (filled
  	 (coord-seq-bounds coord-seq 0))
  	((eq (line-style-joint-shape line-style) :round)
  	 (coord-seq-bounds coord-seq border))
  	(t (let* ((x1 (elt coord-seq 0))
  		  (y1 (elt coord-seq 1))
  		  (min-x x1)
  		  (min-y y1)
  		  (max-x x1)
  		  (max-y y1)
  		  (len (length coord-seq)))
  	     (unless closed
  	       (setq min-x (- x1 border)  min-y (- y1 border)
  		     max-x (+ x1 border)  max-y (+ y1 border)))
  	     ;; Setup for iterating over the coordinate vector.  If
  	     ;; the polygon is closed, deal with the extra segment.
  	     (multiple-value-bind (initial-xp initial-yp
  				   final-xn final-yn
  				   initial-index final-index)
  		 (if closed
  		     (values (elt coord-seq (- len 2))
  			     (elt coord-seq (- len 1))
  			     x1 y1
  			     0 (- len 2))
  		     (values x1 y1
  			     (elt coord-seq (- len 2))
  			     (elt coord-seq (- len 1))
  			     2 (- len 4)))
  	       (ecase (line-style-joint-shape line-style)
  		 (:miter
  		  ;;FIXME: Remove successive positively proportional segments
  		  (loop with sin-limit = (sin (* 0.5 miter-limit))
  			and xn and yn
  			for i from initial-index to final-index by 2
  			for xp = initial-xp then x
  			for yp = initial-yp then y
  			for x = (elt coord-seq i)
  			for y = (elt coord-seq (1+ i))
  			do (setf (values xn yn)
  				 (if (eql i final-index)
  				     (values final-xn final-yn)
  				     (values (elt coord-seq (+ i 2))
  					     (elt coord-seq (+ i 3)))))
  			   (multiple-value-bind (ex1 ey1)
  			       (normalize-coords (- x xp) (- y yp))
  			     (multiple-value-bind (ex2 ey2)
  				 (normalize-coords (- x xn) (- y yn))
  			       (let* ((cos-a (+ (* ex1 ex2) (* ey1 ey2)))
  				      (sin-a/2 (sqrt (* 0.5 (- 1.0 cos-a)))))
  				 (if (< sin-a/2 sin-limit)
  				     (let ((nx (* border
  						  (max (abs ey1) (abs ey2))))
  					   (ny (* border
  						  (max (abs ex1) (abs ex2)))))
  				       (minf min-x (- x nx))
  				       (minf min-y (- y ny))
  				       (maxf max-x (+ x nx))
  				       (maxf max-y (+ y ny)))
  				     (let ((length (/ border sin-a/2)))
  				       (multiple-value-bind (dx dy)
  					   (normalize-coords (+ ex1 ex2)
  							     (+ ey1 ey2)
  							     length)
  					 (minf min-x (+ x dx))
  					 (minf min-y (+ y dy))
  					 (maxf max-x (+ x dx))
  					 (maxf max-y (+ y dy))))))))))
  		 ((:bevel :none)
  		  (loop with xn and yn
  			for i from initial-index to final-index by 2
  			for xp = initial-xp then x
  			for yp = initial-yp then y
  			for x = (elt coord-seq i)
  			for y = (elt coord-seq (1+ i))
  			do (setf (values xn yn)
  				 (if (eql i final-index)
  				     (values final-xn final-yn)
  				     (values (elt coord-seq (+ i 2))
  					     (elt coord-seq (+ i
  								 3)))))
  			   (multiple-value-bind (ex1 ey1)
  			       (normalize-coords (- x xp) (- y yp))
  			     (multiple-value-bind (ex2 ey2)
  				 (normalize-coords (- x xn) (- y yn))
  			       (let ((nx (* border (max (abs ey1) (abs ey2))))
  				     (ny (* border (max (abs ex1) (abs ex2)))))
  				 (minf min-x (- x nx))
  				 (minf min-y (- y ny))
  				 (maxf max-x (+ x nx))
  				 (maxf max-y (+ y ny))))))))
  	       (unless closed
  		 (multiple-value-bind (x y)
  		     (values (elt coord-seq (- len 2))
  			     (elt coord-seq (- len 1)))
  		   (minf min-x (- x border))
  		   (minf min-y (- y border))
  		   (maxf max-x (+ x border))
  		   (maxf max-y (+ y border)))))
  	     (values min-x min-y max-x max-y)))))
  
  (def-grecording draw-polygon ((coord-seq-mixin gs-line-style-mixin)
  			      coord-seq closed filled) ()
    (let ((transformed-coord-seq (transform-positions (medium-transformation medium) coord-seq))
  	(border (graphics-state-line-style-border graphic medium)))
      (setf coord-seq transformed-coord-seq)
      (polygon-record-bounding-rectangle transformed-coord-seq
  				       closed filled line-style border
  				       (medium-miter-limit medium))))
  
  (defrecord-predicate draw-polygon-output-record (closed filled)
    (and (if-supplied (closed)
  	 (eql (slot-value record 'closed) closed))
         (if-supplied (filled)
  	 (eql (slot-value record 'filled) filled))))
  
  (def-grecording draw-rectangle ((gs-line-style-mixin)
  				left top right bottom filled) (:medium-fn nil)
    (let* ((transform (medium-transformation medium))
           (border     (graphics-state-line-style-border graphic medium))
           (pre-coords (expand-rectangle-coords left top right bottom))
  
negative.code:     (when (reflection-transformation-p transform)
        (rotatef start-angle end-angle))
      (multiple-value-bind (min-x min-y max-x max-y)
          (bounding-rectangle* (make-ellipse* center-x center-y
                                              radius-1-dx radius-1-dy
                                              radius-2-dx radius-2-dy
                                              :start-angle start-angle
                                              :end-angle end-angle))
        (if filled
            (values min-x min-y max-x max-y)
            (let ((border (graphics-state-line-style-border graphic medium)))
              (values (- min-x border)
                      (- min-y border)
                      (+ max-x border)
                      (+ max-y border)))))))
  
  (defmethod* (setf output-record-position) :around
      (nx ny (record draw-ellipse-output-record))
    (with-standard-rectangle* (:x1 x1 :y1 y1)
        record
      (with-slots (center-x center-y)
          record
        (let ((dx (- nx x1))
              (dy (- ny y1)))
          (multiple-value-prog1
              (call-next-method)
            (incf center-x dx)
            (incf center-y dy))))))
  
  (defrecord-predicate draw-ellipse-output-record (center-x center-y filled)
    (and (if-supplied (center-x coordinate)
  