[mcclim-cvs] CVS mcclim/Backends/gtkairo

crhodes crhodes at common-lisp.net
Wed Jul 11 15:26:21 UTC 2007


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

Modified Files:
	cairo.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/gtkairo/cairo.lisp	2006/12/26 17:29:49	1.3
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/cairo.lisp	2007/07/11 15:26:20	1.4
@@ -707,6 +707,19 @@
 
 ;;;; Bezier support
 
+(defun %draw-bezier-area (medium area)
+  (with-slots (cr) medium
+    (let ((segments (climi::segments area)))
+      (let ((p0 (slot-value (car segments) 'climi::p0)))
+        (cairo_move_to cr (df (point-x p0)) (df (point-y p0))))
+      (dolist (segment segments)
+        (with-slots (climi::p1 climi::p2 climi::p3) segment
+          (cairo_curve_to cr
+                          (df (point-x climi::p1)) (df (point-y climi::p1))
+                          (df (point-x climi::p2)) (df (point-y climi::p2))
+                          (df (point-x climi::p3)) (df (point-y climi::p3)))))
+      (cairo_fill cr))))
+
 (defmethod climi::medium-draw-bezier-design*
     ((medium cairo-medium) (design climi::bezier-area))
   (with-medium (medium)
@@ -715,39 +728,36 @@
     (sync-ink medium (medium-ink medium))
     (sync-clipping-region medium (medium-clipping-region medium))
     (sync-line-style medium (medium-line-style medium))
-    (with-slots (cr) medium
-      (let ((p0 (slot-value (car (climi::segments design)) 'climi::p0)))
-	(cairo_move_to cr (df (point-x p0)) (df (point-y p0))))
-      (dolist (segment (climi::segments design))
-	(with-slots (climi::p1 climi::p2 climi::p3) segment
-	  (cairo_curve_to cr
-			  (df (point-x climi::p1)) (df (point-y climi::p1))
-			  (df (point-x climi::p2)) (df (point-y climi::p2))
-			  (df (point-x climi::p3)) (df (point-y climi::p3)))))
-      (cairo_fill cr))))
+    (%draw-bezier-area medium design)))
 
 (defmethod climi::medium-draw-bezier-design*
     ((medium cairo-medium) (design climi::bezier-union))
-  (dolist (area (climi::areas design))
-    (climi::medium-draw-bezier-design* medium area)))
+  (with-medium (medium)
+    (sync-sheet medium)
+    (sync-transformation medium)
+    (sync-ink medium (medium-ink medium))
+    (sync-clipping-region medium (medium-clipping-region medium))
+    (sync-line-style medium (medium-line-style medium))
+    (let ((tr (climi::transformation design)))
+      (dolist (area (climi::areas design))
+        (%draw-bezier-area medium (transform-region tr area))))))
 
 (defmethod climi::medium-draw-bezier-design*
     ((medium cairo-medium) (design climi::bezier-difference))
-  (dolist (area (climi::positive-areas design))
-    (climi::medium-draw-bezier-design* medium area))
+  (with-medium (medium)
+    (sync-sheet medium)
+    (sync-transformation medium)
+    (sync-ink medium (medium-ink medium))
+    (sync-clipping-region medium (medium-clipping-region medium))
+    (sync-line-style medium (medium-line-style medium))
+    (dolist (area (climi::positive-areas design))
+      (%draw-bezier-area medium area)))
   (with-drawing-options (medium :ink +background-ink+)
-    (dolist (area (climi::negative-areas design))
-      (climi::medium-draw-bezier-design* medium area))))
-
-(defmethod climi::medium-draw-bezier-design*
-    ((medium cairo-medium) (design climi::translated-bezier-design))
-  (let ((tx (climi::translation design)))
-    (setf tx
-	  ;;
-	  ;; FIXME: needed for gsharp, doesn't make sense to me
-	  ;;
-	  (compose-transformations tx (medium-transformation medium)))
-    (climi::medium-draw-bezier-design* medium
-				       (climi::really-transform-region
-					tx
-					(climi::original-region design)))))
+    (with-medium (medium)
+      (sync-sheet medium)
+      (sync-transformation medium)
+      (sync-ink medium (medium-ink medium))
+      (sync-clipping-region medium (medium-clipping-region medium))
+      (sync-line-style medium (medium-line-style medium))
+      (dolist (area (climi::negative-areas design))
+        (%draw-bezier-area medium area)))))




More information about the Mcclim-cvs mailing list