[mcclim-cvs] CVS mcclim/Backends/gtkairo

[dlichteblau]

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

Modified Files:
	BUGS gadgets.lisp medium.lisp 
Log Message:
Optimize Goatee cursor drawing to make the CLIM Listener usable.

	* medium.lisp (FLIPPING-REGION): New accessor.
        (APPLY-FLIPPING-INK): Draw only the affected region.  ((SYNC-INK
	FLIPPING-INK)): Default to the entire sheet.
	(MEDIUM-DRAW-RECTANGLE*): Set flipping-region to the affected
	rectangle.

Fix menu bar height:

        * gadgets.lisp ((compose-space gtk-menu-bar)): Rewritten similar
	to the default method.


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS	2006/05/13 19:37:29	1.10
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/BUGS	2006/06/10 10:08:49	1.11
@@ -40,7 +40,7 @@
     On windows, all we get is a sans serif font.  No serif and notably
     no monospace font, breaking climacs like bug 3 did.
 
-7a.
+(WONTFIX) 7a. [fixed for draw-rectangle, good enough for now]
     flipping ink takes time proportional to the with the size of the
     window, not with the size of the shape being drawn
 
@@ -98,7 +98,7 @@
     but that doesn't work for gsharp when drawing ellipses.  Find out
     what this is all about.
 
-18.
+(WONTFIX) 18. [see 7a, good enough for now]
     Flipping ink optimization: As suggested by Gilbert, make the temporary
     pixmap just large enough for the clipping region and the currently
     visible part of a (scrolled) sheet.  Right now we're copying the
@@ -117,3 +117,10 @@
 
 22.
    medium-draw-ellipse* needs a rewrite.
+
+23.
+   Beirc problem: When connecting to a server, the first receiver pane
+   is created, and suddenly the windows gets unusably large, hiding the
+   interactor.  Replacing the :min-height 800 in receivers.lisp with
+   :min-height 400 :max-height 400 fixes that, but CLX doesn't have the
+   same problem.
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/05/13 19:37:29	1.5
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gadgets.lisp	2006/06/10 10:08:49	1.6
@@ -301,7 +301,23 @@
 
 (defmethod compose-space ((gadget gtk-menu-bar) &key width height)
   (declare (ignore width height))
-  (make-space-requirement :height 20 :min-height 20 :max-height 20))
+  (let* ((widget (native-widget gadget))
+	 (widgetp widget)
+	 (item nil))
+    (unless widgetp
+      (setf widget (realize-native-widget gadget))
+      (setf item (gtk_menu_item_new_with_label "foo"))
+      (gtk_menu_shell_append widget item)
+      (gtk_widget_show_all widget))
+    (prog1
+	(cffi:with-foreign-object (r 'gtkrequisition)
+	  (gtk_widget_size_request widget r)
+	  (cffi:with-foreign-slots ((height) r gtkrequisition)
+	    (make-space-requirement :height height
+				    :min-height height
+				    :max-height height)))
+      (unless widgetp
+	(gtk_widget_destroy widget)))))
 
 
 ;;; Vermischtes
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp	2006/05/13 19:37:29	1.7
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp	2006/06/10 10:08:49	1.8
@@ -34,6 +34,7 @@
    (cr :initform nil :initarg :cr :accessor cr)
    (flipping-original-cr :initform nil :accessor flipping-original-cr)
    (flipping-pixmap :initform nil :accessor flipping-pixmap)
+   (flipping-region :accessor flipping-region)
    (surface :initarg :surface :accessor surface)
    (last-seen-sheet :accessor last-seen-sheet)
    (last-seen-region :accessor last-seen-region)))
@@ -216,11 +217,15 @@
     (cairo_surface_flush from-surface)
     (cairo_surface_flush to-surface)
     (let ((gc (gdk_gc_new to-drawable))
-	  (region (climi::sheet-mirror-region (medium-sheet medium))))
+	  (region (flipping-region medium)))
       (gdk_gc_set_function gc :xor)
-      (gdk_draw_drawable to-drawable gc from-drawable 0 0 0 0
-			 (floor (bounding-rectangle-max-x region))
-			 (floor (bounding-rectangle-max-y region))) 
+      (gdk_draw_drawable to-drawable gc from-drawable
+			 (floor (bounding-rectangle-min-x region))
+			 (floor (bounding-rectangle-min-y region))
+			 (floor (bounding-rectangle-min-x region))
+			 (floor (bounding-rectangle-min-y region))
+			 (ceiling (bounding-rectangle-max-x region))
+			 (ceiling (bounding-rectangle-max-y region))) 
       (gdk_gc_unref gc))
     (cairo_surface_mark_dirty to-surface))
   (cairo_destroy (cr medium))
@@ -244,6 +249,7 @@
 		  (setf (flipping-pixmap medium)
 			(gdk_pixmap_new drawable width height -1)))))
 	(setf (cr medium) (gdk_cairo_create pixmap))
+	(setf (flipping-region medium) region)
 	(cairo_paint (cr medium))
 	(sync-transformation medium)
 	(sync-ink medium +white+)))))
@@ -516,6 +522,13 @@
     (sync-clipping-region medium (medium-clipping-region medium))
     (unless filled
       (sync-line-style medium (medium-line-style medium)))
+    (when (flipping-original-cr medium)
+      (setf (flipping-region medium)
+	    (transform-region
+	     (if (medium-sheet medium)
+		 (sheet-native-transformation (medium-sheet medium))
+		 clim:+identity-transformation+)
+	     (make-rectangle* x1 y1 x2 y2))))
     (with-slots (cr) medium
       (setf x1 (df x1))
       (setf y1 (df y1))