[mcclim-cvs] CVS mcclim/Backends/gtkairo

[dlichteblau]

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

Modified Files:
	medium.lisp pixmap.lisp port.lisp 
Log Message:

Set the antialising mode on /all/ cairo crs.

	* medium.lisp (set-antialias): New function.  (sync-sheet,
	sync-ink, make-cairo-surface): Call set-antialias.
	
	* port.lisp ((initialize-instance :after), mirror-drawable): Call
	set-antialias.

Fix the beams:

	* pixmap.lisp (%medium-copy-area): Perform clipping.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp	2006/11/19 15:55:11	1.12
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp	2006/12/03 15:24:09	1.13
@@ -74,6 +74,12 @@
 	   (not (region-equal (last-seen-region medium)
 			      (sheet-region (medium-sheet medium)))))))
 
+(defun set-antialias (cr)
+  (cairo_set_antialias cr
+		       (if *antialiasingp*
+			   :CAIRO_ANTIALIAS_DEFAULT
+			   :CAIRO_ANTIALIAS_NONE)))
+
 (defun sync-sheet (medium)
   (when (medium-sheet medium)		;ignore the metrik-medium
     (setf (gethash medium (dirty-mediums (port medium))) t))
@@ -85,7 +91,7 @@
 	(setf (cr medium) (gdk_cairo_create drawable))
 	(dispose-flipping-pixmap medium)
 	(pushnew medium (mirror-mediums mirror))
-	(cairo_set_antialias (cr medium) (if *antialiasingp* 0 1)))
+	(set-antialias (cr medium)))
       (setf (last-seen-sheet medium) (medium-sheet medium))
       (setf (last-seen-region medium) (sheet-region (medium-sheet medium))))))
 
@@ -250,6 +256,7 @@
 		(setf (flipping-pixmap medium)
 		      (gdk_pixmap_new drawable width height -1)))))
       (setf (cr medium) (gdk_cairo_create pixmap))
+      (set-antialias (cr medium))
       (setf (flipping-region medium) region)
       (cairo_paint (cr medium))
       (sync-transformation medium)
@@ -938,6 +945,7 @@
 	     (cairo_get_target (cr compatible-medium))
              format width height))
          (c (cairo_create s)))
+    (set-antialias c)
     (make-instance 'gtkairo-medium :cr c :surface s)))
 
 (defmacro with-pattern ((m1 mp) &body body)
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pixmap.lisp	2006/04/17 18:40:27	1.1
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/pixmap.lisp	2006/12/03 15:24:09	1.2
@@ -44,16 +44,23 @@
 	  (to-drawable (medium-gdkdrawable to-medium)))
       (cairo_surface_flush from-surface)
       (cairo_surface_flush to-surface)
-      (let ((gc (gdk_gc_new to-drawable)))
-	(gdk_draw_drawable to-drawable
-			   gc
-			   from-drawable
-			   (truncate from-x)
-			   (truncate from-y)
-			   (truncate to-x)
-			   (truncate to-y)
-			   (truncate width)
-			   (truncate height))
+      (let ((gc (gdk_gc_new to-drawable))
+	    (region (medium-clipping-region to-medium)))
+	(unless (eq region +nowhere+)
+	  (setf region
+		(region-intersection
+		 region
+		 (make-rectangle* to-x to-y (+ to-x width) (+ to-y height))))
+	  (loop for (x y w h) in (clipping-region->rect-seq region) do
+		(gdk_draw_drawable to-drawable
+				   gc
+				   from-drawable
+				   (truncate (+ from-x x (- to-x)))
+				   (truncate (+ from-y y (- to-y)))
+				   (truncate x)
+				   (truncate y)
+				   (truncate w)
+				   (truncate h))))
 	(gdk_gc_unref gc))
       (cairo_surface_mark_dirty to-surface))))
 
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp	2006/11/19 17:31:20	1.11
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp	2006/12/03 15:24:09	1.12
@@ -83,6 +83,7 @@
     (gtk_init (cffi:null-pointer) (cffi:null-pointer))
     (let ((cr (gdk_cairo_create
 		(gdk_screen_get_root_window (gdk_screen_get_default)))))
+      (set-antialias cr)
       (setf (metrik-medium port)
             (make-instance 'metrik-medium :port port :cr cr))))
   (when clim-sys:*multiprocessing-p*
@@ -150,6 +151,7 @@
 		       (height (floor (bounding-rectangle-max-y region)))
 		       (pixmap (gdk_pixmap_new window width height -1))
 		       (cr (gdk_cairo_create pixmap)))
+		  (set-antialias cr)
 		  (cairo_set_source_rgba cr
 					 1.0d0
 					 1.0d0