Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv6473
Modified Files: cello-window.lisp cello.lisp cello.lpr ctl-markbox.lisp ctl-toggle.lisp frame.lisp image.lisp ix-canvas.lisp ix-layer-expand.lisp ix-opengl.lisp ix-styled.lisp ix-text.lisp ix-togl.lisp slider.lisp window-utilities.lisp wm-mouse.lisp Removed Files: ix-family.lisp Log Message:
--- /project/cello/cvsroot/cello/cello-window.lisp 2006/08/26 21:43:36 1.5 +++ /project/cello/cvsroot/cello/cello-window.lisp 2006/10/17 21:30:08 1.6 @@ -38,8 +38,8 @@ (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)) +(defmethod g-offset ((self cello-window) &optional (accum-h 0) (accum-v 0) within) + (declare (ignorable self within)) (mkv2 accum-h accum-v))
(defmethod cello-window-event-handler (self xe) --- /project/cello/cvsroot/cello/cello.lisp 2006/10/01 20:41:53 1.13 +++ /project/cello/cvsroot/cello/cello.lisp 2006/10/17 21:30:08 1.14 @@ -15,7 +15,7 @@ |#
-;;; $Id: cello.lisp,v 1.13 2006/10/01 20:41:53 fgoenninger Exp $ +;;; $Id: cello.lisp,v 1.14 2006/10/17 21:30:08 ktilton Exp $
;;; ============================================================================ @@ -67,11 +67,25 @@
#:ix-togl))
+(in-package :cello) + +;;; --- macros ----------------------------------------- +(export! .togl .og. .ogc. .retog.) + +(define-symbol-macro .togl (nearest self ix-togl)) + +(define-symbol-macro .og. + (or (ogl-context self) + (setf (ogl-context self) (nearest self ctk::togl)))) + +(define-symbol-macro .ogc. (togl-ptr .og.)) +(define-symbol-macro .retog. (when .ogc. (togl-post-redisplay .ogc.))) + ;;; ============================================================================ ;;; MISC ;;; ============================================================================
-(in-package :cello) +
(defmodel c-button (geometer ctk:button) () --- /project/cello/cvsroot/cello/cello.lpr 2006/09/05 18:43:56 1.13 +++ /project/cello/cvsroot/cello/cello.lpr 2006/10/17 21:30:08 1.14 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "8.0 [Windows] (Aug 24, 2006 21:48)"; cg: "1.81"; -*- +;; -*- lisp-version: "8.0 [Windows] (Oct 17, 2006 12:56)"; cg: "1.81"; -*-
(in-package :cg-user)
@@ -13,9 +13,9 @@ (make-instance 'module :name "frame.lisp") (make-instance 'module :name "application.lisp") (make-instance 'module :name "image.lisp") + (make-instance 'module :name "ix-togl.lisp") (make-instance 'module :name "ix-opengl.lisp") (make-instance 'module :name "ix-canvas.lisp") - (make-instance 'module :name "ix-family.lisp") (make-instance 'module :name "font.lisp") (make-instance 'module :name "ix-grid.lisp") (make-instance 'module :name "mouse-click.lisp") @@ -25,7 +25,6 @@ (make-instance 'module :name "focus-utilities.lisp") (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 "lighting.lisp") (make-instance 'module :name "ctl-toggle.lisp") (make-instance 'module :name "ctl-markbox.lisp") --- /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/10/02 02:59:18 1.7 +++ /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/10/17 21:30:08 1.8 @@ -33,12 +33,12 @@ :skin nil ;;(c? (skin .w.)) :pre-layer (with-layers (:in 4) - +lt-gray+ ;;;(if (^enabled) +white+ +gray+) + +light-gray+ ;;;(if (^enabled) +white+ +gray+) :off (:frame-3d :edge-sunken :thickness 4) :off - +dk-gray+ + +dark-gray+ (:out 4) (:x-mark (^md-value)))))
--- /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/10/13 05:57:27 1.5 +++ /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/10/17 21:30:08 1.6 @@ -28,7 +28,7 @@ :text-color (c? (if (^enabled) (if (^mouse-over-p) +green+ +black+) - +lt-gray+)) + +light-gray+)) :pre-layer (with-layers :off +white+ :fill (:rgba (^text-color)))))
@@ -51,7 +51,7 @@ :skin (c? (skin .w.)) :text-color (c? (cond ((not (^enabled)) +red+) - ((^depressed) +dk-gray+) + ((^depressed) +dark-gray+) (t +white+))) :pre-layer (c? (let* ((thick (min (u96ths 4) (* 0.08 (l-width self)))) (defl (if (clo::^depressed) (downs (/ thick 3)) 0)) @@ -77,7 +77,7 @@
(with-layers (:v3f (/ defl 2) defl push-in) - +lt-gray+ + +light-gray+ :on (:frame-3d :edge-raised :thickness thick) --- /project/cello/cvsroot/cello/frame.lisp 2006/10/02 02:59:18 1.4 +++ /project/cello/cvsroot/cello/frame.lisp 2006/10/17 21:30:08 1.5 @@ -121,6 +121,7 @@ (gl-vertex3f inr inb inz))) (flet ((render () (gl-translatef 0 0 (xlout thick)) + (gl-enable gl_lighting) (with-gl-begun (gl_quads) ;; top (cgl-normal :top @@ -151,13 +152,16 @@ (vrbi)(vrbo)(vrto)(vrti)
;; front - (cgl-normal :front - (- outr in) (+ outb (ups in)) inz - (- outr in) (+ outt (downs in)) inz - (+ outl in) (+ outt (downs in)) inz - )
- (vrti)(vlti)(vlbi)(vrbi) + #+nahhh ;; we're just doing the frame! + (progn + (cgl-normal :front + (- outr in) (+ outb (ups in)) inz + (- outr in) (+ outt (downs in)) inz + (+ outl in) (+ outt (downs in)) inz + ) + + (vrti)(vlti)(vlbi)(vrbi))
) (gl-translatef 0 0 (xlout thick)))) --- /project/cello/cvsroot/cello/image.lisp 2006/10/13 05:57:27 1.14 +++ /project/cello/cvsroot/cello/image.lisp 2006/10/17 21:30:08 1.15 @@ -17,7 +17,9 @@ (in-package :cello)
(eval-when (compile load eval) - (export '(mouse-over-p ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy a-stack a-row a-stack-lazy a-row-lazy ^visible))) + (export '(mouse-over-p ix-view ix-stack ix-row ix-stack-lazy ix-row-lazy + a-stack a-row a-stack-lazy a-row-lazy ^visible + skin ^skin))) ; ------------------------------------------------------
(defmodel ogl-quadric-based (ogl-node) @@ -84,7 +86,11 @@ (defmodel ix-zero-tl (geo-zero-tl ix-family)()) (defmodel ix-kid-sized (geo-kid-sized ix-family)()) (defmodel ix-inline (geo-inline ix-view)()) +(defobserver .kids ((self ix-inline)) + (when .togl .retog.)) (defmodel ix-inline-lazy (geo-inline-lazy ix-view)()) +(defobserver .kids ((self ix-inline-lazy)) + (when .togl .retog.))
(defmodel ix-stack (ix-inline) () @@ -106,6 +112,9 @@ (:default-initargs :orientation :horizontal))
+(eval-now! + (export '(a-stack a-row))) + (defmacro a-stack ((&rest stack-args) &body dd-kids) `(mk-part ,(gensym "STAK") (ix-stack) ,@stack-args @@ -185,7 +194,6 @@ (v2 (v2-h v)) (ix-view (inset-h (inset v)))))
- (defun inset-v (v) (etypecase v (number v) @@ -201,13 +209,14 @@ (setf (px self) (v2-h new-offset)) (setf (py self) (v2-v new-offset)))
-(defmethod g-offset ((self ix-view) &optional (accum-h 0) (accum-v 0)) + +(defmethod g-offset ((self ix-view) &optional (accum-h 0) (accum-v 0) within) (trc nil "goffset self" self 'px (px self) 'py (py self) 'fm-parent (fm-parent self)) (let ( (oh (+ accum-h (or (px self) 0))) (ov (+ accum-v (or (py self) 0))) ) - (if (null (fm-parent self)) + (if (eq within (fm-parent self)) ;; if within is nil we simply goto null parent (mkv2 oh ov) (g-offset (fm-parent self) oh ov))))
--- /project/cello/cvsroot/cello/ix-canvas.lisp 2006/07/06 22:09:10 1.4 +++ /project/cello/cvsroot/cello/ix-canvas.lisp 2006/10/17 21:30:08 1.5 @@ -133,14 +133,15 @@
;-------------------------------------------
-(defmethod g-offset ((self ix-canvas) &optional (accum-h 0) (accum-v 0)) +(defmethod g-offset ((self ix-canvas) &optional (accum-h 0) (accum-v 0) within) ;(trc "goffset self" self 'px (px self) 'py (py self) 'fm-parent (fm-parent self)) (if (fm-parent self) (g-offset (fm-parent self) (+ (res-to-res accum-h (target-res self) (enclosing-res self)) (or (px self) 0)) (+ (res-to-res accum-v (target-res self) (enclosing-res self)) - (or (py self) 0))) + (or (py self) 0)) + within) (mkv2 accum-h accum-v)))
(defmodel ix-root (ix-family) --- /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/07/24 05:00:35 1.7 +++ /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/10/17 21:30:08 1.8 @@ -35,16 +35,16 @@ (def-layer-expansion +dark-green+) (def-layer-expansion +green+) (def-layer-expansion +turquoise+) -(def-layer-expansion +dk-blue+) +(def-layer-expansion +dark-blue+) (def-layer-expansion +blue+) -(def-layer-expansion +lt-blue+) +(def-layer-expansion +light-blue+) (def-layer-expansion +black+) (def-layer-expansion +yellow+) -(def-layer-expansion +lt-yellow+) +(def-layer-expansion +light-yellow+) (def-layer-expansion +purple+) (def-layer-expansion +gray+) -(def-layer-expansion +lt-gray+) -(def-layer-expansion +dk-gray+) +(def-layer-expansion +light-gray+) +(def-layer-expansion +dark-gray+)
(defmethod ix-layer-expand ((key (eql :fill)) &rest args) --- /project/cello/cvsroot/cello/ix-opengl.lisp 2006/10/13 05:57:27 1.8 +++ /project/cello/cvsroot/cello/ix-opengl.lisp 2006/10/17 21:30:08 1.9 @@ -51,15 +51,7 @@ (defmethod ogl-node-window (other) (c-break "ogl-node-window undefined for ~a" other))
- -(export! .og. .ogc. .retog.) - -(define-symbol-macro .og. - (or (ogl-context self) - (setf (ogl-context self) (nearest self ctk::togl)))) - -(define-symbol-macro .ogc. (togl-ptr .og.)) -(define-symbol-macro .retog. (when .ogc. (togl-post-redisplay .ogc.))) +(export! ogl-context)
(defmodel ogl-node () ((ogl-context :cell nil :initform nil :accessor ogl-context) --- /project/cello/cvsroot/cello/ix-styled.lisp 2006/10/02 02:59:18 1.6 +++ /project/cello/cvsroot/cello/ix-styled.lisp 2006/10/17 21:30:08 1.7 @@ -16,7 +16,7 @@
(in-package :cello)
-(eval-when (compile load execute) +(eval-when (:compile-toplevel :load-toplevel :execute) (export '(with-styles)))
;;; (defclass Helper () @@ -155,4 +155,4 @@
-|# \ No newline at end of file +|# --- /project/cello/cvsroot/cello/ix-text.lisp 2006/10/13 05:57:27 1.10 +++ /project/cello/cvsroot/cello/ix-text.lisp 2006/10/17 21:30:08 1.11 @@ -81,11 +81,13 @@ (round (ftgl::ftgl-size font)) (ftgl::ftgl-target-res font))) (ix-string-width self (^display-text$)))))
-(defmacro alabel (text &rest key-arg-pairs) - `(cells::make-part (gensym "ALABEL") 'ix-text - ,@key-arg-pairs +(export! a-label) + +(defmacro a-label (text$ &rest key-arg-pairs) + `(make-kid 'ix-text + ,@key-arg-pairs :style-id :label - :text$ ,text)) + :text$ ,text$))
(defmethod display-text$ :around ((self ix-text)) (or (call-next-method) --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/10/13 05:57:27 1.12 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/10/17 21:30:08 1.13 @@ -69,10 +69,6 @@ :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)) @@ -103,11 +99,15 @@ (:ButtonPress (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe) (- (ctk::xbe-y xe)))) ; trigger mouseview recalc - (setf (mouse-down-evt self) (eko (nil "mousedown!!!") + (setf (mouse-down-evt self) (eko ("mousedown!!!" (ctk::xbe button xe)) (make-os-event :modifiers (keyboard-modifiers .tkw) :where (mouse-pos self) - :realtime (now))))) + :realtime (now) + :c-event xe))) + (when (eql 3 (ctk::xbe button xe)) + (when (^mouse-view) + (inspect (^mouse-view))))) (:ButtonRelease (setf (mouse-pos self) (mkv2 (ctk::xbe-x xe) (- (ctk::xbe-y xe)))) ; trigger mouseview recalc @@ -115,7 +115,8 @@ (make-os-event :modifiers (keyboard-modifiers .tkw) :where (mouse-pos self) - :realtime (now))))) + :realtime (now) + :c-event xe))))
(:MotionNotify (trc nil "setting mouse pos!!!!" (ctk::xbe-x xe) (- (ctk::xbe-y xe))) --- /project/cello/cvsroot/cello/slider.lisp 2006/06/26 17:05:20 1.4 +++ /project/cello/cvsroot/cello/slider.lisp 2006/10/17 21:30:08 1.5 @@ -37,7 +37,7 @@ (thumb-layers :initarg :thumb-layers :accessor thumb-layers :initform (with-layers (:out 24) :on - +lt-gray+ + +light-gray+ (:frame-3d :edge-raised :thickness (u96ths 3)))) (tracked-pct :initarg :tracked-pct :initform nil :accessor tracked-pct) @@ -45,7 +45,7 @@ (jumper-action :initarg :jumper-action :reader jumper-action :initform 'ix-slider-jumper-action) (jumper-layers :initarg :jumper-layers :reader jumper-layers - :initform (with-layers +lt-gray+ :on + :initform (with-layers +light-gray+ :on (:frame-3d :edge-raised :thickness (u96ths 3)))) ) --- /project/cello/cvsroot/cello/window-utilities.lisp 2006/08/31 17:34:47 1.8 +++ /project/cello/cvsroot/cello/window-utilities.lisp 2006/10/17 21:30:08 1.9 @@ -28,33 +28,11 @@ ;;(trc "*** No special do-double-click for ix-view, event:" self osEvent) nil)
-; ------------------- right button -------------------------------------- - (defun geo-dump (i) (when (typep i 'ix-view) (print (list :pxy (cons (px i)(py i)) :lt (lt i) :lb (lb i))) (geo-dump (fm-parent i))))
-(defmethod wm-rbuttondown ((w cello-window) buttons mouse-pos) - (declare (ignorable buttons mouse-pos)) - (bwhen (i (find-ix-under w mouse-pos)) - (trc "mpos ix=" i) - (unless (do-right-button i buttons mouse-pos) - (cond - ((control-key-down buttons) (geo-dump i)) - (t (print `(inspecting ,i)) - ;;(c-stop :inspecting) - (inspect i)))))) - -(defmethod do-right-button :around (self buttons wxwy) - (declare (ignorable buttons wxwy)) - (when self - (or (call-next-method) - (do-right-button (fm-parent self) buttons wxwy)))) - -(defmethod do-right-button (self buttons wxwy) - (declare (ignorable self buttons wxwy))) - (defmethod do-menu-right (self buttons wxwy) (declare (ignorable buttons self wxwy)))
@@ -69,9 +47,6 @@
; --------------- geometry -------------------------------
- - - (defun point-in-box (pt box) (and (<= (r-left box) (v2-h pt) (r-right box)) (>= (r-top box) (v2-v pt) (r-bottom box)))) --- /project/cello/cvsroot/cello/wm-mouse.lisp 2006/06/05 01:47:49 1.4 +++ /project/cello/cvsroot/cello/wm-mouse.lisp 2006/10/17 21:30:08 1.5 @@ -35,7 +35,8 @@ (:conc-name nil)) modifiers where - realtime) + realtime + c-event)
(defun mk-os-event (modifiers where) (make-os-event :modifiers modifiers @@ -51,6 +52,10 @@ (defun evt-where (os-event) (where os-event))
+(export! evt-c-event) +(defun evt-c-event (os-event) + (c-event os-event)) + (defun evt-wherex (os-event) (declare (optimize (speed 3) (safety 0) (debug 0))) ;; (logand (the fixnum (evtLParam os-event)) (1- 65536)) @@ -60,15 +65,6 @@ (declare (optimize (speed 3) (safety 0) (debug 0))) (v2-v (evt-where os-event)))
-(defmethod wm-lbuttonup ((w cello-window) modifiers mouse-pos) - (with-metrics (nil nil "win:WM_LBUTTONUP " w modifiers mouse-pos) - (setf (mouse-up-evt w) (mk-os-event modifiers mouse-pos)))) - -(defparameter *mouse-move-occupado* nil - "Vestigial? Under CG/Win32 mouse move could be received during mouse move") - -(defparameter *mouse-where* nil) -
-
ktilton