[cello-cvs] CVS cello
ktilton
ktilton at common-lisp.net
Sat Nov 4 20:56:30 UTC 2006
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))
, at 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))
More information about the Cello-cvs
mailing list