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

Modified Files: application.lisp cello-window.lisp cello.lpr ctl-toggle.lisp image.lisp ix-opengl.lisp ix-paint.lisp ix-text.lisp ix-togl.lisp nehe-06.lisp Log Message:

--- /project/cello/cvsroot/cello/application.lisp 2006/06/05 01:47:49 1.4 +++ /project/cello/cvsroot/cello/application.lisp 2006/07/03 00:35:12 1.5 @@ -22,7 +22,8 @@

(defun cello-reset (&optional (system-type 'mg-system)) (ffx-reset) - (cells-reset 'tk-client-queue-handler) + (cells-reset 'tk-user-queue-handler) + (makunbound 'ogl::*gl-stop*) (when system-type (setf *sys* (make-instance system-type :md-name 'mgsys))) (values)) --- /project/cello/cvsroot/cello/cello-window.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/07/03 00:35:12 1.2 @@ -72,7 +72,7 @@ ; (case (ctk::tk-event-type (ctk::xsv type xe)) (:virtualevent ) - (:KeyPress ) + (:KeyPress ) ;; this and next handled as app virtual events because Tcl events useless (:KeyRelease ) (:ButtonPress ) (:ButtonRelease ) --- /project/cello/cvsroot/cello/cello.lpr 2006/06/26 17:05:20 1.7 +++ /project/cello/cvsroot/cello/cello.lpr 2006/07/03 00:35:12 1.8 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Jun 21, 2006 9:54)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Jun 28, 2006 10:53)"; cg: "1.81"; -*-

(in-package :cg-user)

@@ -26,7 +26,6 @@ (make-instance 'module :name "ix-styled.lisp") (make-instance 'module :name "ix-text.lisp") (make-instance 'module :name "ix-togl.lisp") - (make-instance 'module :name "window-callbacks.lisp") (make-instance 'module :name "lighting.lisp") (make-instance 'module :name "ctl-toggle.lisp") (make-instance 'module :name "ctl-markbox.lisp") --- /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/06/05 01:47:49 1.2 +++ /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/07/03 00:35:12 1.3 @@ -111,6 +111,7 @@ )) :ll 0 :lt 0 :lr (u96ths 15) :lb (downs (u96ths 15))))

+ (defmacro mk-twisted (twisted-name (label-class &rest label-args) (twisted-class &rest twisted-args)) `(mk-part :twisted-group (ix-zero-tl) --- /project/cello/cvsroot/cello/image.lisp 2006/06/26 17:05:20 1.7 +++ /project/cello/cvsroot/cello/image.lisp 2006/07/03 00:35:12 1.8 @@ -17,7 +17,7 @@ (in-package :cello)

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

(defmodel ogl-quadric-based (ogl-node) @@ -69,8 +69,7 @@ ;;------- IXFamily ----------------------------- ;; (defmodel ix-family (ix-view family) - ( - (styles :initform nil :reader styles :initarg :styles) + ((styles :initform nil :reader styles :initarg :styles)

(effective-styles :reader effective-styles :initarg :effective-styles :initform nil #+(or) (ix-family-effective-styles)) @@ -80,33 +79,55 @@ (kids-ever-shown :initarg :kids-ever-shown :initform (c? (or .cache (^showkids))) - :reader kids-ever-shown) - )) + :reader kids-ever-shown)))

(defmodel ix-inline (geo-inline ix-view)()) +(defmodel ix-inline-lazy (geo-inline-lazy ix-view)())

(defmodel ix-stack (ix-inline) () (:default-initargs :orientation :vertical))

+(defmodel ix-stack-lazy (ix-inline-lazy) + () + (:default-initargs + :orientation :vertical)) + (defmodel ix-row (ix-inline) () (:default-initargs :orientation :horizontal))

+(defmodel ix-row-lazy (ix-inline-lazy) + () + (:default-initargs + :orientation :horizontal)) + (defmacro a-stack ((&rest stack-args) &body dd-kids) `(mk-part ,(copy-symbol 'stk) (ix-stack) ,@stack-args :fm-parent *parent* :kids (c? (the-kids ,@dd-kids))))

+(defmacro a-stack-lazy ((&rest stack-args) &body dd-kids) + `(mk-part ,(copy-symbol 'stk) (ix-stack-lazy) + ,@stack-args + :fm-parent *parent* + :kids (c? (the-kids ,@dd-kids)))) + (defmacro a-row ((&rest stack-args) &body dd-kids) `(mk-part ,(copy-symbol 'row) (ix-row) ,@stack-args :fm-parent *parent* :kids (c? (the-kids ,@dd-kids))))

+(defmacro a-row-lazy ((&rest stack-args) &body dd-kids) + `(mk-part ,(copy-symbol 'row) (ix-row-lazy) + ,@stack-args + :fm-parent *parent* + :kids (c? (the-kids ,@dd-kids)))) + (defmethod focus-starting ((self ix-family)) (some #'focus-find-first (kids self)))

@@ -115,13 +136,7 @@ `(let* ((,kid ,self)) (find-prior ,kid (kids (fm-parent ,kid))))))

-(defmethod md-awaken :after ((self ix-view)) - (assert (px self)) - (assert (py self)) - (assert (ll self)) - (assert (lt self)) - (assert (lr self)) - (assert (lb self))) +

(defmethod ogl-shared-resource-tender ((self ix-view)) .w.) @@ -164,6 +179,7 @@ (v2 (v2-h v)) (ix-view (inset-h (inset v)))))

+ (defun inset-v (v) (etypecase v (number v) @@ -190,7 +206,7 @@ (g-offset (fm-parent self) oh ov))))

(defun w-bottom-left (self) - (v2-move (g-offset self) + (v2-add (g-offset self) (ll self) (+ (lb self) (l-height .w.))))

--- /project/cello/cvsroot/cello/ix-opengl.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/ix-opengl.lisp 2006/07/03 00:35:12 1.2 @@ -55,7 +55,7 @@ (defmodel ogl-node () ((ogl-context :cell nil :initform nil :accessor ogl-context) (dsp-list :initarg :dsp-list :accessor dsp-list - :initform (c-formula (:lazy :until-asked) + :initform nil #+not (c-formula (:lazy :until-asked) (assert (not *ogl-listing-p*)) (progn (ogl-dsp-list-prep self) @@ -66,12 +66,12 @@ (*ogl-shared-resource-tender* (ogl-shared-resource-tender self))) (gl-new-list display-list-name gl_compile) - (trc nil "starting display list" display-list-name self) + (trc nil "---------------starting display list" display-list-name self) (let ((*ogl-listing-p* self) *selecting* *render-clip-l* *render-clip-r* *render-clip-t* *render-clip-b*) (with-metrics (nil nil "ix-paint" self) (ix-paint self))) - (trc nil "finished display list" display-list-name self) + (trc nil "---------------finished display list" display-list-name self) (gl-end-list) (setf (redisplayp .og.) t) display-list-name))))) --- /project/cello/cvsroot/cello/ix-paint.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/ix-paint.lisp 2006/07/03 00:35:12 1.2 @@ -25,11 +25,13 @@ (c-assert (px k) () "pX is null in ~a" k) (c-assert (py k) () "pY is null in ~a" k)

- (count-it :call-list) + (if (dsp-list k) (progn - (trc nil "ix-paint calling list" (dsp-list k)) - (gl-call-list (dsp-list k))) + (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))))

(defun rpchk (id pfail psucc &optional self) @@ -50,6 +52,7 @@ (let ((ixr-box (mkr 0 0 0 0))) (defmethod ix-paint :around ((self ix-view) &aux (n (gl-name self))) (trc nil "painting, shifting bitmap" self n (^px)(^py) (pre-layer self)) + (with-bitmap-shifted ((px self)(py self)) (gl-translatef (px self) (py self) 0)

@@ -69,6 +72,55 @@ (count-it :ix-render) #+(or) (count-it :ix-paint (type-of self)) #+(or) (unless (kids self) + (count-it :ix-render-atom)) + (trc nil "ix painting" self (^px)(^py)(l-box self)) + (with-matrix () + (with-ogl-isolation + (case (lighting self) ;; default is "same as parent" + (:on (gl-enable gl_lighting)) + (:off (gl-disable gl_lighting))) + + (gl-enable gl_color_material) + (bif (pre-layer (pre-layer self)) + (progn + (assert (functionp pre-layer)) + (count-it :pre-layer) + (nr-make ixr-box (ll self) (lt self) (lr self) (lb self)) + + (funcall pre-layer self ixr-box :before) + (call-next-method self) + (funcall pre-layer self ixr-box :after)) + (call-next-method self))))))) + (when n + (gl-pop-name)) + (gl-translatef (- (px self)) (- (py self)) 0)) + + )) + +#+new +(let ((ixr-box (mkr 0 0 0 0))) + (defmethod ix-paint :around ((self ix-view) &aux (n (gl-name self))) + (trc nil "painting, shifting bitmap" self n (^px)(^py) (pre-layer self)) + (when (or (c-stopped) + (not (^visible)) + (collapsed self)) + (return-from ix-paint)) + + (with-bitmap-shifted ((px self)(py self)) + (gl-translatef (px self) (py self) 0) + + + (when n + (trc "pushing gl-name" self n) + (gl-push-name n)) + + (rpchk 'ix-paint t nil self) + (when (or (not *selecting*)(ix-selectable self)) + (progn ;;with-clipping (self) + (progn ;; with-attrib (gl_lighting_bit gl_texture_bit gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit) + (count-it :ix-render) + #+(or) (count-it :ix-paint (type-of self)) + #+(or) (unless (kids self) (count-it :ix-render-atom)) (trc nil "ix painting" self (lighting self)) (with-matrix () --- /project/cello/cvsroot/cello/ix-text.lisp 2006/06/26 17:05:20 1.6 +++ /project/cello/cvsroot/cello/ix-text.lisp 2006/07/03 00:35:12 1.7 @@ -19,7 +19,7 @@ ;===========================================================

(eval-when (compile load eval) - (export '(ix-paint))) + (export '(ix-paint inset)))

(defmodel ix-text (ix-styled ix-view) ( @@ -51,7 +51,8 @@

(inset :cell nil :initarg :inset :unchanged-if 'v2= - :initform (mkv2 0 0)) + :initform (mkv2 0 0) + :accessor inset) (ll :initform (c? (- (inset-h self)))) (lt :initform (c? (ups 0 (font-ascent (text-font self)) (inset-v self)))) (lr :initform (c? (^lr-width (+ (cond --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/06/26 17:05:20 1.1 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/07/03 00:35:12 1.2 @@ -85,6 +85,8 @@ (trc nil "window-display > continuous specified so posting redisplay" self) (ctk:togl-post-redisplay (ctk:togl-ptr self))))))

+ + (defmethod ix-togl-event-handler (self xe) "Tk does not go inside Togl OpenGL-land, so Cello Classic effectively begins here" (TRC nil "ix-togl-event-handler" self (ctk::tk-event-type (ctk::xsv type xe)) ) --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/06/26 17:05:20 1.5 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/07/03 00:35:12 1.6 @@ -142,7 +142,7 @@ (gl-tex-coord2f 1 1) (v3f -1 1 1) (gl-tex-coord2f 0 1) (v3f -1 1 -1) )) - #+ifuwanttoseepixmap + ;;#+ifuwanttoseepixmap (wand-render *grace* 0 0 1 -1)

(progn @@ -171,7 +171,7 @@ (setf *skin6* (mgk:wand-ensure-typed 'wand-texture (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels - (test-image "turing" "gif")))) + (test-image "grace" "jpg")))) ; "turing" "gif"))))

(defun print-frame-rate (window) (with-slots (frame-count t0) window @@ -188,8 +188,8 @@ (setq t0 time) (setq frame-count 0)))))

-(defun test-image (filename filetype) +(defun test-image (filename filetype &optional (subdir "shapers")) (make-pathname - :directory '(:absolute "0dev" "user" "graphics" "shapers") + :directory `(:absolute "0dev" "user" "graphics" ,subdir) :name (string filename) :type (string filetype)))