[cello-cvs] CVS cello
ktilton
ktilton at common-lisp.net
Mon Aug 21 04:28:27 UTC 2006
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)))))
More information about the Cello-cvs
mailing list