Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv7862

Modified Files: cello-window.lisp cello.lpr image.lisp ix-opengl.lisp ix-paint.lisp ix-togl.lisp window-utilities.lisp Log Message: CVS sucks

--- /project/cello/cvsroot/cello/cello-window.lisp 2006/07/03 00:35:12 1.2 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/08/21 04:28:26 1.3 @@ -20,31 +20,8 @@ ;

-(defmodel cello-window (celtk:window focuser) ;; control ogl-shared-resource-tender) +(defmodel cello-window (celtk:window focuser) ( -;;; (mouse-pos :initarg :mouse-pos :initform (c-in nil) :accessor mouse-pos) ;logical coords. Try to maintain for now. -;;; -;;; (mouse-view :initarg :mouse-view :accessor mouse-view -;;; :initform (c? (let ((mp (^mouse-pos))) -;;; (trc nil "mouseview sees pos" .w. mp) -;;; (when mp -;;; (eko (nil "mouseview >" self) -;;; (without-c-dependency -;;; (find-ix-under self mp))))))) -;;; -;;; (mouse-control :initarg :mouse-control :accessor mouse-control -;;; :initform (c? (bwhen (node (^mouse-view)) -;;; (eko (nil "possible mousecontrol" node) -;;; (fm-ascendant-if node #'fully-enabled))))) -;;; -;;; (mouse-cursor :initarg :mouse-cursor :initform nil :accessor mouse-cursor) -;;; -;;; (mouse-up-evt :cell :ephemeral :initarg :mouse-up-evt :initform (c-in nil) :accessor mouse-up-evt) -;;; (mouse-down-evt :cell :ephemeral :initarg :mouse-down-evt :initform (c-in nil) :accessor mouse-down-evt) -;;; (double-click? :initform (c-in nil) :accessor double-click?) -;;; -;;; (tick-count :initarg :tick-count :initform (c-in nil) :accessor tick-count) -;;; (tick-fine :initarg :tick-fine :initform (c-in nil) :accessor tick-fine) (gl-name-highest :cell nil :initarg :gl-name-highest :initform 0 :accessor gl-name-highest)) @@ -62,6 +39,10 @@ (defmethod path ((self cello-window)) ".") (defmethod parent-path ((self cello-window)) "")

+(defmethod g-offset ((self cello-window) &optional (accum-h 0) (accum-v 0)) + (declare (ignorable self)) + (mkv2 accum-h accum-v)) + (defmethod cello-window-event-handler (self xe) (declare (ignorable self)) (TRC nil "cello-window-event-handler" self (ctk::tk-event-type (ctk::xsv type xe)) ) @@ -76,7 +57,7 @@ (:KeyRelease ) (:ButtonPress ) (:ButtonRelease ) - (:MotionNotify ) + (:MotionNotify (trc "we got motion!!!!")) (:EnterNotify ) (:LeaveNotify ) (:FocusIn ) --- /project/cello/cvsroot/cello/cello.lpr 2006/07/24 05:00:35 1.10 +++ /project/cello/cvsroot/cello/cello.lpr 2006/08/21 04:28:26 1.11 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jul 11, 2006 4:27)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Aug 17, 2006 12:24)"; cg: "1.81"; -*-

(in-package :cg-user)

--- /project/cello/cvsroot/cello/image.lisp 2006/07/06 22:09:10 1.9 +++ /project/cello/cvsroot/cello/image.lisp 2006/08/21 04:28:26 1.10 @@ -17,7 +17,7 @@ (in-package :cello)

(eval-when (compile load eval) - (export '(ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy))) + (export '(ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy ^visible))) ; ------------------------------------------------------

(defmodel ogl-quadric-based (ogl-node) --- /project/cello/cvsroot/cello/ix-opengl.lisp 2006/07/06 22:09:10 1.3 +++ /project/cello/cvsroot/cello/ix-opengl.lisp 2006/08/21 04:28:26 1.4 @@ -44,10 +44,14 @@ (defmethod ogl-node-window (other) (c-break "ogl-node-window undefined for ~a" other))

+(export! .og. .ogc.) + (define-symbol-macro .og. (or (ogl-context self) (setf (ogl-context self) (upper self ctk::togl))))

+(define-symbol-macro .ogc. (togl-ptr .og.)) + (defmodel ogl-node () ((ogl-context :cell nil :initform nil :accessor ogl-context) (dsp-list :initarg :dsp-list :accessor dsp-list --- /project/cello/cvsroot/cello/ix-paint.lisp 2006/07/03 00:35:12 1.2 +++ /project/cello/cvsroot/cello/ix-paint.lisp 2006/08/21 04:28:26 1.3 @@ -17,22 +17,31 @@ (in-package :cello)

(defmethod ix-paint :after ((self family)) - (dolist (k (kids self)) - (trc nil "ixr geo" k (list (px k)(py k)) (list (ll k)(lt k)(lr k)(lb k))) - (trc nil "render kid pxy" k (px k)(py k) - :rpos-before (ogl-get-boolean gl_current_raster_position_valid) - (ogl-raster-pos-get)) - (c-assert (px k) () "pX is null in ~a" k) - (c-assert (py k) () "pY is null in ~a" k) + (let ((kids (kids self))) + (declare (ignorable kids)) + (block chk1 + (dolist (k kids) + (unless (find k (kids self)) + (trc "1. kid ~a amongst ~a, no longer amongst kids ~a" k kids (kids self)) + (break "1. kid ~a amongst ~a, no longer amongst kids ~a" k kids (kids self)) + (return-from chk1)))) + (dolist (k (kids self)) + (trc nil "ixr geo" k (list (px k)(py k)) (list (ll k)(lt k)(lr k)(lb k))) + (trc nil "render kid pxy" k (px k)(py k) + :rpos-before (ogl-get-boolean gl_current_raster_position_valid) + (ogl-raster-pos-get)) + (assert (find k (kids self))() "kid ~a no longer amongst kids ~a" k (kids self)) + (c-assert (px k) () "pX is null in ~a" k) + (c-assert (py k) () "pY is null in ~a" k)

- (if (dsp-list k) - (progn - (count-it :call-list) - (trc "ix-paint calling list" (dsp-list k)) - (gl-call-list (dsp-list k))) ; 06/0629 edit caret presences causes INVALID_OP on + (if (dsp-list k) + (progn + (count-it :call-list) + (trc "ix-paint calling list" (dsp-list k)) + (gl-call-list (dsp-list k))) ; 06/0629 edit caret presences causes INVALID_OP on ; first run only in a session; just continue from - (ix-paint k)))) + (ix-paint k)))))

(defun rpchk (id pfail psucc &optional self) (declare (ignorable pfail)) --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/07/06 22:09:10 1.3 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/08/21 04:28:26 1.4 @@ -22,6 +22,8 @@ ;------------- Window --------------- ;

+(export! mouse-view ^mouse-view mouse-pos ^mouse-pos mouse-control ^mouse-control) + (defmodel ix-togl ( #+not focuser ogl-lit-scene control ogl-shared-resource-tender togl ix-view) ( (redisplayp :cell nil :initarg :redisplayp :initform nil :accessor redisplayp) @@ -67,6 +69,9 @@ :event-handler 'ix-togl-event-handler ))

+(export! .togl) +(define-symbol-macro .togl (nearest self ix-togl)) + (defmethod ctk::togl-display-using-class ((self ix-togl)) (unless (or *ogl-listing-p* ;; re-entrance happens if a DLL puts up a MessageBox (c-stopped)) @@ -95,14 +100,16 @@ (:KeyPress ) (:KeyRelease ) (:ButtonPress - (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)(ctk::xbe-y xe))) ; trigger mouseview recalc + (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe) + (- (ctk::xbe-y xe)))) ; trigger mouseview recalc (setf (mouse-down-evt self) (make-os-event :modifiers (keyboard-modifiers .tkw) :where (mkv2 (ctk::xbe-x xe)(ctk::xbe-y xe)) :realtime (now)))) (:ButtonRelease ) (:MotionNotify - (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)(ctk::xbe-y xe)))) + (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe) + (- (ctk::xbe-y xe))))) (:EnterNotify ) (:LeaveNotify ) (:FocusIn ) @@ -223,7 +230,7 @@ (defparameter *mgw-far* -1500)

(defmethod ctk:togl-create-using-class ((self ix-togl)) - (setf (gl-name self) (car (gl-gen-lists 1))) + (setf (gl-name self) (gl-gen-lists 1)) (cello-gl-init) ;; clear errors ;;; ;;; #+profile (macrolet ((glm (param num) --- /project/cello/cvsroot/cello/window-utilities.lisp 2006/06/26 17:05:20 1.6 +++ /project/cello/cvsroot/cello/window-utilities.lisp 2006/08/21 04:28:26 1.7 @@ -101,12 +101,13 @@ (defun find-ix-under (self os-pos &key (test #'true)) (when (and (visible self) (not (collapsed self))) + (trc nil "find-ix-under" self os-pos (screen-box self)) (let ((inself (point-in-box os-pos (screen-box self)))) (or (when (or inself (not (clipped self))) (trc nil "inside self sbox" self os-pos (screen-box self)) (dolistreversed (k (kids self)) ;; overlap goes to last kid displayed (unless (typep k 'window) - (trc nil "fixunder kid" k) + (trc nil "fixunder kid!!!!!!!!" k) (bwhen (ix (find-ix-under k os-pos :test test)) (return-from find-ix-under ix)))))