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 (,@component-args) + (a-row () + (make-kid 'ct-twister + :md-name :show-contents + :md-value (c-in ,initial-open) + :visible (c? (^enabled)) + ,@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)