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