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