[mcclim-cvs] CVS mcclim/Backends/gtkairo

dlichteblau dlichteblau at common-lisp.net
Sun Nov 5 21:23:12 UTC 2006


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

Modified Files:
	gtk-ffi.lisp medium.lisp port.lisp 
Log Message:

Make gsharp pretty.

	* gtk-ffi.lisp (gdk_draw_rectangle, gdk_gc_set_rgb_fg_color): New
	declarations. 

	* medium.lisp (medium-draw-point*, medium-draw-points*): Draw the
	line in a 45 deg angle, resulting in a fully saturated color.

	* port.lisp ((realize-mirror pixmap)): Clear the pixmap using
	white color. 


--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp	2006/11/05 18:43:19	1.10
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/gtk-ffi.lisp	2006/11/05 21:23:11	1.11
@@ -602,6 +602,21 @@
   (width :int)
   (height :int))
 
+(defcfun "gdk_draw_rectangle"
+    :void
+  (drawable :pointer)
+  (gc :pointer)
+  (filled :int)
+  (x :int)
+  (y :int)
+  (width :int)
+  (height :int))
+
+(defcfun "gdk_gc_set_rgb_fg_color"
+    :void
+  (gc :pointer)
+  (color :pointer))
+
 (defcfun "gtk_button_new"
     :pointer
   )
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp	2006/11/05 18:49:13	1.10
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/medium.lisp	2006/11/05 21:23:12	1.11
@@ -446,7 +446,7 @@
       (setf x (df x))
       (setf y (df y))
       (cairo_move_to cr x y)
-      (cairo_line_to cr (+ x (/ x (expt 2 16))) y)
+      (cairo_line_to cr (+ x 0.5) (+ y 0.5))
       (cairo_stroke cr))))
 
 (defmethod medium-draw-points* ((medium gtkairo-medium) coord-seq)
@@ -462,7 +462,7 @@
 	    (let ((x (df (elt coord-seq (+ i 0))))
 		  (y (df (elt coord-seq (+ i 1)))))
 	      (cairo_move_to cr x y)
-	      (cairo_line_to cr (+ x (/ x (expt 2 16))) y)
+	      (cairo_line_to cr (+ x 0.5) (+ y 0.5))
 	      (cairo_stroke cr))))))
 
 (defmethod medium-draw-line* ((medium gtkairo-medium) x1 y1 x2 y2)
--- /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp	2006/11/05 18:43:19	1.6
+++ /project/mcclim/cvsroot/mcclim/Backends/gtkairo/port.lisp	2006/11/05 21:23:12	1.7
@@ -379,12 +379,20 @@
     (let* ((drawable
 	    (mirror-drawable
 	     (sheet-direct-mirror (climi::pixmap-sheet pixmap-sheet))))
-	   (pixmap
-	    (gdk_pixmap_new drawable
-			    (round (pixmap-width pixmap-sheet))
-			    (round (pixmap-height pixmap-sheet))
-			    -1))
-	   (mirror (make-instance 'drawable-mirror :drawable pixmap)))
+	   (w (round (pixmap-width pixmap-sheet)))
+	   (h (round (pixmap-height pixmap-sheet)))
+	   (pixmap (gdk_pixmap_new drawable w h -1))
+	   (mirror (make-instance 'drawable-mirror :drawable pixmap))
+	   (gc (gdk_gc_new pixmap)))
+      (cffi:with-foreign-object (c 'gdkcolor)
+	(setf (cffi:foreign-slot-value c 'gdkcolor 'pixel) 0)
+	(setf (values (cffi:foreign-slot-value c 'gdkcolor 'r)
+		      (cffi:foreign-slot-value c 'gdkcolor 'g)
+		      (cffi:foreign-slot-value c 'gdkcolor 'b))
+	      (values 65535 65535 65535))
+	(gdk_gc_set_rgb_fg_color gc c))
+      (gdk_draw_rectangle pixmap gc 1 0 0 w h)
+      (gdk_gc_unref gc)
       (climi::port-register-mirror port pixmap-sheet mirror)
       mirror)))
 




More information about the Mcclim-cvs mailing list