Hi guys,
I've managed to get cells-gtk drawing-area to basically work. I'm
attaching the diff. A few notes follow.
In drawing.lisp I shuffled some stuff around and used the double colon
package selector to get it find all the symbols on first load. There may
be a slightly cleaner way to do this.
I fixed a bug where *window* was not bound on first run and caused an
error, but would be ok on later runs in the same Lisp image.
I made button1-down, button2-down, and button3-down all cells so that
you can use them as inputs in the cells-gtk framework.
For the future, I suspect that drawing-expose-event-handler could
probably be simpler and not call init-graphics-context each time? Also
drawing-pointer-motion-handler produces an effect but probably not quite
what was intended (the image is moved while you hold down the button,
but excess areas are not cleaned so it looks slurred along, and
subsequent tries move it from 0,0 again).
I'm on SBCL on Ubuntu 7.04.
Martin Flack
diff -ur tmp/cells-gtk-0.1/cells-gtk.asd .sbcl/site/cells-gtk-0.1/cells-gtk.asd
--- tmp/cells-gtk-0.1/cells-gtk.asd 2006-06-30 10:22:55.000000000 -0400
+++ .sbcl/site/cells-gtk-0.1/cells-gtk.asd 2007-06-03 09:49:02.000000000 -0400
@@ -11,7 +11,7 @@
(:file "widgets" :depends-on ("conditions"))
(:file "layout" :depends-on ("widgets"))
(:file "display" :depends-on ("widgets"))
-; (:file "drawing" :depends-on ("widgets"))
+ (:file "drawing" :depends-on ("widgets"))
(:file "buttons" :depends-on ("widgets"))
(:file "entry" :depends-on ("widgets"))
(:file "tree-view" :depends-on ("widgets"))
diff -ur tmp/cells-gtk-0.1/drawing.lisp .sbcl/site/cells-gtk-0.1/drawing.lisp
--- tmp/cells-gtk-0.1/drawing.lisp 2006-06-30 10:22:55.000000000 -0400
+++ .sbcl/site/cells-gtk-0.1/drawing.lisp 2007-06-10 00:35:39.000000000 -0400
@@ -14,48 +14,74 @@
|#
+(in-package :cgtk)
+
+(def-widget drawing-area ()
+ ((draw-fn :accessor draw-fn :initform (c-in nil) :initarg :draw-fn)
+ (gobjects :cell nil :initform (make-hash-table :test #'equal) :accessor gobjects)
+ (backing-pixmap :cell nil :initform nil)
+ (button1-down :initform (c-in nil) :accessor button1-down)
+ (button2-down :initform (c-in nil) :accessor button2-down)
+ (button3-down :initform (c-in nil) :accessor button3-down))
+ () ; gtk-slots
+ (expose-event)) ; signal-slots
+
+(defvar *colors* (make-hash-table :test #'equal))
+(defvar *gcontext* nil "The current graphics context")
+(defvar *widget-id* nil "The current widget (set in with-pixmap)")
+(defvar *window* nil "The current window of the current widget (useful in drawing text.)")
+
+(defun init-graphics-context (widget)
+ (loop for color in '("black" "white" "red" "green" "blue") ; see /usr/X11R6/lib/X11/rgb.txt
+ for cobj = (gtk-adds-color-new) do
+ (unless (= 1 (gdk-color-parse color cobj)) (error "unknown color: ~A" color))
+ (setf (gethash color *colors*) cobj))
+ (setf *window* (gtk-adds-widget-window widget))
+ (setf *gcontext* (gdk-gc-new *window*))
+ (gdk-gc-set-rgb-fg-color *gcontext* (get-color "black"))
+ (gdk-gc-set-rgb-bg-color *gcontext* (get-color "white"))
+ (gdk-gc-set-line-attributes *gcontext* 3 0 0 0))
+
+;;;============================================================================
(in-package :gtk-ffi)
+;;;============================================================================
(cffi:defcallback drawing-expose-event-handler :int
((drawing-area :pointer) (signal :pointer) (data :pointer))
- (declare (ignorable data signal gkd-event-expose widget))
- (when-bind (self (gtk-object-find drawing-area))
- (init-graphics-context drawing-area)
- (gdk-draw-drawable
- *window*
- *gcontext*
- (funcall (funcall (intern "draw-fn" :cells-gtk) self) self)
- 0 0 0 0 -1 -1)
+ (declare (ignorable data signal gdk-event-expose widget))
+ (when-bind (self (cgtk::gtk-object-find drawing-area))
+ (cgtk::init-graphics-context drawing-area)
+ (gdk-draw-drawable cgtk::*window* cgtk::*gcontext* (funcall (cgtk::draw-fn self) self) 0 0 0 0 -1 -1)
0))
(cffi:defcallback drawing-button-events-handler :int
((drawing-area :pointer) (signal :pointer) (data :pointer))
(declare (ignorable data))
- (when-bind (self (gtk-object-find drawing-area))
+ (when-bind (self (cgtk::gtk-object-find drawing-area))
(let ((event (gdk-event-button-type signal)))
- (when (and (eql (event-type event) :button_press)
- (= (gdk-event-button-button signal) 1))
- (setf (button1-down self)
- (cons (truncate (gdk-event-button-x signal))
- (truncate (gdk-event-button-y signal)))))
- (when (and (eql (event-type event) :button_release)
- (= (gdk-event-button-button signal) 1))
- (setf (button1-down self) nil))))
+ (block known-event
+ (let ((pos (case (event-type event)
+ (:button_press (cons (truncate (gdk-event-button-x signal))
+ (truncate (gdk-event-button-y signal))))
+ (:button_release nil)
+ (t (return-from known-event)))))
+ (ecase (gdk-event-button-button signal)
+ (1 (setf (cgtk::button1-down self) pos))
+ (2 (setf (cgtk::button2-down self) pos))
+ (3 (setf (cgtk::button3-down self) pos)))))))
0)
-
(cffi:defcallback drawing-pointer-motion-handler :int
((drawing-area :pointer) (signal :pointer) (data :pointer))
(declare (ignorable data signal widget))
- (when-bind (self (gtk-object-find drawing-area))
- (when-bind (button1 (button1-down self))
+ (when-bind (self (cgtk::gtk-object-find drawing-area))
+ (when-bind (button1 (cgtk::button1-down self))
(let ((dx (- (truncate (gdk-event-motion-x signal)) (car button1)))
- (dy(- (truncate (gdk-event-motion-y signal)) (cdr button1))))
- (loop for drawable being the hash-value of (gobjects self) do
- (gdk-draw-drawable *window* *gcontext* drawable 0 0 dx dy -1 -1)))))
+ (dy (- (truncate (gdk-event-motion-y signal)) (cdr button1))))
+ (loop for drawable being the hash-value of (cgtk::gobjects self) do
+ (gdk-draw-drawable cgtk::*window* cgtk::*gcontext* drawable 0 0 dx dy -1 -1)))))
0)
-
(defun gtk-drawing-set-handlers (widget data)
(gtk-signal-connect-swap widget "button-press-event"
(cffi:get-callback 'drawing-button-events-handler)
@@ -69,47 +95,24 @@
(gtk-signal-connect-swap widget "expose-event"
(cffi:get-callback 'drawing-expose-event-handler)
:data data))
-(export '(gtk-drawing-set-handlers))
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+ (export '(gtk-drawing-set-handlers)))
;;;============================================================================
(in-package :cgtk)
;;;============================================================================
-(def-widget drawing-area ()
- ((draw-fn :accessor draw-fn :initform (c-in nil) :initarg :draw-fn)
- (gobjects :cell nil :initform (make-hash-table :test #'equal) :accessor gobjects)
- (backing-pixmap :cell nil :initform nil)
- (button1-down :cell nil :initform nil :accessor button1-down)
- (button2-down :cell nil :initform nil :accessor button2-down)
- (button3-down :cell nil :initform nil :accessor button3-down))
- () ; gtk-slots
- (expose-event)) ; signal-slots
-
;;; POD This is essentially an initialize-instance, but run later.
(def-c-output draw-fn ((self drawing-area))
(gtk-widget-add-events (id self) 772) ; 512 + 256 + 4 button_press, release, motion,
- (gtk-ffi:gtk-drawing-set-handlers (id self) (id self))) ; Could I arrange for data to be a pixmap or widget ???
-
-(defvar *colors* (make-hash-table :test #'equal))
-(defvar *gcontext* nil "The current graphics context")
-(defvar *widget-id* nil "The current widget (set in with-pixmap)")
-(defvar *window* nil "The current window of the current widget (useful in drawing text.)")
+ (gtk-ffi::gtk-drawing-set-handlers (id self) (id self))) ; Could I arrange for data to be a pixmap or widget ???
(declaim (inline get-color))
(defun get-color (color-string)
(or (gethash color-string *colors*)
(error "No such color: ~A" color-string)))
-(defun init-graphics-context (widget)
- (loop for color in '("black" "white" "red" "green" "blue") ; see /usr/X11R6/lib/X11/rgb.txt
- for cobj = (gtk-adds-color-new) do
- (unless (= 1 (gdk-color-parse color cobj)) (error "unknown color: ~A" color))
- (setf (gethash color *colors*) cobj))
- (setf *gcontext* (gdk-gc-new (gtk-adds-widget-window widget)))
- (gdk-gc-set-rgb-fg-color *gcontext* (get-color "black"))
- (gdk-gc-set-rgb-bg-color *gcontext* (get-color "white"))
- (gdk-gc-set-line-attributes *gcontext* 3 0 0 0))
-
;(declaim (inline line-style))
(defun line-style (enum)
(ecase enum
@@ -218,5 +221,3 @@
(gdk-draw-drawable *window* *gcontext* pixmap 0 0 x y -1 -1))
(defvar *my-pixmap* nil)
-
-
diff -ur tmp/cells-gtk-0.1/gtk-ffi/gdk-other.lisp .sbcl/site/cells-gtk-0.1/gtk-ffi/gdk-other.lisp
--- tmp/cells-gtk-0.1/gtk-ffi/gdk-other.lisp 2006-06-30 10:22:55.000000000 -0400
+++ .sbcl/site/cells-gtk-0.1/gtk-ffi/gdk-other.lisp 2007-06-09 21:59:28.000000000 -0400
@@ -2,53 +2,56 @@
(in-package :gtk-ffi)
(def-gtk-lib-functions :gdk
- (gdk-gc-new ((drawable c-pointer))
- c-pointer)
- (gdk-draw-line ((drawable c-pointer)
- (gc c-pointer)
- (x1 int)
- (y1 int)
- (x2 int)
- (y2 int)))
- (gdk-pixmap-new ((drawable c-pointer)
- (width int)
- (height int)
- (depth int))
- c-pointer)
- (gdk-draw-drawable ((drawable c-pointer)
- (gc c-pointer)
- (src c-pointer)
- (xsrc int)
- (ysrc int)
- (xdest int)
- (ydest int)
- (width int)
- (height int)))
- (gdk-draw-rectangle ((drawable c-pointer)
- (gc c-pointer)
- (filled boolean)
- (x int)
- (y int)
- (width int)
- (height int)))
- (gdk-gc-set-rgb-fg-color ((gc c-pointer)
- (color c-pointer)))
- (gdk-gc-set-rgb-bg-color ((gc c-pointer)
- (color c-pointer)))
- (gdk-color-parse ((spec c-string)
- (color c-pointer))
- int)
- (gdk-draw-layout ((drawable c-pointer)
- (gc c-pointer)
- (x int)
- (y int)
- (pango-layout c-pointer)))
- (gdk-gc-set-line-attributes ((gc c-pointer)
- (line-width int)
- (line-style int)
- (cap-style int)
- (join-style int))))
-
-
-
-
+ (gdk-gc-new :pointer
+ ((drawable :pointer)))
+ (gdk-draw-line :void
+ ((drawable :pointer)
+ (gc :pointer)
+ (x1 :int)
+ (y1 :int)
+ (x2 :int)
+ (y2 :int)))
+ (gdk-pixmap-new :pointer
+ ((drawable :pointer)
+ (width :int)
+ (height :int)
+ (depth :int)))
+ (gdk-draw-drawable :void
+ ((drawable :pointer)
+ (gc :pointer)
+ (src :pointer)
+ (xsrc :int)
+ (ysrc :int)
+ (xdest :int)
+ (ydest :int)
+ (width :int)
+ (height :int)))
+ (gdk-draw-rectangle :void
+ ((drawable :pointer)
+ (gc :pointer)
+ (filled :boolean)
+ (x :int)
+ (y :int)
+ (width :int)
+ (height :int)))
+ (gdk-gc-set-rgb-fg-color :void
+ ((gc :pointer)
+ (color :pointer)))
+ (gdk-gc-set-rgb-bg-color :void
+ ((gc :pointer)
+ (color :pointer)))
+ (gdk-color-parse :int
+ ((spec :gtk-string)
+ (color :pointer)))
+ (gdk-draw-layout :void
+ ((drawable :pointer)
+ (gc :pointer)
+ (x :int)
+ (y :int)
+ (pango-layout :pointer)))
+ (gdk-gc-set-line-attributes :void
+ ((gc :pointer)
+ (line-width :int)
+ (line-style :int)
+ (cap-style :int)
+ (join-style :int))))
diff -ur tmp/cells-gtk-0.1/gtk-ffi/gtk-ffi.asd .sbcl/site/cells-gtk-0.1/gtk-ffi/gtk-ffi.asd
--- tmp/cells-gtk-0.1/gtk-ffi/gtk-ffi.asd 2006-12-17 18:09:27.000000000 -0500
+++ .sbcl/site/cells-gtk-0.1/gtk-ffi/gtk-ffi.asd 2007-06-09 21:50:24.000000000 -0400
@@ -21,4 +21,5 @@
(:file "gtk-tool" :depends-on ("gtk-ffi"))
(:file "gtk-menu" :depends-on ("gtk-ffi"))
(:file "gtk-list-tree" :depends-on ("gtk-ffi"))
- (:file "gtk-utilities" :depends-on ("gtk-core" "gtk-other"))))
+ (:file "gtk-utilities" :depends-on ("gtk-core" "gtk-other"))
+ (:file "gdk-other" :depends-on ("gtk-ffi"))))
diff -ur tmp/cells-gtk-0.1/gtk-ffi.asd .sbcl/site/cells-gtk-0.1/gtk-ffi.asd
--- tmp/cells-gtk-0.1/gtk-ffi.asd 2006-12-17 18:42:40.000000000 -0500
+++ .sbcl/site/cells-gtk-0.1/gtk-ffi.asd 2007-06-09 21:50:34.000000000 -0400
@@ -20,5 +20,6 @@
(:file "gtk-tool" :depends-on ("gtk-ffi"))
(:file "gtk-menu" :depends-on ("gtk-ffi"))
(:file "gtk-list-tree" :depends-on ("gtk-ffi"))
- (:file "gtk-utilities" :depends-on ("gtk-core" "gtk-other")))))
+ (:file "gtk-utilities" :depends-on ("gtk-core" "gtk-other"))
+ (:file "gdk-other" :depends-on ("gtk-ffi")))))
:depends-on (:cells :pod-utils :cffi :cffi-uffi-compat))
diff -ur tmp/cells-gtk-0.1/packages.lisp .sbcl/site/cells-gtk-0.1/packages.lisp
--- tmp/cells-gtk-0.1/packages.lisp 2006-06-30 10:22:55.000000000 -0400
+++ .sbcl/site/cells-gtk-0.1/packages.lisp 2007-06-09 22:53:01.000000000 -0400
@@ -32,7 +32,7 @@
#:push-message
#:pop-message
#:pulse
- #:gtk-drawing-set-handlers
+ ; #:gtk-drawing-set-handlers
#:*gcontext*
#:with-pixmap
#:with-gc
_______________________________________________
cells-gtk-devel site list
[email protected]
http://common-lisp.net/mailman/listinfo/cells-gtk-devel
