[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