[cello-cvs] CVS cello

ktilton ktilton at common-lisp.net
Tue Oct 17 21:30:08 UTC 2006


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)
       , at 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
-      , at key-arg-pairs
+(export! a-label)
+
+(defmacro a-label (text$ &rest key-arg-pairs)
+  `(make-kid 'ix-text
+     , at 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)
-
 
 
 




More information about the Cello-cvs mailing list