[cells-cvs] CVS update: cell-cultures/cello/cello-ftgl.lisp cell-cultures/cello/cello-magick.lisp cell-cultures/cello/cello.lisp cell-cultures/cello/cello.lpr cell-cultures/cello/ct-scroll-bar.lisp cell-cultures/cello/ct-scroll-pane.lisp cell-cultures/cello/ctl-drag.lisp cell-cultures/cello/ctl-markbox.lisp cell-cultures/cello/ctl-selectable.lisp cell-cultures/cello/ctl-toggle.lisp cell-cultures/cello/image.lisp cell-cultures/cello/ix-family.lisp cell-cultures/cello/ix-geometry.lisp cell-cultures/cello/ix-grid.lisp cell-cultures/cello/ix-inline.lisp cell-cultures/cello/ix-render.lisp cell-cultures/cello/ix-styled.lisp cell-cultures/cello/menu.lisp cell-cultures/cello/pick.lisp cell-cultures/cello/to-do.lisp cell-cultures/cello/window-callbacks.lisp cell-cultures/cello/window.lisp
Kenny Tilton
ktilton at common-lisp.net
Fri Oct 15 03:37:30 UTC 2004
Update of /project/cells/cvsroot/cell-cultures/cello
In directory common-lisp.net:/tmp/cvs-serv28025/cello
Modified Files:
cello-ftgl.lisp cello-magick.lisp cello.lisp cello.lpr
ct-scroll-bar.lisp ct-scroll-pane.lisp ctl-drag.lisp
ctl-markbox.lisp ctl-selectable.lisp ctl-toggle.lisp
image.lisp ix-family.lisp ix-geometry.lisp ix-grid.lisp
ix-inline.lisp ix-render.lisp ix-styled.lisp menu.lisp
pick.lisp to-do.lisp window-callbacks.lisp window.lisp
Log Message:
Re-write of the core layout widgets under the ix-inline class, plus a new OpenGL example, viz., a simple nurb. Looks sweet, btw.
Date: Fri Oct 15 05:37:22 2004
Author: ktilton
Index: cell-cultures/cello/cello-ftgl.lisp
diff -u cell-cultures/cello/cello-ftgl.lisp:1.3 cell-cultures/cello/cello-ftgl.lisp:1.4
--- cell-cultures/cello/cello-ftgl.lisp:1.3 Fri Oct 1 06:01:05 2004
+++ cell-cultures/cello/cello-ftgl.lisp Fri Oct 15 05:37:21 2004
@@ -188,8 +188,6 @@
:clipped nil
:kids (c? (loop for mode in '(:bitmap :pixmap :texture :outline :polygon :extruded)
collect (mk-part :rb (ct-radio-labeled)
- :text-font (font-ftgl-ensure :texture
- *gui-style-default-face* 12)
:associated-value mode
:title$ (string-capitalize
(format nil "~d" mode))))))
@@ -198,7 +196,8 @@
:kids (c? (the-kids
(loop repeat cols
collecting
- (mk-part :fstk (ix-stack)
+ (mk-part :fstk (ix-inline)
+ :orientation :vertical
:kids (c? (let ((col-no (kid-no self)))
(loop for row-no below (ceiling (length fns) cols)
when (mk-font-show col-no row-no)
Index: cell-cultures/cello/cello-magick.lisp
diff -u cell-cultures/cello/cello-magick.lisp:1.2 cell-cultures/cello/cello-magick.lisp:1.3
--- cell-cultures/cello/cello-magick.lisp:1.2 Fri Oct 1 06:01:05 2004
+++ cell-cultures/cello/cello-magick.lisp Fri Oct 15 05:37:21 2004
@@ -26,8 +26,9 @@
(eval-when (compile load eval)
(defmethod ix-layer-expand ((key (eql :wand)) &rest args)
- `(progn ;; (cells::trc "ix-layer-expand draw wand for" self)
- (ix-render-wand ,(car args) l-box))))
+ `(let ((wand ,(car args)))
+ (cells::trc nil "ix-layer-expand draw wand for" self wand)
+ (ix-render-wand wand l-box))))
(def-c-output recording ()
(when old-value
Index: cell-cultures/cello/cello.lisp
diff -u cell-cultures/cello/cello.lisp:1.1 cell-cultures/cello/cello.lisp:1.2
--- cell-cultures/cello/cello.lisp:1.1 Sun Jul 4 20:59:40 2004
+++ cell-cultures/cello/cello.lisp Fri Oct 15 05:37:21 2004
@@ -32,217 +32,7 @@
#:cl-opengl
)
;;; (:shadowing-import-from #:excl #:fasl-write #:fasl-read #:gc)
-
- (:export access-allowed resource-key-held accesscontrol focus-shared-by
- ct-toggle-choice-controlaction
- ct-zoomers zoom-step zoom-limit
- make-foldertab ct-toggle-choice
- ix-shadow client client-offset ^client-offset
- ix-ensure-in-view-image
-
- ^parent-height ^parent-width
- open-browser-with-file clipped turn-edit-active
- content ^content caret-rect ^caret-rect edit-requires-activation edit-ip-compute
- canvas text-font ^sel-rect ^text-font ix-string-width font-caret-height nres-to-res nr-offset
- column-spacing pb cs-waiting-ex
- lvalue-in-frame-h lvalue-in-frame-v
- cttext-find-ip-fixed cttext-find-ip-variable
- s-focuser wdw swdw focuser focus-text-mini focuser focus ^focus ^focused-on
- ctl-handle-over focus-editactive-do ct-selector-stack ct-selector-row
- mk-twisted-part mk-twisted do-virtual-key-functions selector
- ix-bar-chart ix-detail key-evt ^key-evt initialselection-first
- ix-canvas ix-canvas-nested ix-canvas-parent-sized ix-canvas-kid-sized s-canvas w-kill edit-requires-activation
- ct-edit-caret ^textual-focus ^edit-active ix-edit-selection
- ix-blob ix-dd-bitmap ig-splitter ix-icon
- folder-tab-grid folder-tab
- ct-tab-header ix-details ^details ix-details-column ix-details-column-ex column-specs ^column-specs
- ct-fsm-assume-value fully-enabled markbox-frame associated-value
- ct-polygon ct-scroll-rocker ct-scroll-pane igscroller ix-scroller-multi a-scroller ^scroll-stepv2
- ix-scroll-bar-hz ix-scroll-bar-vt ix-scroll-fill
- ct-key-valued ct-details ct-icon
- ^make-ix-detail-columns make-ix-details do-click
- with-one-invalidation with-modality
- canvas-to-screen-point canvas-to-screen-rect
- nr-outset current-folder focus-minded
- focus-lose focus-gain a-stack-of-kids
- ^lbmax? ^lrmax?
- inset-h inset-v openstate
- row-padding wrap$
- inset outset with-window-message
- ix-stack-of-kids
- focus-debug
- buttons-shifted gunscaled
- kbd-modifiers ^kbd-modifiers
- ll lt lr lb ^ll ^lt ^lr ^lb l-rect
- l-height
- ^prior-sib
- l-width ^best-fit-targetres
- px ^px *mouse-where*
- py ^py
- ^dd-bit-map
- visible collapsed layers
- ^visible ^collapsed ^layers
- was-handled
-
- ^py-maintain-pt ^px-maintain-pl
- ^centered-h? ^centered-v?
- ^px-maintain-pr ^py-maintain-pb
- ^lr-maintain-pr ^lr-width ^insetlr ^inset-width ^fillright ^fill-right-type ^fill-down ^inset-height
- ^fill-parent-right ^fill-parent-down
-
-
- ^prior-sib-pb ^cell-pr ^cell-width
-
- mk-gr g-offset g-offset-h g-offset-v offset-within
-
- ^inset-lb
- ^lb-maintain-pb ^lb-height find-ix-under pr
- colpadding all-cell-width ix-orientation-opposite
- selection-set1 v2-xlate selection-set
- do-gpprint
- current-tab
- ix-table
- radio-on-name
-
-
- frame :black :red
-
- focused-on focus-thickness focus ^focus focus-change
- edit-active
- focused-descendant focus-family focus-find-first ;; /// vestigial?
- focus-navi-leave focus-navigate
- tabstopp tab-mode
-
- ;;; userActivity ^userActivity
-
- multi-text cello-reset
-
- ix-text
- ;-----
- text$ ^text$
- char-mask ^char-mask
- maxcharwidth ^maxcharwidth
- justify-hz ^justify-hz justify-vt ^justify-vt
- im-label
-
- ht-phrase
- ^px-self-centered spacing-hz
- ^py-self-centered
-
- ix-text-tall
- ;---------
- text-height ^text-height
- formatted$ ^formatted$
-
- ix-family
- ;-------
- styles ^styles
- effective-styles ^effective-styles
- showkids ^showkids
- kids-ever-shown ^kids-ever-shown
-
- ig-zero-tl ix-kid-sized im-matrix ix-oriented im-oriented-cell
- ix-stack ig-row ix-row ix-row-flow ix-row-fv
-
- image ix-bits backpict ^backpict texturearrayinfo ^texturearrayinfo
- im-pix-file
-
- target-res ^target-res
-
- ix-grid
- ;-----
- col-ct ^col-ct
- all-cell-width ^all-cell-width
- all-cell-height ^all-cell-height
- row-offsets ^row-offsets
- col-offsets ^col-offsets
- row-justifys ^row-justifys
- col-justifys ^col-justifys
- html-to-parts
-
- ix-paint
-
- control
- ;------
- click-evt ^click-evt ^in-drag
- title$ ^title$ enabled ^enabled hilited ^hilited
- control-do-action
-
- ct-button ct-check-text
-
- ct-drag
-
- ct-sizer ct-tab-stop
-
- ct-folder ix-folder
-
- ctfsm ct-mark-box ct-check-box ct-check-text ct-radio-button ct-radio
- ct-reorienter ct-twister
- ct-tab-stop-bar ^ix-orientation tabdefs ^tabdefs fixed ^fixed
-
- ct-selectable ^selected
-
- ct-exclusive ct-multi-choice
- ct-label ct-label-multi-choice ct-label-exclusive
- ct-text
- user-text$ ^user-text$
- insertion-pt ^insertion-pt
- ^caret sm-echo-caret
- sel-end ^sel-end sel-rect ^sel-rect sel-range ^sel-range sm-echo-selrange
-
- ct-selector
- selection ^selection
- selection-focus ^selection-focus
-
- tree-view tv-node-directory
-
- ct-file-drawer drawer-values ^drawer-values ^selectedp
- cell-col col-head cell-row row-head
-
- a-row a-stack
-
- states make-os-event-buttons-where no-echo-text
-
- mg-window-activate swindow window
-
- do-menu-right make-menu-right-items menu-right-select menu-shortc
-
- current-app-universal-time user-preferences
-
- getcurrentthread getthreadpriority setthreadpriority
- getcurrentprocess getpriorityclass setpriorityclass
-
- alabel ac-make-font make-style
- ix-tabbed-row a-tabbed-row archosw mg-system
- tn-browser mktabheaders
-
- ;--- ooops ---------
- make-tv-node
- ^tick-count
- tv-tree-node-type
- context-cursor
- do-virtual-key
- ^folder-tab-title$
- tick-count
- ctradio-turn-to
- ix-folder-kids
- ^focused-descendant
- wants-caret
-
- ^fm-parent
- ix-paint-string
- pg-no
- focus-on focus-get ix-ensure-in-view
- user-pref-set user-pref ^user-pref user-pref-toggle
- sampleprinter
- do-double-click do-right-button
- folder-tab-tab-view
- mouse-pos ^mouse-pos mouse-image ^mouse-image
-
- progress-tracker status-text percent-complete *progress-stepper*
-
-
- ))
+ )
(in-package :cello)
Index: cell-cultures/cello/cello.lpr
diff -u cell-cultures/cello/cello.lpr:1.2 cell-cultures/cello/cello.lpr:1.3
--- cell-cultures/cello/cello.lpr:1.2 Sun Jul 4 20:59:40 2004
+++ cell-cultures/cello/cello.lpr Fri Oct 15 05:37:21 2004
@@ -1,4 +1,4 @@
-;; -*- lisp-version: "6.2 [Windows] (May 12, 2004 22:13)"; common-graphics: "1.389.2.105.2.14"; -*-
+;; -*- lisp-version: "6.2 [Windows] (Sep 3, 2004 12:04)"; common-graphics: "1.389.2.105.2.14"; -*-
(in-package :common-graphics-user)
@@ -21,7 +21,6 @@
(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-inline.lisp")
(make-instance 'module :name "ix-grid.lisp")
(make-instance 'module :name "mouse-click.lisp")
(make-instance 'module :name "control.lisp")
Index: cell-cultures/cello/ct-scroll-bar.lisp
diff -u cell-cultures/cello/ct-scroll-bar.lisp:1.1 cell-cultures/cello/ct-scroll-bar.lisp:1.2
--- cell-cultures/cello/ct-scroll-bar.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ct-scroll-bar.lisp Fri Oct 15 05:37:21 2004
@@ -24,59 +24,53 @@
(defmodel ct-scroll-bar (control ix-inline)
((overflow :accessor overflow
- :initform (c? (ecase (md-name self)
- (:hz (/ (l-width (content .parent))
+ :initform (c? (ecase (orientation self)
+ (:horizontal (/ (l-width (content .parent))
(l-width (kid1 .parent))))
- (:vt (/ (l-height (content .parent))
- (l-height (kid1 .parent)))))))
+ (:vertical (/ (l-height (content .parent))
+ (l-height (kid1 .parent)))))))
(pct-scrolled :reader pct-scrolled
:initform (c? (md-value (find :sbar-slider (^kids) :key 'md-name))))
(scroll-handler :cell nil :initarg :scroll-handler :reader scroll-handler
:initform (lambda (self scroll-pct)
(let ((mgr (scroll-manager self)))
- (ecase (md-name self)
- (:hz (setf (px (content mgr))
+ (ecase (orientation self)
+ (:horizontal (setf (px (content mgr))
(* scroll-pct (v2-h (scroll-max mgr)))))
- (:vt (setf (py (content mgr))
+ (:vertical (setf (py (content mgr))
(* scroll-pct (v2-v (scroll-max mgr)))))))))
)
(:default-initargs
;;:pre-layer (with-layers +white+ :fill)
:justify :center
- :kids (c? (the-kids
- (funcall (if (mac-p (upper self ix-scroller))
- 'identity 'nreverse)
- (list (scroll-bar-slider (md-name self))
- (scroll-bar-stepper (md-name self) :home)))
- (scroll-bar-stepper (md-name self) :end)))
- :kid-slots (lambda (self)
- (assert (eql :center (justify .parent)))
- (ecase (md-name .parent)
- (:hz (kid-slots-rowing))
- (:vt (kid-slots-stacking))))
-
+ :kids (c? (the-kids
+ (funcall (if (mac-p (upper self ix-scroller))
+ 'identity 'nreverse)
+ (list (scroll-bar-slider (orientation self))
+ (scroll-bar-stepper (md-name self) :home)))
+ (scroll-bar-stepper (md-name self) :end)))
:visible (c? (> (^overflow) 1))
;;:collapsed (c? (not (^visible)))
- :px (c? (ecase (md-name self)
- (:hz 0)
- (:vt (px-maintain-pr (inset-lr .parent)))))
- :py (c? (ecase (md-name self)
- (:vt 0)
- (:hz (py-maintain-pb (inset-lb .parent)))))
+ :px (c? (ecase (orientation self)
+ (:horizontal 0)
+ (:vertical (px-maintain-pr (inset-lr .parent)))))
+ :py (c? (ecase (orientation self)
+ (:vertical 0)
+ (:horizontal (py-maintain-pb (inset-lb .parent)))))
:ll 0 :lt 0
-
- :lr (c? (ecase (md-name self)
- (:hz (- (inset-lr .parent)
- (if (or (resize-range .parent)
- (scrolls-p .parent :vt))
- *sbar-thickness* 0)))
- (:vt *sbar-thickness*)))
- :lb (c? (ecase (md-name self)
- (:vt (+ (inset-lb .parent)
- (if (or (resize-range .parent)
- (scrolls-p .parent :hz) )
- (ups *sbar-thickness*) 0)))
- (:hz (downs *sbar-thickness*))))))
+
+ :lr (c? (ecase (orientation self)
+ (:horizontal (- (inset-lr .parent)
+ (if (or (resize-range .parent)
+ (scrolls-p .parent :vertical))
+ *sbar-thickness* 0)))
+ (:vertical *sbar-thickness*)))
+ :lb (c? (ecase (orientation self)
+ (:vertical (+ (inset-lb .parent)
+ (if (or (resize-range .parent)
+ (scrolls-p .parent :horizontal) )
+ (ups *sbar-thickness*) 0)))
+ (:horizontal (downs *sbar-thickness*))))))
(def-c-output pct-scrolled ()
@@ -88,7 +82,8 @@
(defun scroll-bar-slider (hz-vt-value)
(macrolet ((hz-vt (hz-form vt-form)
`(ecase hz-vt-value
- (:hz ,hz-form)(:vt ,vt-form))))
+ (:horizontal ,hz-form)
+ (:vertical ,vt-form))))
(make-instance 'ix-slider
:md-name :sbar-slider
:md-value-fn (lambda (pct)
@@ -165,7 +160,7 @@
(* 4 *scroll-stepper-r*))))))))
(defmethod ix-paint ((self ix-slider))
- #+not (when (eql :vt (md-name .parent))
+ #+not (when (eql :vertical (md-name .parent))
(trc "slider px" (^px))
(trc "slider py" (^py))
(trc "slider ll" (^ll))
@@ -194,7 +189,7 @@
(:home ,home-form)(:end ,end-form)))
(hz-vt (hz-form vt-form)
`(ecase hz-vt-value
- (:hz ,hz-form)(:vt ,vt-form))))
+ (:horizontal ,hz-form)(:vertical ,vt-form))))
(make-instance 'ct-button
:md-name home-end-value
:ll (- *scroll-stepper-r*) :lt (ups *scroll-stepper-r*)
Index: cell-cultures/cello/ct-scroll-pane.lisp
diff -u cell-cultures/cello/ct-scroll-pane.lisp:1.1 cell-cultures/cello/ct-scroll-pane.lisp:1.2
--- cell-cultures/cello/ct-scroll-pane.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ct-scroll-pane.lisp Fri Oct 15 05:37:21 2004
@@ -28,7 +28,7 @@
slider trench prettied up
|#
-(defmodel ct-scroll-manager (focus control ig-zero-tl)
+(defmodel ct-scroll-manager (focus control ix-zero-tl)
((content :initform nil :initarg :content :accessor content)
(step-x :initform (u96ths 12) :initarg :step-x :accessor step-x)
(step-y :initform (u96ths 12) :initarg :step-y :accessor step-y)
@@ -56,7 +56,7 @@
(defconstant *sbar-thickness* 16)
-(defmodel ix-scroller (ct-scroll-manager ig-zero-tl)
+(defmodel ix-scroller (ct-scroll-manager ix-zero-tl)
((mac-p :initarg :mac-p :initform t :reader mac-p)
(scroll-bars :cell nil :initform nil :initarg :scroll-bars :accessor scroll-bars)
(resizeable :cell nil :initform nil :initarg :resizeable :accessor resizeable)
@@ -84,11 +84,11 @@
:ll 0 :lt 0
:px 0 :py 0
:lr (c? (- (inset-lr .parent)
- 2 (if (scrolls-p .parent :vt)
+ 2 (if (scrolls-p .parent :vertical)
*sbar-thickness* 0)))
:lb (c? (+ (inset-lb .parent)
(ups 2)
- (if (scrolls-p .parent :hz)
+ (if (scrolls-p .parent :horizontal)
(ups *sbar-thickness*) 0)))
:step-x (c? (step-x .parent))
:step-y (c? (step-y .parent)))
@@ -103,7 +103,8 @@
:drag-range (c? (resize-range .parent))))
(mapcar (lambda (bar-id)
(make-instance 'ct-scroll-bar
- :md-name bar-id))
+ :md-name bar-id
+ :orientation bar-id))
(scroll-bars self))))))
(defmacro uskin ()
Index: cell-cultures/cello/ctl-drag.lisp
diff -u cell-cultures/cello/ctl-drag.lisp:1.1 cell-cultures/cello/ctl-drag.lisp:1.2
--- cell-cultures/cello/ctl-drag.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ctl-drag.lisp Fri Oct 15 05:37:21 2004
@@ -65,9 +65,9 @@
;;;(defmethod context-cursor ((self CTDrag) kbdModifiers)
;;; (declare (ignore kbdmodifiers))
;;; (ecase (dragdirection self)
-;;; (:hz GLUT_CURSOR_LEFT_RIGHT)
-;;; (:vt GLUT_CURSOR_UP_DOWN)
-;;; (:hz-vt GLUT_CURSOR_CROSSHAIR)))
+;;; (:horizontal GLUT_CURSOR_LEFT_RIGHT)
+;;; (:vertical GLUT_CURSOR_UP_DOWN)
+;;; (:horizontal-vt GLUT_CURSOR_CROSSHAIR)))
(defmodel ct-poly-drag (ct-drag ix-polygon)())
Index: cell-cultures/cello/ctl-markbox.lisp
diff -u cell-cultures/cello/ctl-markbox.lisp:1.1 cell-cultures/cello/ctl-markbox.lisp:1.2
--- cell-cultures/cello/ctl-markbox.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ctl-markbox.lisp Fri Oct 15 05:37:21 2004
@@ -101,20 +101,22 @@
(defmodel ct-radio-button (ct-mark-box ct-radio-item) ())
(defmodel ct-text-radio-item ( ct-radio-item ct-text)())
-(defmodel ct-radio (ix-family)
+(defmodel ct-radio (ix-inline)
()
(:default-initargs
:md-value (c-in nil)))
-(defmodel ct-radio-row (ix-row ct-radio)
+(defmodel ct-radio-row (ct-radio)
()
(:default-initargs
+ :orientation :horizontal
:md-value (c-in nil)))
-(defmodel ct-radio-stack (ix-stack ct-radio)
+(defmodel ct-radio-stack (ct-radio)
()
(:default-initargs
- :md-value (c-in nil)))
+ :md-value (c-in nil)
+ :orientation :vertical))
(defun radio-on-name (radio-values)
(some (lambda (rb-value)
@@ -186,8 +188,7 @@
(trc "rendering radio-push" :unscissored)))
(call-next-method))
-(defmodel ct-push-toggle (ct-radio-push-button)
+(defmodel ct-push-toggle (ct-toggle ct-button)
()
(:default-initargs
- :md-value (c-in nil)
- :radio (c? self)))
\ No newline at end of file
+ :md-value (c-in nil)))
\ No newline at end of file
Index: cell-cultures/cello/ctl-selectable.lisp
diff -u cell-cultures/cello/ctl-selectable.lisp:1.1 cell-cultures/cello/ctl-selectable.lisp:1.2
--- cell-cultures/cello/ctl-selectable.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ctl-selectable.lisp Fri Oct 15 05:37:21 2004
@@ -26,23 +26,22 @@
(defmodel ct-selector () ;; mixin at any node containing CTSelectable's
- ((selection :accessor selection :initarg :selection)
+ ((selection :initform (c-in nil) :accessor selection :initarg :selection)
(selection-focus :initarg :selection-focus
:reader selection-focus
:initform nil)
(initial-selection :initform nil :reader initial-selection :cell nil :initarg :initial-selection)
- )
- (:default-initargs
- :selection (c-in nil)
- ))
+ (multiple-choice-p :initform nil :initarg :multiple-choice-p :accessor multiple-choice-p)
+ (togglep :initform nil :initarg :togglep :accessor togglep)
+ ))
(defmethod sm-unchanged-p ((self ct-selector) (slotname (eql 'selection)) new-value old-value)
(equal new-value old-value))
-(defun initialselection-first (self)
+(defun initial-selection-first (self)
(do-like-fm-parts (it (self ct-selectable))
(when (enabled it)
- (return-from initialselection-first (list it)))))
+ (return-from initial-selection-first (list it)))))
(defmethod md-awaken :after ((self ct-selector))
(when (initial-selection self)
@@ -50,11 +49,7 @@
(setf (selection self) (eko ("setting initial selection" self)
(funcall (initial-selection self) self))))))
-(def-c-output selection ())
-
-(defmodel ct-selector-stack (ct-selector ix-stack)())
-(defmodel ct-exclusive-stack (ct-exclusive ix-stack)())
-(defmodel ct-selector-row (ct-selector ix-row)())
+(defmodel ct-selector-inline (ct-selector ix-inline)())
;----------
@@ -75,83 +70,41 @@
(:default-initargs
:outset (u8ths 1)))
-#+test?
-(def-c-output kids ((self ct-details))
- ;(trc "ctdetails kids echo" newvalue oldvalue)
- )
-
(defmodel ct-details-exclusive (ct-exclusive ct-details)()) ;; go generic with CTSelectorNested?
(defmodel ct-selectable (control)
((selectedp :initarg :selectedp
- :initform (c? (bwhen (selector (selector self))
- (member self (selection selector))))
- :reader selectedp))
+ :initform (c? (bwhen (selector (selector self))
+ (member (^md-value) (selection selector))))
+ :reader selectedp))
(:default-initargs
- :bkg-color (c? (if (^enabled)
- (if (^hilited)
- +blue+
- (if (^selectedp)
- +yellow+
- +white+))
- +lt-gray+))
- :pre-layer (with-layers (:rgba (^bkg-color))
- :fill
- +black+)))
+;;; nah, no image behavior here. put in mixin if desired
+;;; :bkg-color (c? (if (^enabled)
+;;; (if (^hilited)
+;;; +blue+
+;;; (if (^selectedp)
+;;; +yellow+
+;;; +white+))
+;;; +lt-gray+))
+;;; :pre-layer (with-layers (:rgba (^bkg-color))
+;;; :fill
+;;; +black+)
+ :ct-action (lambda (self event
+ &aux
+ (buttons (evt-buttons event))
+ (selector (selector self))
+ (selection (selection selector))
+ (value (^md-value))
+ (now-selected (member value selection)))
+ (if (multiple-choice-p selector)
+ (if now-selected
+ (when (or (togglep selector)
+ (shift-key-down buttons))
+ (selection-set selector (remove value selection)))
+ (selection-set selector (cons value selection)))
+ (unless now-selected
+ (selection-set selector value))))))
(defun selector (self)
(upper self ct-selector))
-;=====================================
-
-(defmodel ct-exclusive (ct-selectable)
- ()
- (:default-initargs
- :ct-action #'ct-exclusive-control-action))
-
-(defmethod ct-exclusive-control-action (self event)
- (declare (ignorable event))
-
- (with-metrics (nil nil (nil :type :time #+not :count-only #+not :space
- ;; :count 2000
- :interpret-closures t
- ;; :count-list (list #'md::bd-bound-slot-value)
- ) "CTExclusive-controlAction")
- (selection-set1 (selector self) self)))
-
-;=====================================
-
-(defmodel ct-multi-choice (ct-selectable)
- ()
- (:default-initargs
- :ct-action (lambda (self event
- &aux
- (buttons (evt-buttons (os-event event)))
- (selector (selector self))
- (selection (selection selector)))
- (selection-set selector
- (if (shift-key-down buttons)
- (if (member self selection)
- (delete self selection)
- (cons self selection))
- (list self))))))
-
-;=====================================
-
-(defmodel ct-toggle-choice (ct-toggle ct-selectable)
- ()
- (:default-initargs
- :ct-action #'ct-toggle-choice-controlaction))
-
-(defmethod ct-toggle-choice-controlaction (self event
- &aux
- (buttons (evt-buttons (os-event event)))
- (selector (selector self))
- (selection (selection selector)))
- (trc "controlaction toggle" self)
- (selection-set selector
- (if (member self selection)
- (remove self selection)
- (if (shift-key-down buttons)
- (cons self selection)
- (list self)))))
Index: cell-cultures/cello/ctl-toggle.lisp
diff -u cell-cultures/cello/ctl-toggle.lisp:1.1 cell-cultures/cello/ctl-toggle.lisp:1.2
--- cell-cultures/cello/ctl-toggle.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ctl-toggle.lisp Fri Oct 15 05:37:21 2004
@@ -40,17 +40,18 @@
((inset :unchanged-if 'v2= :initform (mkv2 (upts 4) (upts 4)))
(depressed :initarg :depressed :reader depressed :initform (c? (^hilited))))
(:default-initargs
+ :title$ (c? (string-capitalize (md-name self)))
:text$ (c? (^title$))
:clipped t
:justify-hz :center
:justify-vt :center
:style-id :button
:skin (c? (skin .w.))
+ :text-color (c? (if (^depressed)
+ +dk-gray+ +white+))
:pre-layer (c? (let* ((thick (min (u96ths 4) (* 0.08 (l-width self))))
(defl (if (^depressed) (downs (/ thick 3)) 0))
- (push-in (if (^depressed) (xlout (* .5 thick)) 0))
- (tx-color (if (^depressed)
- +dk-gray+ +white+)))
+ (push-in (if (^depressed) (xlout (* .5 thick)) 0)))
(declare (ignorable thick defl))
(trc nil "ctbutton" thick defl)
@@ -60,7 +61,9 @@
:on
(:frame-3d :edge-raised
:thickness thick)
- (:rgba tx-color))))))
+ (:rgba (^text-color)))))))
+
+(defmodel ct-selectable-button (ct-selectable ct-button)())
; ---------------- CT FSM ---------------------
(defmodel ctfsm (control)
@@ -116,7 +119,7 @@
(defmacro mk-twisted (twisted-name (label-class &rest label-args)
(twisted-class &rest twisted-args))
- `(mk-part :twisted-group (ig-zero-tl)
+ `(mk-part :twisted-group (ix-zero-tl)
:showkids (c-in nil)
:ll (c? (ix-kid-wrap self 'pl))
:lr (c? (ix-kid-wrap self 'pr))
@@ -145,7 +148,7 @@
(defmacro mk-twisted-part (twisted-name (label$ &rest label-args)
twisted-part)
- `(mk-part :twisted-group (ig-zero-tl)
+ `(mk-part :twisted-group (ix-zero-tl)
:showkids (c-in nil)
:ll (c? (ix-kid-wrap self 'pl))
:lr (c? (ix-kid-wrap self 'pr))
Index: cell-cultures/cello/image.lisp
diff -u cell-cultures/cello/image.lisp:1.4 cell-cultures/cello/image.lisp:1.5
--- cell-cultures/cello/image.lisp:1.4 Fri Oct 1 06:01:05 2004
+++ cell-cultures/cello/image.lisp Fri Oct 15 05:37:21 2004
@@ -45,8 +45,6 @@
(when (every 'dsp-list (kids self))
(let ((display-list-name (or .cache (gl-gen-lists 1)))
(*window-rendering* (nearest self window)))
- (trc nil "display-list-name" display-list-name self)
-
(gl-new-list display-list-name gl_compile)
(trc nil "starting display list" display-list-name self)
(let ((*ogl-listing-p* self)
@@ -97,6 +95,7 @@
;
; appearance
;
+ (gui-styles :initarg :gui-styles :initform nil :accessor gui-styles)
(sound :initarg :sound :initform nil :accessor sound)
;
(lighting :initarg :lighting :initform nil :accessor lighting)
@@ -126,10 +125,20 @@
(:default-initargs
:renderer 'ix-paint ))
-(defmethod ogl-dsp-list-prep progn ((self image))
- (skin self))
+(defmethod md-awaken :after ((self image))
+ (assert (px self))
+ (assert (py self))
+ (assert (ll self))
+ (assert (lt self))
+ (assert (lr self))
+ (assert (lb self)))
+
+(defmethod ogl-dsp-list-prep progn ((self image))
+ (ogl-dsp-list-prep (skin self)))
+(defmethod ogl-dsp-list-prep progn ((self wand-texture))
+ (texture-name self))
;------------------------------
(def-c-output mouse-over-p ()
Index: cell-cultures/cello/ix-family.lisp
diff -u cell-cultures/cello/ix-family.lisp:1.1 cell-cultures/cello/ix-family.lisp:1.2
--- cell-cultures/cello/ix-family.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ix-family.lisp Fri Oct 15 05:37:21 2004
@@ -31,7 +31,7 @@
(effective-styles :reader effective-styles :initarg :effective-styles
:initform nil #+not (ix-family-effective-styles))
- (outset :cell nil :initarg :outset :initform 0 :accessor outset)
+ (outset :initarg :outset :initform 0 :accessor outset)
(showkids :initarg :showkids :initform nil :accessor showkids)
(kids-ever-shown
@@ -48,7 +48,7 @@
;;-------- ZeroTL ----------------------------
;;
-(defmodel ig-zero-tl (ix-family)
+(defmodel ix-zero-tl (ix-family)
()
(:default-initargs
:ll (c? (- (outset self)))
@@ -69,32 +69,76 @@
:lr (c? (ix-kid-wrap self 'pr))
:lb (c? (ix-kid-wrap self 'pb))))
-;----------- OfKids -----------------------
+;--------------- ix-inline -----------------------------
;
-(defmacro smkidp (outset-optr min-max attribute)
- `(c? (,outset-optr
- (if (^kids)
- (with-dynamic-fn (roomy (kid) (not (collapsed kid)))
- (,min-max ,attribute
- :test roomy))
- 0)
- (outset self))))
+
+(defmodel ix-inline (ix-zero-tl)
+ ((orientation :initarg :orientation :initform nil :accessor orientation
+ :documentation ":vertical (for a column) or :horizontal (row)")
+ (justify :initarg :justify :accessor justify
+ :initform (c? (ecase (orientation self)
+ (:vertical :left)
+ (:horizontal :top))))
+ (spacing :initarg :spacing :initform 0 :accessor spacing))
+ (:default-initargs
+ :lr (c? (+ (^outset)
+ (ecase (orientation self)
+ (:vertical (loop for k in (^kids)
+ maximizing (l-width k)))
+ (:horizontal (bif (lk (last1 (^kids)))
+ (pr lk) 0)))))
+ :lb (c? (+ (downs (^outset))
+ (ecase (orientation self)
+ (:vertical (bif (lk (last1 (^kids)))
+ (pb lk) 0))
+ (:horizontal (downs (loop for k in (^kids)
+ maximizing (l-height k)))))))
+ :kid-slots (lambda (self)
+ (ecase (orientation .parent)
+ (:vertical (list
+ (mk-kid-slot (px :if-missing t)
+ (c? (^px-self-centered (justify .parent))))
+ (mk-kid-slot (py)
+ (c? (py-maintain-pt
+ (^prior-sib-pb self (spacing .parent)))))))
+ (:horizontal (list
+ (mk-kid-slot (py :if-missing t)
+ (c? (^py-self-centered (justify .parent))))
+ (mk-kid-slot (px)
+ (c? (px-maintain-pl
+ (^prior-sib-pr self (spacing .parent)))))))))))
+
+(defmodel ix-stack (ix-inline)
+ ()
+ (:default-initargs
+ :orientation :vertical))
+
+(defmodel ix-row (ix-inline)
+ ()
+ (:default-initargs
+ :orientation :horizontal))
+(defmacro a-stack ((&rest stack-args) &body dd-kids)
+ `(mk-part ,(copy-symbol 'a-stack) (ix-inline)
+ , at stack-args
+ :orientation :vertical
+ :kids (c? (packed-flat! , at dd-kids))))
-(defun v2-in-subframe (super h v sub)
- (if (eql super sub) ;; bingo
- (values h v)
- (dolist (kid (kids super))
- (multiple-value-bind (subh sub-v)
- (v2-in-subframe kid h v sub)
- (when subh
- (return-from v2-in-subframe (values (- subh (px kid))
- (- sub-v (py kid)))))))))
+(defmacro a-row ((&rest stack-args) &body dd-kids)
+ `(mk-part ,(copy-symbol 'a-stack) (ix-inline)
+ , at stack-args
+ :orientation :horizontal
+ :kids (c? (packed-flat! , at dd-kids))))
+
+#| archive
+
+(defmodel ix-row-fv (family-values ix-row)())
+(defmodel ix-inline-fv (family-values ix-inline)())
;-------------------------- IMMatrix ------------------------------------------
-(defmodel im-matrix (ig-zero-tl)
+(defmodel im-matrix (ix-zero-tl)
((columns :cell nil :initarg :columns :initform nil :accessor columns)
(indent-hz :cell nil :initarg :indent-hz :initform 0 :accessor indent-hz)
(spacing-hz :cell nil :initarg :spacing-hz :initform 0 :accessor spacing-hz)
@@ -121,3 +165,28 @@
(pt psib))
0))))))))
+;--------------- IGRowFlow ----------------------------
+
+(defmodel ix-row-flow (ix-row)
+ ((spacing-hz :cell nil :initarg :spacing-hz :initform 0 :reader spacing-hz)
+ (spacing-vt :cell nil :initarg :spacing-vt :initform 0 :reader spacing-vt)
+ (aligned :cell nil :initarg :aligned :initform nil :reader aligned))
+ (:default-initargs
+ :lb (c? (ix-kid-wrap self 'pb))
+ :kid-slots (lambda (self)
+ (declare (ignore self))
+ (list
+ (mk-kid-slot (py)
+ (c? (py-maintain-pt
+ (let ((ph (^prior-sib-pr self (spacing-hz .parent) (aligned .parent))))
+ (if (> (+ ph (l-width self)) (l-width .parent))
+ (^prior-sib-pb self (spacing-vt .parent))
+ (^prior-sib-pt self))))))
+ (mk-kid-slot (px)
+ (c? (px-maintain-pl
+ (let ((ph (^prior-sib-pr self (spacing-hz .parent) (aligned .parent))))
+ (if (> (+ ph (l-width self)) (l-width .parent))
+ 0
+ ph)))))))))
+
+|#
\ No newline at end of file
Index: cell-cultures/cello/ix-geometry.lisp
diff -u cell-cultures/cello/ix-geometry.lisp:1.2 cell-cultures/cello/ix-geometry.lisp:1.3
--- cell-cultures/cello/ix-geometry.lisp:1.2 Sun Jul 4 20:59:40 2004
+++ cell-cultures/cello/ix-geometry.lisp Fri Oct 15 05:37:21 2004
@@ -66,6 +66,18 @@
(incf ,offset-h (px ,from))
(incf ,offset-v (py ,from))))))
+;----------- OfKids -----------------------
+;
+
+(defun v2-in-subframe (super h v sub)
+ (if (eql super sub) ;; bingo
+ (values h v)
+ (dolist (kid (kids super))
+ (multiple-value-bind (subh sub-v)
+ (v2-in-subframe kid h v sub)
+ (when subh
+ (return-from v2-in-subframe (values (- subh (px kid))
+ (- sub-v (py kid)))))))))
(defun mk-gr (ap)
(c-assert ap)
(count-it :mk-gr)
Index: cell-cultures/cello/ix-grid.lisp
diff -u cell-cultures/cello/ix-grid.lisp:1.1 cell-cultures/cello/ix-grid.lisp:1.2
--- cell-cultures/cello/ix-grid.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ix-grid.lisp Fri Oct 15 05:37:21 2004
@@ -24,7 +24,7 @@
(defmacro u-grid () `(fm-parent self))
-(defmodel ix-grid (ig-zero-tl)
+(defmodel ix-grid (ix-zero-tl)
((col-ct :initarg :col-ct :initform nil :accessor col-ct)
(row-ct :initarg :row-ct :initform nil :accessor row-ct)
;
Index: cell-cultures/cello/ix-inline.lisp
diff -u cell-cultures/cello/ix-inline.lisp:1.1 cell-cultures/cello/ix-inline.lisp:1.2
--- cell-cultures/cello/ix-inline.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/ix-inline.lisp Fri Oct 15 05:37:21 2004
@@ -21,123 +21,3 @@
;;; IN THE SOFTWARE.
(in-package :cello)
-
-;--------------- ix-inline -----------------------------
-;
-
-(defmodel ix-inline (ig-zero-tl)
- ((justify :cell nil :initarg :justify :initform nil :accessor justify)
- (spacing :cell nil :initarg :spacing :initform 0 :accessor spacing)))
-
-;--------------- Stacks ------------------------------
-;
-
-
-(defmodel ix-stack (ix-inline)
- ()
- (:default-initargs
- :lr (c? (^lr-width (+ (or (loop for k in (^kids)
- maximizing (l-width k))
- 0)
- (outset self))))
- :lb (c? (+ (downs (outset self))
- (bif (lk (last1 (^kids)))
- (pb lk) 0)))
- :justify :left
- :kid-slots (lambda (self)
- (declare (ignore self))
- (kid-slots-stacking))))
-
-(defun kid-slots-stacking ()
- (list
- (mk-kid-slot (px :if-missing t)
- (c? (^px-self-centered (justify .parent))))
- (mk-kid-slot (py)
- (c? (py-maintain-pt
- (^prior-sib-pb self (spacing .parent)))))))
-
-(defmodel ix-stack-of-kids (ix-stack)
- ()
- (:default-initargs
- :ll (c? (- (or (loop for k in (^kids)
- minimizing (pl k))
- 0)
- (outset self)))
- :lr (c? (+ (or (loop for k in (^kids)
- maximizing (pr k))
- 0)
- (outset self)))
- :lb (c? (+ (downs (outset self))
- (bif (lk (last1 (^kids)))
- (pb lk) 0)))
- :justify :left))
-
-(defmacro a-stack ((&rest stack-args) &body dd-kids)
- `(mk-part ,(copy-symbol 'a-stack) (ix-stack)
- , at stack-args
- :kids (c? (packed-flat! , at dd-kids))))
-
-(defmacro a-stack-of-kids ((&rest stack-args) &body dd-kids)
- `(mk-part ,(copy-symbol 'a-stack) (ix-stack-of-kids)
- , at stack-args
- :kids (c? (packed-flat! , at dd-kids))))
-
-
-
-;----------------------- IXRow ------------------------------
-;
-
-
-(defmodel ix-row (ix-inline)
- ()
- (:default-initargs
- :ll (c? (- (outset self)))
- :lt (c? (ups (outset self)))
- :lb (c? (downs (outset self) (^lb-height (fm-max-kid self 'l-height))))
- :lr (c? (+ (outset self) (bif (lk (last1 (^kids)))
- (pr lk) 0)))
- :justify :top
- :kid-slots (lambda (self)
- (declare (ignore self))
- (kid-slots-rowing))))
-
-(defun kid-slots-rowing ()
- (list
- (mk-kid-slot (py :if-missing t)
- (c? (^py-self-centered (justify .parent))))
- (mk-kid-slot (px)
- (c? (px-maintain-pl
- (^prior-sib-pr self (spacing .parent)))))))
-
-(defmodel ix-row-fv (family-values ix-row)())
-(defmodel ix-stack-fv (family-values ix-stack)())
-;--------------- IGRowFlow ----------------------------
-
-(defmodel ix-row-flow (ix-row)
- ((spacing-hz :cell nil :initarg :spacing-hz :initform 0 :reader spacing-hz)
- (spacing-vt :cell nil :initarg :spacing-vt :initform 0 :reader spacing-vt)
- (aligned :cell nil :initarg :aligned :initform nil :reader aligned))
- (:default-initargs
- :lb (c? (ix-kid-wrap self 'pb))
- :kid-slots (lambda (self)
- (declare (ignore self))
- (list
- (mk-kid-slot (py)
- (c? (py-maintain-pt
- (let ((ph (^prior-sib-pr self (spacing-hz .parent) (aligned .parent))))
- (if (> (+ ph (l-width self)) (l-width .parent))
- (^prior-sib-pb self (spacing-vt .parent))
- (^prior-sib-pt self))))))
- (mk-kid-slot (px)
- (c? (px-maintain-pl
- (let ((ph (^prior-sib-pr self (spacing-hz .parent) (aligned .parent))))
- (if (> (+ ph (l-width self)) (l-width .parent))
- 0
- ph)))))))))
-
-(defmacro a-row ((&rest row-args) &body dd-kids)
- `(mk-part ,(copy-symbol 'a-row) (ix-row)
- , at row-args
- :spacing 0
- :kids (c? (packed-flat! , at dd-kids))))
-
Index: cell-cultures/cello/ix-render.lisp
diff -u cell-cultures/cello/ix-render.lisp:1.3 cell-cultures/cello/ix-render.lisp:1.4
--- cell-cultures/cello/ix-render.lisp:1.3 Fri Oct 1 06:01:05 2004
+++ cell-cultures/cello/ix-render.lisp Fri Oct 15 05:37:21 2004
@@ -81,6 +81,7 @@
(let ((ixr-box (mkr 0 0 0 0)))
(defmethod ix-paint :around ((self image) &aux (n (gl-name self)))
+ (trc nil "painting" self (^px)(^py)(^lr))
(with-bitmap-shifted ((px self)(py self))
(gl-translatef (px self) (py self) 0)
Index: cell-cultures/cello/ix-styled.lisp
diff -u cell-cultures/cello/ix-styled.lisp:1.2 cell-cultures/cello/ix-styled.lisp:1.3
--- cell-cultures/cello/ix-styled.lisp:1.2 Wed Sep 29 04:50:09 2004
+++ cell-cultures/cello/ix-styled.lisp Fri Oct 15 05:37:21 2004
@@ -69,10 +69,10 @@
(defun styles-default () *styles*)
-(defun gui-style (style)
+(defun gui-style (self style)
(when style
;;(print `(gui-style ,style ,(styles-default)))
- (or (find style (styles-default) :key 'id)
+ (or (ix-find-style self style)
(find :default (styles-default) :key 'id)
(break "gui-style cannot find requested style ~a" style))))
@@ -81,7 +81,7 @@
:initform nil
:reader style-id)
- (style :initform (c? (gui-style (^style-id)))
+ (style :initform (c? (gui-style self (^style-id)))
:initarg :style
:reader style)
@@ -102,6 +102,13 @@
(with-layers
(:rgba (^text-color)))))))
+(defmethod ix-find-style ((self image) style-id)
+ (or (find style-id (^gui-styles) :key 'id)
+ (ix-find-style .parent style-id)))
+
+(defmethod ix-find-style (self style-id)
+ (declare (ignore self style-id)))
+
(defmethod ogl-dsp-list-prep progn ((self ix-styled) &aux (font (text-font self)))
(assert (not *ogl-listing-p*))
(trc nil "ogl-dsp-list-prep sub-prepping font" font)
@@ -110,18 +117,7 @@
(unless (ftgl::ftgl-disp-ready-p font)
(fgc-set-face-size (ftgl::ftgl-get-metrics-font font)
(ftgl::ftgl-size font) (ftgl::ftgl-target-res font)))
- (ix-string-width self (^display-text$)))
- (ftgl-texture
- #+not (loop with x for c across (^display-text$)
- do (pushnew (fgc-char-texture (ftgl::ftgl-get-metrics-font font)(char-code c)) x)
- finally (trc "font,string,textures" font (^display-text$) x))
- #+no? (unless (ftgl::ftgl-disp-ready-p font)
- (trc "setting face size" font)
- (fgc-set-face-size (ftgl::ftgl-get-metrics-font font)
- (ftgl::ftgl-size font) (ftgl::ftgl-target-res font)))
- ;;(trc (eql 12 (ftgl::ftgl-size font)) "forcing glyphs" (ftgl::ftgl-face font) (^display-text$))
- #+not (ix-string-width self (^display-text$)))
- )
+ (ix-string-width self (^display-text$))))
(ftgl::ftgl-get-display-font font))
(defmethod make-style-font ((style gui-style-glut-stroke))
Index: cell-cultures/cello/menu.lisp
diff -u cell-cultures/cello/menu.lisp:1.1 cell-cultures/cello/menu.lisp:1.2
--- cell-cultures/cello/menu.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/menu.lisp Fri Oct 15 05:37:21 2004
@@ -34,12 +34,14 @@
:pre-layer (with-layers +lt-gray+ :fill)
:kids (c? (mapcar #'make-menu menus))))
-(defmodel ct-menu (control ix-styled ix-stack)
+(defmodel ct-menu (control ix-styled ix-inline)
((items :initarg :items :reader items :initform nil))
(:default-initargs
+ :orientation :vertical
:style-id :button
:kids (c? (the-kids
- (mk-part :title-items (ix-stack)
+ (mk-part :title-items (ix-inline)
+ :orientation :vertical
:kids (c? (the-kids
(mk-part :title (ix-text)
:lighting :off
@@ -63,9 +65,10 @@
-(defmodel ct-menu-items (ix-stack window)
+(defmodel ct-menu-items (ix-inline window)
()
(:default-initargs
+ :orientation :vertical
:self-sizing t
:lighting :off
:outset (u96ths 4)
Index: cell-cultures/cello/pick.lisp
diff -u cell-cultures/cello/pick.lisp:1.2 cell-cultures/cello/pick.lisp:1.3
--- cell-cultures/cello/pick.lisp:1.2 Sun Jul 4 20:59:40 2004
+++ cell-cultures/cello/pick.lisp Fri Oct 15 05:37:21 2004
@@ -58,7 +58,7 @@
;;(format t "~&perspective sees aspect: ~a" aspect)
(glu-perspective 45 aspect 0.1 100.0)) ;;OQ: appropriate for ortho?
- (gl-matrix-mode gl_model-view)
+ (gl-matrix-mode gl_modelview)
#+not (let ((*ogl-listing-p* target)
*selecting* *render-clip-l* *render-clip-r* *render-clip-t* *render-clip-b*)
(with-metrics (nil nil "(funcall renderer)" self)
@@ -69,7 +69,7 @@
(gl-matrix-mode gl_projection)
(gl-pop-matrix)
- (gl-matrix-mode gl_model-view)
+ (gl-matrix-mode gl_modelview)
(let ((hits (gl-render-mode gl_render)))
(print `(:hits ,hits))
Index: cell-cultures/cello/to-do.lisp
diff -u cell-cultures/cello/to-do.lisp:1.1 cell-cultures/cello/to-do.lisp:1.2
--- cell-cultures/cello/to-do.lisp:1.1 Sat Jun 26 20:38:33 2004
+++ cell-cultures/cello/to-do.lisp Fri Oct 15 05:37:21 2004
@@ -6,17 +6,11 @@
in not-to-be of Window, free os font stuff
-do up a display lists slot, maybe now rather than later. read up on efficiency,
-and see how deep one can go allocating display lists
-
when that is done, worry about not leaking foreign-allocated data
look at more helpers like with-matrix, and auto-normal, and auto-detecting functions
not meant to be called within begin/end
-look at a lighting preview control, xyz with sliders for positioning,
-sliders for ambient and diffuse
-
double-clicks
mousedown in w, mouseup out, mmosemove back in, click still alive [glut says they fix this]
@@ -31,8 +25,6 @@
get ctdrag working on :vt and both and an arbitrary (for things like z)
do a polar coordinate dragger for rotation
-
-lights (and lighting) should be slots in MGWindow, and lights pulled in as kids of the window
toggling nested off in starter-w does not redraw unchecked, tho simple cover/uncover works
Index: cell-cultures/cello/window-callbacks.lisp
diff -u cell-cultures/cello/window-callbacks.lisp:1.3 cell-cultures/cello/window-callbacks.lisp:1.4
--- cell-cultures/cello/window-callbacks.lisp:1.3 Fri Oct 1 06:01:05 2004
+++ cell-cultures/cello/window-callbacks.lisp Fri Oct 15 05:37:21 2004
@@ -84,33 +84,25 @@
(bwhen (w (mg-window-current))
(ix-idle w))))
-#+bzzzt
-(defun dnr (n)
- (locally (declare (special %displaying%))
- (print `(dnr ,n))
- (unless (and (boundp '%displaying%) %displaying%)
- (let ((%displaying% t))
- (when (< n 2)
- (dnr (1+ n)))))))
-
-
(def-window-callback mg-glut-display ()
- (unless (or *ogl-listing-p* ;; re-entrance happens if a DLL puts up a MessageBox
+ (unless (or *ogl-listing-p* ;; re-entrance happens if a DLL puts up a MessageBox
(c-stopped) (null *w*))
(with-metrics (nil nil "mg-glut-display")
- (trc nil "mg-glut-display > about to render w " *w* (glutgetwindow))
+ (trc nil "mg-glut-display > about to render w " *w* (glutgetwindow))
(window-display *w*))))
(defmethod window-display ((self window))
(bif (dl (dsp-list self))
- (gl-call-list (dsp-list self))
+ (progn
+ (trc nil "window using disp list")
+ (gl-call-list (dsp-list self)))
(ix-paint self))
(glut-swap-buffers)
- (incf (frame-ct self))
(trc nil "window-display > rendered w " self (glutgetwindow))
+ (incf (frame-ct self))
(when (display-continuous self)
(trc nil "window-display > continuous specified so posting redisplay" self)
(glut-post-redisplay)))
Index: cell-cultures/cello/window.lisp
diff -u cell-cultures/cello/window.lisp:1.3 cell-cultures/cello/window.lisp:1.4
--- cell-cultures/cello/window.lisp:1.3 Fri Oct 1 06:01:05 2004
+++ cell-cultures/cello/window.lisp Fri Oct 15 05:37:21 2004
@@ -81,6 +81,7 @@
:initform 0
:accessor gl-name-highest))
(:default-initargs
+ :px 0 :py 0
:kids (c? (the-kids (^content)) #+not (the-kids
(mk-part :wstuff (ix-kid-sized)
:px 0 :py (c? (bif (n (nsib))
@@ -386,19 +387,18 @@
(defmethod mg-window-reshape (self width height)
(trc nil "mg-window-reshape" self width height)
(gl-viewport 0 0 width height)
+
(gl-matrix-mode gl_projection)
(gl-load-identity)
- (trc nil "mg-window-reshape ortho" 0 width (- height) 0 *mgw-near* *mgw-far*)
+ (trc "mg-window-reshape ortho" 0 width (- height) 0 *mgw-near* *mgw-far*)
(gl-ortho 0 width (- height) 0 *mgw-near* *mgw-far*)
- (gl-load-identity)
- (trc nil "mg-window-reshape > new window wid,hei:" self width height)
+ (trc nil "mg-window-reshape > new window wid,hei:" self width height)
+;;; (gl-load-identity)
(setf (lr self) (+ (ll self) (scr2log width)))
(setf (lb self) (- (lt self) (scr2log height))))
-
-
(defun run-window (new-window &optional run-init-func)
(when run-init-func
(funcall run-init-func))
@@ -416,34 +416,27 @@
(bwhen (s (ix-sound-find new-window :open))
(ix-sound-install new-window s))
- #+nah (do ()
- ((or (c-stopped)
- (zerop (glut-get-window))))
- ;;(format t "before main loop ~a | ~&" (glut-get-window))
- (progn ;; with-render-lock ((glut-get-window))
- (glutmainloopevent))
- (sleep 0.1)
- )
(handler-bind ((error #'(lambda (c) (print `(bingo glut leave ,c))
(c-stop :top-handler)
(glut-leave-main-loop))))
+ #+fasterbutcannotbreak
(glutmainloop)
- #+nah ;; before re-enabling wotk out how to get idel func called if present
+ ;; before re-enabling wotk out how to get idle func called if present
+ ;;#+breakable
(do ()
((or (c-stopped)
(zerop (glut-get-window))))
;;(format t "before main loop ~a | ~&" (glut-get-window))
- (progn ;; with-render-lock ((glut-get-window))
- (glutmainloopevent)
- )
- (sleep 0.1)))))
+ (glutmainloopevent)
+ (setf (tick-count new-window) (os-tickcount))
+ (sleep 0.05)))))
(defmethod ix-paint :around ((self window))
(flet ((projection ()
(gl-matrix-mode gl_projection)
(gl-load-identity)
- (trc nil "paint> win ortho! l r b t n f:"
+ (trc "paint> win ortho! l r b t n f:"
(ll self)(lr self)
(lb self)(lt self)
*mgw-near* *mgw-far*)
@@ -454,7 +447,7 @@
*mgw-far*
)))
(projection)
- (gl-matrix-mode gl_model-view)
+ (gl-matrix-mode gl_modelview)
(gl-load-identity)
(gl-light-modeli gl_light_model_two_side 0)
More information about the Cells-cvs
mailing list