[cello-cvs] CVS cello
ktilton
ktilton at common-lisp.net
Sat Oct 28 18:22:43 UTC 2006
Update of /project/cello/cvsroot/cello
In directory clnet:/tmp/cvs-serv3711
Modified Files:
cello.asd control.lisp ctl-markbox.lisp ctl-toggle.lisp
ix-layer-expand.lisp ix-polygon.lisp ix-togl.lisp
Log Message:
Cello rizing.
--- /project/cello/cvsroot/cello/cello.asd 2006/08/26 16:04:46 1.5
+++ /project/cello/cvsroot/cello/cello.asd 2006/10/28 18:22:43 1.6
@@ -30,7 +30,6 @@
(:file "image")
(:file "ix-opengl")
(:file "ix-canvas")
- (:file "ix-family")
(:file "font")
(:file "ix-grid")
(:file "mouse-click")
--- /project/cello/cvsroot/cello/control.lisp 2006/10/13 05:57:27 1.6
+++ /project/cello/cvsroot/cello/control.lisp 2006/10/28 18:22:43 1.7
@@ -15,7 +15,7 @@
|#
(in-package :cello)
-
+(export! control enabled ^enabled)
(defmd control ()
(title$ (c? (format nil "~:(~a~)" ;; this is just a poor default-- really s.b. supplied by form author
(string-downcase (substitute #\space #\- (string (md-name self)))))))
--- /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/10/17 21:30:08 1.8
+++ /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/10/28 18:22:43 1.9
@@ -20,7 +20,7 @@
(eval-now!
(defmethod ix-layer-expand ((self (eql :x-mark)) &rest args)
- `(ix-render-x-mark ,(car args) l-box)))
+ `(ix-render-x-mark ,(car args) l-box ,(cadr args))))
(defmodel ct-mark-box (ct-toggle ix-view)
((kb-selector :cell nil :initarg :kb-selector :initform nil :reader kb-selector)
@@ -35,23 +35,22 @@
(:in 4)
+light-gray+ ;;;(if (^enabled) +white+ +gray+)
:off
- (:frame-3d :edge-sunken
- :thickness 4)
+ (:frame-3d :edge-sunken :thickness 4)
:off
+dark-gray+
(:out 4)
(:x-mark (^md-value)))))
-(defun ix-render-x-mark (do-p lbox)
+(defun ix-render-x-mark (do-p lbox &optional thickness &aux (thick (or thickness (/ (r-width lbox) 4))))
(when do-p
- (let* ((thick (/ (r-width lbox) 4))
+ (let* (
(br (- (r-right lbox) thick)) ;; /// bogus use of thick to inset "x"
(bl (+ (r-left lbox) thick))
(bt (+ (r-top lbox) (downs thick)))
(bb (+ (r-bottom lbox) (ups thick)))
)
(with-matrix ()
- (gl-line-width (max 2 (log2scr thick)))
+ (gl-line-width (log2scr thick))
(gl-disable gl_texture_2d)
(with-gl-begun (gl_lines)
(gl-vertex3f bl bt 0)(gl-vertex3f br bb 0)
@@ -68,8 +67,8 @@
:enabled t
:md-value (c? (find (associated-value self) (md-value (^radio))))
:ct-action (lambda (self event)
- (radio-item-to-md-value self event (^radio)))))
-
+ (with-c-change :ct-radio-item
+ (radio-item-to-md-value self event (^radio))))))
(defun radio-item-to-md-value (self event radio)
@@ -87,10 +86,14 @@
(defmodel ct-radio-button (ct-mark-box ct-radio-item) ())
(defmodel ct-text-radio-item ( ct-radio-item ct-text)())
-(defmodel ct-radio (ix-inline)
- ()
- (:default-initargs
- :md-value (c-in nil)))
+(defmd ct-radio (ix-inline)
+ on-change
+ :md-value (c-in nil))
+
+(defobserver .md-value ((self ct-radio)) ;; /// should every control have this?
+ (when (^on-change)
+ (trcx nil radio-value-observer self new-value old-value old-value-boundp)
+ (funcall (^on-change) self new-value old-value old-value-boundp)))
(defmodel ct-radio-row (ct-radio)
()
--- /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/10/17 21:30:08 1.6
+++ /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/10/28 18:22:43 1.7
@@ -138,6 +138,7 @@
:md-value (c-in nil) ;;; closed by default
:poly-style :fill
:pre-layer (c? (with-layers
+ (:poly-mode gl_front_and_back gl_fill)
(:rgba (if (^hilited)
+green+ +black+))))
:vertices (c? (if (md-value self)
@@ -145,6 +146,27 @@
'((4 . -2) (9 . -7) (4 . -12))))
:ll 0 :lt 0 :lr (u96ths 15) :lb (downs (u96ths 15))))
+(export! a-twister)
+
+(defmacro a-twister ((label component-args initial-open &rest twister-args) twisted-widget)
+ `(a-stack (, at component-args)
+ (a-row ()
+ (make-kid 'ct-twister
+ :md-name :show-contents
+ :md-value (c-in ,initial-open)
+ :visible (c? (^enabled))
+ , at twister-args)
+ ,(if (stringp label)
+ `(make-kid 'ix-text
+ :text$ ,label
+ :style-id :button)
+ label)) ;; actually should be a form to build a widget
+ (a-stack (:collapsed (c? (let ((tw (fm^ :show-contents)))
+ (assert (eq .parent (fm-parent (fm-parent tw))))
+ (not (md-value tw)))))
+ ,twisted-widget)))
+
+#| vestigial?
(defmacro mk-twisted (twisted-name (label-class &rest label-args)
(twisted-class &rest twisted-args))
@@ -193,3 +215,4 @@
,twisted-part
))))
+|#
\ No newline at end of file
--- /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/10/17 21:30:08 1.8
+++ /project/cello/cvsroot/cello/ix-layer-expand.lisp 2006/10/28 18:22:43 1.9
@@ -113,7 +113,7 @@
`(gl-disable ,gl))))
(defmethod ix-layer-expand ((self (eql :poly-mode)) &rest args)
- `(gl-polygon-mode ,(car args),(cadr args)))
+ `(gl-polygon-mode ,(car args) ,(cadr args)))
(defmethod ix-layer-expand ((self (eql :nice-lines)) &rest args)
`(progn
@@ -123,7 +123,7 @@
(gl-enable gl_blend)
(gl-blend-func gl_src_alpha gl_one_minus_src_alpha)
,(when args
- `(gl-line-width ,(car args)))))
+ `(gl-line-width ,(or (car args) 1)))))
--- /project/cello/cvsroot/cello/ix-polygon.lisp 2006/10/13 05:57:27 1.4
+++ /project/cello/cvsroot/cello/ix-polygon.lisp 2006/10/28 18:22:43 1.5
@@ -35,7 +35,8 @@
(with-matrix (nil)
(gl-line-width (poly-thickness self))
- (with-gl-begun (gl_line_loop)
+ (gl-polygon-mode gl_front_and_back gl_fill)
+ (with-gl-begun (gl_triangles)
(dolist (v vs)
(gl-vertex3f (v2-h v) (v2-v v) 0)))
(ogl::glec :f3d))))))
--- /project/cello/cvsroot/cello/ix-togl.lisp 2006/10/17 21:30:08 1.13
+++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/10/28 18:22:43 1.14
@@ -99,7 +99,7 @@
(:ButtonPress
(setf (mouse-pos self) (mkv2 (ctk::xbe-x xe)
(- (ctk::xbe-y xe)))) ; trigger mouseview recalc
- (setf (mouse-down-evt self) (eko ("mousedown!!!" (ctk::xbe button xe))
+ (setf (mouse-down-evt self) (eko (nil "mousedown!!!" (ctk::xbe button xe))
(make-os-event
:modifiers (keyboard-modifiers .tkw)
:where (mouse-pos self)
More information about the Cello-cvs
mailing list