[cells-cvs] CVS Celtk

[ktilton]

Update of /project/cells/cvsroot/Celtk
In directory clnet:/tmp/cvs-serv8987

Modified Files:
	CELTK.lpr tk-events.lisp togl.lisp widget.lisp 
Log Message:


--- /project/cells/cvsroot/Celtk/CELTK.lpr	2006/07/24 05:04:01	1.18
+++ /project/cells/cvsroot/Celtk/CELTK.lpr	2006/08/21 04:30:22	1.19
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "8.0 [Windows] (Jul 19, 2006 19:38)"; cg: "1.81"; -*-
+;; -*- lisp-version: "8.0 [Windows] (Aug 17, 2006 12:24)"; cg: "1.81"; -*-
 
 (in-package :cg-user)
 
--- /project/cells/cvsroot/Celtk/tk-events.lisp	2006/06/03 12:04:37	1.5
+++ /project/cells/cvsroot/Celtk/tk-events.lisp	2006/08/21 04:30:23	1.6
@@ -89,6 +89,8 @@
   :DeactivateNotify
   :MouseWheelEvent)
 
+
+
 (defcenum tk-event-mask
     "Use to filter events when calling tk-create-event-handler"
   :NoEventMask		
--- /project/cells/cvsroot/Celtk/togl.lisp	2006/07/25 10:53:41	1.16
+++ /project/cells/cvsroot/Celtk/togl.lisp	2006/08/21 04:30:23	1.17
@@ -146,6 +146,7 @@
   (:default-initargs
       :double t
     :rgba t
+    :alpha t
     :id (gentemp "TOGL")
     :ident (c? (^path))))
 
@@ -183,8 +184,7 @@
 
 (def-togl-callback create ()
   (trc nil "!!!!!!!!!!!!!!!!!! about to install togl-ptr!!!!!!!!!!!!!!!!!!" togl-ptr self)
-  (setf (togl-ptr self) (setf cl-ftgl::*ftgl-ogl* ;; help debug failure to use lazy cells/classes to defer FTGL till Ogl ready
-                          togl-ptr))
+  (setf cl-ftgl::*ftgl-ogl* togl-ptr) ;; help debug failure to use lazy cells/classes to defer FTGL till Ogl ready
 
   (setf (togl-ptr self) togl-ptr)
   (setf (gethash (pointer-address togl-ptr) (tkwins *tkw*)) self))
--- /project/cells/cvsroot/Celtk/widget.lisp	2006/07/06 22:10:40	1.16
+++ /project/cells/cvsroot/Celtk/widget.lisp	2006/08/21 04:30:23	1.17
@@ -77,12 +77,18 @@
 (defun tk-create-event-handler-ex (widget callback-name &rest masks)
   (let ((self-tkwin (widget-to-tkwin widget)))
     (assert (not (null-pointer-p self-tkwin)))
-    (trc nil "setting up widget virtual-event handler" widget :tkwin self-tkwin)
+    (trc nil "setting up widget virtual-event handler" widget callback-name :tkwin self-tkwin :masks masks)
+    (tk-create-event-handler self-tkwin
+      (foreign-masks-combine 'tk-event-mask :PointerMotionMask)
+      (get-callback callback-name)
+      self-tkwin)
     (tk-create-event-handler self-tkwin
       (apply 'foreign-masks-combine 'tk-event-mask masks)
       (get-callback callback-name)
       self-tkwin)))
 
+
+
 (defun widget-menu (self key)
   (or (find key (^menus) :key 'md-name)
     (break "The only menus I see are~{ ~a,~} not requested ~a" (mapcar 'md-name (^menus)) key)))
@@ -124,12 +130,11 @@
     (trc "widget-event-handler > no widget for tkwin ~a" client-data)))
 
 (defmethod widget-event-handle ((self widget) xe) ;; override for class-specific handling
+  (trc nil "bingo widget-event-handle" (xevent-type xe))
   (bif (h (^event-handler)) ;; support instance-specific handlers
     (funcall h self xe)
-    #+shhh (case (xevent-type xe)
-      (:buttonpress
-       (trc "button pressed:" (xbe button xe)(xbe x xe)(xbe y xe)(xbe x-root xe)(xbe y-root xe)))
-      
+    (case (xevent-type xe)
+      (:buttonpress (trc "button pressed:" (xbe button xe)(xbe x xe)(xbe y xe)(xbe x-root xe)(xbe y-root xe)))
       (:buttonrelease (trc "button released:" (xbe button xe)(xbe x xe)(xbe y xe)(xbe x-root xe)(xbe y-root xe)))(:MotionNotify
        (xevent-dump xe))
       (:virtualevent))))