Update of /project/cello/cvsroot/cello In directory clnet:/tmp/cvs-serv32241
Modified Files: cello-ftgl.lisp cello-magick.lisp cello.lpr ctl-markbox.lisp ctl-selectable.lisp ctl-toggle.lisp image.lisp ix-paint.lisp ix-togl.lisp nehe-06.lisp slider.lisp wm-mouse.lisp Log Message: md-value -> value
--- /project/cello/cvsroot/cello/cello-ftgl.lisp 2006/10/13 07:59:12 1.9 +++ /project/cello/cvsroot/cello/cello-ftgl.lisp 2006/11/04 20:56:30 1.10 @@ -47,7 +47,7 @@ (:default-initargs :style nil :pre-layer (with-layers - (:rgba (if (^md-value) +red+ +black+))) + (:rgba (if (^value) +red+ +black+))) :text-font (c? (font-ftgl-ensure :texture (intern (^font-pathname)) 14)) :text$ (c? (string-capitalize @@ -56,7 +56,7 @@
(defobserver mouse-over-p ((self font-id)) (when new-value - (setf (md-value (fm-other :ftgl-test)) (^font-pathname)))) + (setf (value (fm-other :ftgl-test)) (^font-pathname))))
(export! gui-style-ftgl)
@@ -152,13 +152,13 @@ (eko ("font show") (elt fns (+ (* cols row-no) col-no))))))))) (a-stack (:md-name :ftgl-test :spacing (upts 10) :px 0 :py (uin 1) - :md-value (c-in (car fns)) + :value (c-in (car fns)) :justify :left :outset (u8ths 1)) (a-stack (:lb (downs (upts 64)) :justify :center :outset (upts 8) - :pre-layer (c? (when (md-value (fm-other :ftgl-test)) + :pre-layer (c? (when (value (fm-other :ftgl-test)) (with-layers :on +gray+ (:frame-3d :edge-sunken :thickness (u96ths 4)) @@ -172,13 +172,13 @@ :style nil :pre-layer (with-layers +black+) :text-font (c? (font-ftgl-ensure - (car (md-value (fm-other :mode))) - (intern (md-value (fm-other :ftgl-test))) + (car (value (fm-other :mode))) + (intern (value (fm-other :ftgl-test))) 18 ;; (* 12 (1+ (mod x 4))) ))))) (mk-part :mode (ct-radio-row) :spacing (upts 4) - :md-value (c-in (list :texture)) + :value (c-in (list :texture)) :clipped nil :kids (c? (loop for mode in '(:bitmap :pixmap :texture :outline :polygon :extruded) collect (mk-part :rb (ct-radio-labeled) --- /project/cello/cvsroot/cello/cello-magick.lisp 2006/07/06 22:09:10 1.5 +++ /project/cello/cvsroot/cello/cello-magick.lisp 2006/11/04 20:56:30 1.6 @@ -61,11 +61,11 @@ (defmodel ix-image-file (ix-wander) ((wand-type :initarg :wand-type :accessor wand-type :initform 'wand-pixels)) (:default-initargs - :wander (c? (if (^md-value) - (let ((wand (wand-ensure-typed (^wand-type) (^md-value)))) - (assert wand () "Unable to load image file ~a" (^md-value)) + :wander (c? (if (^value) + (let ((wand (wand-ensure-typed (^wand-type) (^value)))) + (assert wand () "Unable to load image file ~a" (^value)) wand) - (error "ix-image-file requires md-value of path to image file"))) + (error "ix-image-file requires value of path to image file"))) :pre-layer (c? (with-layers +white+ (:wand (^wander)))) :ll 0 :lt 0 :lb (c? (downs (cdr (image-size (^wander))))) :lr (c? (car (image-size (^wander)))) --- /project/cello/cvsroot/cello/cello.lpr 2006/10/17 21:30:08 1.14 +++ /project/cello/cvsroot/cello/cello.lpr 2006/11/04 20:56:30 1.15 @@ -58,7 +58,7 @@ (make-instance 'project-module :name "cl-magick\cl-magick") (make-instance 'project-module :name - "..\Celtk\CELTK")) + "..\Celtk\CELLOTK")) :libraries nil :distributed-files nil :internally-loaded-files nil --- /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/10/28 18:22:43 1.9 +++ /project/cello/cvsroot/cello/ctl-markbox.lisp 2006/11/04 20:56:30 1.10 @@ -39,7 +39,7 @@ :off +dark-gray+ (:out 4) - (:x-mark (^md-value))))) + (:x-mark (^value)))))
(defun ix-render-x-mark (do-p lbox &optional thickness &aux (thick (or thickness (/ (r-width lbox) 4)))) (when do-p @@ -65,22 +65,22 @@ (radio :initarg :radio :accessor radio :initform (c? (upper self ct-radio)))) (:default-initargs :enabled t - :md-value (c? (find (associated-value self) (md-value (^radio)))) + :value (c? (find (associated-value self) (value (^radio)))) :ct-action (lambda (self event) (with-c-change :ct-radio-item - (radio-item-to-md-value self event (^radio)))))) + (radio-item-to-value self event (^radio))))))
-(defun radio-item-to-md-value (self event radio) +(defun radio-item-to-value (self event radio) (declare (ignorable event)) - (trc nil "radio item acts" self (md-value self) (already-on-do self) .w.) - (if (md-value self) + (trc nil "radio item acts" self (value self) (already-on-do self) .w.) + (if (value self) (ecase (already-on-do self) ((nil)) - (:off (setf (md-value radio) nil))) + (:off (setf (value radio) nil))) (progn (trc nil "here come rb" (associated-value self) radio) - (setf (md-value radio) + (setf (value radio) (list (associated-value self))))))
(defmodel ct-radio-button (ct-mark-box ct-radio-item) ()) @@ -88,9 +88,9 @@
(defmd ct-radio (ix-inline) on-change - :md-value (c-in nil)) + :value (c-in nil))
-(defobserver .md-value ((self ct-radio)) ;; /// should every control have this? +(defobserver .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))) @@ -99,12 +99,12 @@ () (:default-initargs :orientation :horizontal - :md-value (c-in nil))) + :value (c-in nil)))
(defmodel ct-radio-stack (ct-radio) () (:default-initargs - :md-value (c-in nil) + :value (c-in nil) :orientation :vertical))
(defun radio-on-name (radio-values) @@ -120,20 +120,20 @@ () (:default-initargs :lighting :on - :md-value (c-in nil)) + :value (c-in nil)) )
(defmodel ct-check-text (control ix-row) () (:default-initargs - :md-value (c-in nil) + :value (c-in nil) :justify :center :spacing (u96ths 8) :outset (u96ths 2) :kids (c? (the-kids (make-kid 'ct-check-box :md-name :check-box - :md-value (c? (md-value .parent)) + :value (c? (value .parent)) :enabled nil) ;; let parent handle clicks since text is clickable by the rules (make-kid 'ix-text :md-name :label @@ -142,9 +142,9 @@
:ct-action (lambda (self event) (declare (ignorable event)) - (trc nil "checktext bingo" (not (md-value self))) + (trc nil "checktext bingo" (not (value self))) (with-c-change :check-text-action - (setf (md-value self) (not (md-value self))))))) + (setf (value self) (not (value self)))))))
(defmodel ct-radio-labeled (ix-row ct-radio-item) () @@ -154,7 +154,7 @@ :outset (u96ths 2) :kids (c? (the-kids (mk-part :rbutton (ct-check-box) - :md-value (c? (md-value .parent)) + :value (c? (value .parent)) :enabled nil) ;; let parent handle clicks since text is clickable by the rules
(mk-part :label (ix-text) @@ -169,7 +169,7 @@ () (:default-initargs :inset (mkv2 (upts 4) (upts 4)) - :depressed (c? (or (^hilited)(^md-value))) + :depressed (c? (or (^hilited)(^value))) ))
(defmethod ix-paint ((self ct-radio-push-button)) @@ -183,4 +183,4 @@ (defmodel ct-push-toggle (ct-toggle ct-button) () (:default-initargs - :md-value (c-in nil))) + :value (c-in nil))) --- /project/cello/cvsroot/cello/ctl-selectable.lisp 2006/06/05 01:47:49 1.3 +++ /project/cello/cvsroot/cello/ctl-selectable.lisp 2006/11/04 20:56:30 1.4 @@ -69,7 +69,7 @@ (defmodel ct-selectable (control) ((selectedp :initarg :selectedp :initform (c? (bwhen (selector (ct-selector self)) - (member (^md-value) (selection selector)))) + (member (^value) (selection selector)))) :reader selectedp)) (:default-initargs :ct-action (lambda (self event @@ -77,7 +77,7 @@ (buttons (evt-buttons event)) (selector (ct-selector self)) (selection (selection selector)) - (value (^md-value)) + (value (^value)) (now-selected (member value selection))) (if (multiple-choice-p selector) (if now-selected --- /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/11/03 13:38:24 1.8 +++ /project/cello/cvsroot/cello/ctl-toggle.lisp 2006/11/04 20:56:30 1.9 @@ -22,7 +22,7 @@ () (:default-initargs :style-id :default - :text$ (c? (string (^md-value))) + :text$ (c? (string (^value))) :inset (mkv2 (u96ths 2)(u96ths 2)) :lighting :off :text-color (c? (if (^enabled) @@ -34,14 +34,14 @@
(defmd ct-button (control ix-text) ;; same inheritance, but otherwise unrelated to CTText - (md-value (c-in nil) :cell :ephemeral) + (value (c-in nil) :cell :ephemeral) (inset (mkv2 (upts 4) (upts 4)) :unchanged-if 'v2=) (depressed (c? (^hilited))) :ct-action (lambda (self event) (declare (ignore event)) (with-c-change :button-press .retog. - (setf (^md-value) t))) + (setf (^value) t))) :title$ (c? (string-capitalize (md-name self))) :text$ (c? (^title$)) :clipped t @@ -102,7 +102,7 @@ (states :cell nil :initarg :states :reader states) ) (:default-initargs - :md-value (c-in nil) + :value (c-in nil) :transition-fn (lambda (current-state state-table) ;(trc "CTFSM :transitionFN curr,table" currentstate statetable) (or (cadr (member current-state state-table :test (if (stringp current-state) @@ -113,11 +113,11 @@ :ct-action (lambda (self event) (declare (ignorable event)) (with-integrity (:change :ctfsm-action) - (let ((newv (funcall (transition-fn self) (md-value self) (states self)))) + (let ((newv (funcall (transition-fn self) (value self) (states self)))) (ct-fsm-assume-value self newv))))))
(defmethod ct-fsm-assume-value (self new-value) - (setf (md-value self) new-value)) + (setf (value self) new-value))
; --------------- CT Toggle -----------------------
@@ -135,13 +135,13 @@ ; () (:default-initargs - :md-value (c-in nil) ;;; closed by default + :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) + :vertices (c? (if (value self) '((2 . -4) (7 . -9) (12 . -4)) '((4 . -2) (9 . -7) (4 . -12)))) :ll 0 :lt 0 :lr (u96ths 15) :lb (downs (u96ths 15)))) @@ -153,7 +153,7 @@ (a-row () (make-kid 'ct-twister :md-name :show-contents - :md-value (c-in ,initial-open) + :value (c-in ,initial-open) :visible (c? (^enabled)) ,@twister-args) ,(if (stringp label) @@ -163,7 +163,7 @@ 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))))) + (not (value tw))))) ,twisted-widget)))
@@ -177,7 +177,7 @@ :ll (c? (geo-kid-wrap self 'pl)) :lr (c? (geo-kid-wrap self 'pr)) :kids (c? (let ((thetree self)) - ;; (trc "making all parts of tree for" (md-value self) rethinker) + ;; (trc "making all parts of tree for" (value self) rethinker) (the-kids (mk-part 'ix-kid-sized :ll (u96ths -20) :px 0 --- /project/cello/cvsroot/cello/image.lisp 2006/11/03 13:38:24 1.16 +++ /project/cello/cvsroot/cello/image.lisp 2006/11/04 20:56:30 1.17 @@ -83,6 +83,7 @@ :initform (c? (or .cache (^showkids))) :reader kids-ever-shown)))
+(export! ix-zero-tl) (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)()) --- /project/cello/cvsroot/cello/ix-paint.lisp 2006/10/02 03:55:23 1.7 +++ /project/cello/cvsroot/cello/ix-paint.lisp 2006/11/04 20:56:30 1.8 @@ -73,7 +73,7 @@ (ix-selectable self)) (visible self) (not (collapsed self))) - (progn ;;with-clipping (self) + (progn ;; with-clipping (self) (progn ;; with-attrib (gl_lighting_bit gl_texture_bit gl_enable_bit gl_hint_bit gl_line_bit gl_color_buffer_bit) (count-it :ix-render) #+(or) (count-it :ix-paint (type-of self)) --- /project/cello/cvsroot/cello/ix-togl.lisp 2006/10/28 18:22:43 1.14 +++ /project/cello/cvsroot/cello/ix-togl.lisp 2006/11/04 20:56:30 1.15 @@ -178,14 +178,11 @@
(defun buttons-shifted (buttons) #+glut (logtest buttons glut_active_shift) - (find :shift-key buttons) - ) + (find :shift-key buttons))
(defun shift-key-down (buttons) #+glut (logtest buttons glut_active_shift) - (find :shift-key buttons) - ) - + (find :shift-key buttons))
(defun control-key-down (buttons) #+glut (logtest buttons glut_active_ctrl) --- /project/cello/cvsroot/cello/nehe-06.lisp 2006/09/05 23:05:36 1.11 +++ /project/cello/cvsroot/cello/nehe-06.lisp 2006/11/04 20:56:30 1.12 @@ -38,7 +38,7 @@ (make-instance 'nehe06 :fm-parent *parent* :width 700 :height 500 - :timer-interval 2 #+later (c? (let ((n$ (md-value (fm-other :vtime)))) + :timer-interval 2 #+later (c? (let ((n$ (value (fm-other :vtime)))) (format nil "~a" (max 1 (or (parse-integer n$ :junk-allowed t) 0))))) :double 1 ;; "yes" )))))) --- /project/cello/cvsroot/cello/slider.lisp 2006/10/17 21:30:08 1.5 +++ /project/cello/cvsroot/cello/slider.lisp 2006/11/04 20:56:30 1.6 @@ -41,7 +41,7 @@ (:frame-3d :edge-raised :thickness (u96ths 3)))) (tracked-pct :initarg :tracked-pct :initform nil :accessor tracked-pct) - (md-value-fn :initarg :md-value-fn :initform nil :accessor md-value-fn) + (value-fn :initarg :value-fn :initform nil :accessor value-fn) (jumper-action :initarg :jumper-action :reader jumper-action :initform 'ix-slider-jumper-action) (jumper-layers :initarg :jumper-layers :reader jumper-layers @@ -51,8 +51,8 @@ ) (:default-initargs :ll 0 :lt 0 - :md-value (c? (let ((vs (loop for k in (rest (^kids)) - collecting (funcall (or (^md-value-fn) 'identity) + :value (c? (let ((vs (loop for k in (rest (^kids)) + collecting (funcall (or (^value-fn) 'identity) (drag-pct k))))) (if (cdr vs) vs (car vs)))) :kids (c? (the-kids @@ -88,12 +88,12 @@ (trc nil "tracked-pct output sets slider" self) (slider-set self new-value)))
-(defun make-slider (md-name &key (md-value-fn 'identity) +(defun make-slider (md-name &key (value-fn 'identity) (initial-pcts (list (mkv2 .50 .50))) (width (uin 1)) (height (u8ths 1))) (make-part md-name 'ix-slider :lr width :lb (downs height) - :md-value-fn md-value-fn + :value-fn value-fn :initial-pcts initial-pcts))
(defun slider-set (self value) --- /project/cello/cvsroot/cello/wm-mouse.lisp 2006/10/17 21:30:08 1.5 +++ /project/cello/cvsroot/cello/wm-mouse.lisp 2006/11/04 20:56:30 1.6 @@ -49,10 +49,16 @@ (defun evt-buttons (os-event) (modifiers os-event))
+(defun evt-shift-key-down (os-event) + (shift-key-down (evt-buttons os-event))) + +(defun evt-control-key-down (os-event) + (control-key-down (evt-buttons os-event))) + (defun evt-where (os-event) (where os-event))
-(export! evt-c-event) +(export! evt-c-event evt-shift-key-down evt-control-key-down) (defun evt-c-event (os-event) (c-event os-event))