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)))))