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