[mcclim-cvs] CVS mcclim/Backends/PostScript

[crhodes]

Update of /project/mcclim/cvsroot/mcclim/Backends/PostScript
In directory clnet:/tmp/cvs-serv13045/Backends/PostScript

Modified Files:
	graphics.lisp 
Log Message:
Bezier designs which draw in the right place in all backends (I think).

The implementation prior to this worked for the replay on an 
output-recording stream, and probably worked for the first draw using 
the pixmap (fall-through) rendering method.  It did not work for the 
first draw on a backend with native bezier drawing routines, basically 
because the design was being passed through untransformed by the medium 
transformation.  So:

* define a method on medium-draw-bezier-design* specialized on 
  transform-coordinates-mixin, to transform the region appropriately 
  before passing down to backend-drawing functions.  This method runs
  after the output-recording-stream method, so sadly we're now doing 
  some transformations twice.

* this implies deleting the translated-bezier-design class, as returning
  an object of a different class from transform-region meant that the 
  idiom of doing
    (defmethod medium-draw-foo* :around ((medium t-c-mixin) foo)
      (let ((foo (transform-region (medium-transformation medium) foo)))
        (call-next-method medium foo)))
  would be in violation of the restriction that the set of applicable
  methods not change when using call next method.

* deleting the translated-bezier-design class would mean losing the 
  cacheing of pixmap renderings, so restore that by keeping track of
  the original design in all bezier-design subclasses, and use that in
  ensure-pixmap.

* this on its own is still too slow, so for bezier-areas and 
  bezier-unions additionally keep track of accumulated 
  translation transformations, only performing the transformation of 
  individual segments or areas when they are necessary.  (A similar 
  approach could be used for differences, but I ran out of energy; we 
  have however recovered most of the speed loss from the introduction of 
  this extra correctness.)

* the Postscript and gtkairo backends, with their medium-draw-bezier* 
  methods, needed some adjustment to perform the transformations 
  themselves.

Please test!


--- /project/mcclim/cvsroot/mcclim/Backends/PostScript/graphics.lisp	2006/12/26 16:44:45	1.18
+++ /project/mcclim/cvsroot/mcclim/Backends/PostScript/graphics.lisp	2007/07/11 15:26:20	1.19
@@ -547,36 +547,44 @@
 
 ;;; Bezier support
 
-(defmethod climi::medium-draw-bezier-design*
-    ((medium clim-postscript::postscript-medium) (design climi::bezier-area))
-  (let ((stream (clim-postscript::postscript-medium-file-stream medium))
-        (clim-postscript::*transformation* (sheet-native-transformation (medium-sheet medium))))
-    (clim-postscript::postscript-actualize-graphics-state stream medium :color)
-    (format stream "newpath~%")
-    (let ((p0 (slot-value (car (climi::segments design)) 'climi::p0)))
-      (clim-postscript::write-coordinates stream (point-x p0) (point-y p0))
+(defun %draw-bezier-area (stream area)
+  (format stream "newpath~%")
+  (let ((segments (climi::segments area)))
+    (let ((p0 (slot-value (car segments) 'climi::p0)))
+      (write-coordinates stream (point-x p0) (point-y p0))
       (format stream "moveto~%"))
-    (loop for segment in (climi::segments design)
+    (loop for segment in segments
           do (with-slots (climi::p1 climi::p2 climi::p3) segment
-               (clim-postscript::write-coordinates stream (point-x climi::p1) (point-y climi::p1))
-               (clim-postscript::write-coordinates stream (point-x climi::p2) (point-y climi::p2))
-               (clim-postscript::write-coordinates stream (point-x climi::p3) (point-y climi::p3))
+               (write-coordinates stream (point-x climi::p1) (point-y climi::p1))
+               (write-coordinates stream (point-x climi::p2) (point-y climi::p2))
+               (write-coordinates stream (point-x climi::p3) (point-y climi::p3))
                (format stream "curveto~%")))
     (format stream "fill~%")))
 
 (defmethod climi::medium-draw-bezier-design*
-    ((medium clim-postscript::postscript-medium) (design climi::bezier-union))
-  (dolist (area (climi::areas design))
-    (climi::medium-draw-bezier-design* medium area)))
+    ((medium postscript-medium) (design climi::bezier-area))
+  (let ((stream (postscript-medium-file-stream medium))
+        (*transformation* (sheet-native-transformation (medium-sheet medium))))
+    (postscript-actualize-graphics-state stream medium :color)
+    (%draw-bezier-area stream design)))
 
 (defmethod climi::medium-draw-bezier-design*
-    ((medium clim-postscript::postscript-medium) (design climi::bezier-difference))
-  (dolist (area (climi::positive-areas design))
-    (climi::medium-draw-bezier-design* medium area))
-  (with-drawing-options (medium :ink +background-ink+)
-    (dolist (area (climi::negative-areas design))
-      (climi::medium-draw-bezier-design* medium area))))
+    ((medium postscript-medium) (design climi::bezier-union))
+  (let ((stream (postscript-medium-file-stream medium))
+        (*transformation* (sheet-native-transformation (medium-sheet medium))))
+    (postscript-actualize-graphics-state stream medium :color)
+    (let ((tr (climi::transformation design)))
+      (dolist (area (climi::areas design))
+        (%draw-bezier-area stream (transform-region tr area))))))
 
 (defmethod climi::medium-draw-bezier-design*
-    ((medium clim-postscript::postscript-medium) (design climi::translated-bezier-design))
-  (climi::medium-draw-bezier-design* medium (climi::really-transform-region (climi::translation design) (climi::original-region design))))
+    ((medium postscript-medium) (design climi::bezier-difference))
+  (let ((stream (postscript-medium-file-stream medium))
+        (*transformation* (sheet-native-transformation (medium-sheet medium))))
+    (postscript-actualize-graphics-state stream medium :color)
+    (dolist (area (climi::positive-areas design))
+      (%draw-bezier-area stream area))
+    (with-drawing-options (medium :ink +background-ink+)
+      (postscript-actualize-graphics-state stream medium :color)
+      (dolist (area (climi::negative-areas design))
+        (%draw-bezier-area stream area)))))