Update of /project/cells-gtk/cvsroot/root/cells-gtk In directory common-lisp:/tmp/cvs-serv30914/root/cells-gtk
Modified Files: drawing.lisp Log Message: Replaced hello-c stuff with cffi stuff
--- /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp 2006/01/03 19:03:33 1.3 +++ /project/cells-gtk/cvsroot/root/cells-gtk/drawing.lisp 2006/02/11 03:34:09 1.4 @@ -17,57 +17,58 @@
(in-package :gtk-ffi)
-(ffx:ff-defun-callable :cdecl :int drawing-expose-event-handler - ((drawing-area :pointer-void) (signal (* gdk-event-expose)) (data :pointer-void)) +(cffi:defcallback drawing-expose-event-handler :int + ((drawing-area :pointer) (signal :pointer) (data :pointer)) (declare (ignorable data signal gkd-event-expose widget)) - (bwhen (self (cgtk::gtk-object-find drawing-area)) - (cgtk::init-graphics-context drawing-area) - ;; POD This should draw the entire backing-pixmap - (gdk-draw-drawable - cgtk::*window* cgtk::*gcontext* - (funcall (funcall (intern "DRAW-FN" :cells-gtk) self) self) + (bwhen (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) - 0)) + 0))
- -(ffx:ff-defun-callable :cdecl :int drawing-button-events-handler - ((drawing-area :pointer-void) (signal (* gdk-event-button)) (data :pointer-void)) +(cffi:defcallback drawing-button-events-handler :int + ((drawing-area :pointer) (signal :pointer) (data :pointer)) (declare (ignorable data)) - (bwhen (self (cgtk::gtk-object-find drawing-area)) + (bwhen (self (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 (cgtk::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 (cgtk::button1-down self) nil)))) + (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)))) 0)
-(ffx:ff-defun-callable :cdecl :int drawing-pointer-motion-handler - ((drawing-area :pointer-void) (signal (* gdk-event-motion)) (data :pointer-void)) + +(cffi:defcallback drawing-pointer-motion-handler :int + ((drawing-area :pointer) (signal :pointer) (data :pointer)) (declare (ignorable data signal widget)) - (bwhen (self (cgtk::gtk-object-find drawing-area)) - (bwhen (button1 (cgtk::button1-down self)) - (let ((dx (- (truncate (gdk-event-motion-x signal)) (car button1))) - (dy (- (truncate (gdk-event-motion-y signal)) (cdr button1)))) - ;; POD NYI this should drag the thing closest to pointer, and redraw around it. - (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))))) + (bwhen (self (gtk-object-find drawing-area)) + (bwhen (button1 (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))))) 0)
+ (defun gtk-drawing-set-handlers (widget data) (gtk-signal-connect-swap widget "button-press-event" - (ffx:ff-register-callable 'drawing-button-events-handler) + (cffi:get-callback 'drawing-button-events-handler) :data data) (gtk-signal-connect-swap widget "button-release-event" - (ffx:ff-register-callable 'drawing-button-events-handler) + (cffi:get-callback 'drawing-button-events-handler) :data data) (gtk-signal-connect-swap widget "motion-notify-event" - (ffx:ff-register-callable 'drawing-pointer-motion-handler) + (cffi:get-callback 'drawing-pointer-motion-handler) :data data) (gtk-signal-connect-swap widget "expose-event" - (ffx:ff-register-callable 'drawing-expose-event-handler) + (cffi:get-callback 'drawing-expose-event-handler) :data data)) (export '(gtk-drawing-set-handlers))