Update of /project/cello/cvsroot/cello/cellodemo In directory clnet:/tmp/cvs-serv7403/cellodemo
Modified Files: cellodemo.lisp demo-window.lisp hedron-decoration.lisp hedron-render.lisp light-panel.lisp tutor-geometry.lisp Log Message:
--- /project/cello/cvsroot/cello/cellodemo/cellodemo.lisp 2006/06/03 12:05:55 1.3 +++ /project/cello/cvsroot/cello/cellodemo/cellodemo.lisp 2008/04/11 09:22:55 1.4 @@ -42,8 +42,8 @@ :kids (c? (the-kids (a-row (:px 96 :py (downs 96)) (mk-part :imk-jpg (ix-image-file) - :pre-layer (c? (with-layers +red+ :fill (:wand (^wander)))) - :md-value (c? (demo-image-file "shapers" "grace.jpg"))) + :pre-layer (c? (with-layers +red+ :fill (:wand (^value)))) + :value (c? (demo-image-file "shapers" "grace.jpg"))) (a-stack () (loop for face in '(antquabi bookosb georgiai framd times @@ -56,22 +56,22 @@ (c? (font-ftgl-ensure :texture myface 24))) :text$ "Hello, world!")))) (mk-part :zee (ix-text) - :md-value (c? (if (visible (fm-other :ft-jpg)) - (without-c-dependency (frame-ct .w.)) 0)) + :value (c? (if (visible (fm-other :ft-jpg)) + (without-c-dependency (frame-ct .togl)) 0)) :px (c? (px-maintain-pl (pl (psib)))) :justify-hz :center :py (c? (py-maintain-pt (pb (psib)))) :pre-layer (with-layers (:out 1500) +blue+) - :zoom (c? (let ((start (^md-value))) - (if (without-c-dependency (< 200 (- (frame-ct .w.) start))) + :zoom (c? (let ((start (^value))) + (if (without-c-dependency (< 200 (- (frame-ct .togl) start))) .cache - (make-list 3 :initial-element (min 2.0 (/ (- (frame-ct .w.) start) + (make-list 3 :initial-element (min 2.0 (/ (- (frame-ct .togl) start) 100.0))))))
- :rotation (c? (let ((start (^md-value))) - (if (without-c-dependency (< 200 (- (frame-ct .w.) start))) + :rotation (c? (let ((start (^value))) + (if (without-c-dependency (< 200 (- (frame-ct .togl) start))) .cache - (list (* 360 (/ (min 200 (- (frame-ct .w.) start)) 100.0)) + (list (* 360 (/ (min 200 (- (frame-ct .togl) start)) 100.0)) 1 1 1))))
:text-font (c? (font-ftgl-ensure :texture *gui-style-default-face* 24 )) --- /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2006/08/24 09:33:46 1.6 +++ /project/cello/cvsroot/cello/cellodemo/demo-window.lisp 2008/04/11 09:22:55 1.7 @@ -32,12 +32,12 @@ #+no demo-scroller) 'tu-geo :skin (c? (wand-ensure-typed 'wand-texture - (car (md-value (fm-other :texture-picker))))) + (car (value (fm-other :texture-picker))))) :lb (c-in (downs 1000)))))
-(defun demo-scroller () +(defun demo-scroller (self) (mk-part :demo-scroller (ix-zero-tl) - :kids (c? (list + :kids (c? (the-kids (mk-part :dialog (ix-zero-tl) :px 48 :py -48 :outset (u8ths 2) @@ -68,12 +68,12 @@ :resizeable t :content (c? (mk-part :gview (ix-image-file) :wand-type 'wand-pixels - :md-value (demo-image-file "shapers" "mandelbrot3.gif"))))))) + :value (demo-image-file "shapers" "mandelbrot3.gif")))))))
(defun run-demos (demo-names start-at &rest iargs) (declare (ignorable start-at)) (run-window (apply 'make-instance 'demo-window - :md-value (c-in (list start-at)) + :value (c-in (list start-at)) :content demo-names iargs) (lambda () @@ -129,7 +129,7 @@ ;; :diffuse *dim* ;; :specular *bright*))
- :recording nil #+(or) (c? (when (md-value (fm-other :record)) + :recording nil #+(or) (c? (when (value (fm-other :record)) (make-recording :wand (magick-wand-template) :splice-wand (magick-wand-template) @@ -144,7 +144,7 @@ :lighting :on ;; :clear-rgba (list 0 0 0 1) ;; :light-model (c? (bwhen (lm (fm-other? :light-model)) -;; (list (md-value lm)))) +;; (list (value lm))))
:snapshot-pathnamer (lambda (self) (make-pathname @@ -162,7 +162,7 @@ (:out 500))) :clipped nil :kids (c? (the-kids - (demo-window-beef) + (demo-window-beef self) #+nicetry (mk-part :wintop (ix-zero-tl) :px 0 :py 0 @@ -202,14 +202,14 @@ (ix-sound-find self :close))) (wav-play-till-end nil (car (sound-paths s)))))
-(defun demo-window-beef () +(defun demo-window-beef (self) (mk-part :beef (ix-inline) :orientation :vertical :px 0 :py (u8ths (downs 1)) :spacing (u8ths 1) :lb (c? (^fill-parent-down)) :kids (c? (the-kids - (demo-control-panel) + (demo-control-panel self) (mk-part :demos (ix-zero-tl) ;;:py (u8ths 4) :lb (c? (^fill-parent-down)) @@ -218,24 +218,24 @@ (list (mk-kid-slot (visible) (c? (string-equal (md-name self) - (car (md-value .w.))))) + (car (value .w.))))) (mk-kid-slot (px) (c? (px-maintain-pl 0))) (mk-kid-slot (py) (c? (py-maintain-pt 0))))) :kids (let (demos-built) - (c? (bwhen (demo-factory (car (md-value .w.))) + (c? (bwhen (demo-factory (car (value .w.))) (unless (assoc demo-factory demos-built) (pushnew (cons demo-factory (funcall demo-factory)) demos-built))) (mapcar 'cdr demos-built))))))))
-(defun demo-control-panel () +(defun demo-control-panel (self) (a-row (:spacing (u8ths 2) :justify :center) - (mk-part :rate (frame-rate-text)) + ;;(mk-part :rate (frame-rate-text)) (a-stack (:spacing (u16ths 1)) - (texture-picker) - (demo-picker)) + (texture-picker self) + (demo-picker self)) (a-stack (:spacing (u96ths 6) :justify :center :outset (u96ths 6) @@ -247,12 +247,12 @@ +yellow+ )))
- (alabel "just shoot me!" + (a-label "just shoot me!" :text-font (c? (ftgl-font-ensure :texture 'stacc222 14 96)) :pre-layer (c? (with-layers +yellow+ :fill +gray+))) (mk-part :record (ct-push-toggle) - :md-value (c-in nil) + :value (c-in nil) :title$ "record") (mk-part :snapshot (ct-button) :title$ "snapshot" @@ -266,14 +266,14 @@ (incf snap-count))))))))
-(defun texture-picker (&aux (backdrops +(defun texture-picker (self &aux (backdrops (directory (demo-image-subdir "window-bkgs")))) (a-row (:spacing (u8ths 1)) - (alabel "Skins") + (a-label "Skins") (mk-part :texture-picker (ct-radio-row) :spacing (upts 4) - :md-value (c-in (let ((jpegs backdrops)) + :value (c-in (let ((jpegs backdrops)) (list (or (find-if (lambda (jpeg) (search "concrete" (pathname-name jpeg))) jpegs) @@ -288,9 +288,9 @@ :title$ (pathname-name p))) backdrops)))))
-(defun demo-picker () +(defun demo-picker (self) (a-row (:spacing (u8ths 1) :justify :center) - (alabel "Demos") + (a-label "Demos") (mk-part :demo (ix-row) :spacing (upts 4) :clipped nil @@ -302,30 +302,25 @@ (format nil "~d" s)))) (content .w.))))))
- - -(defun nested-windows () +(defun nested-windows (self) (a-row (:md-name 'nested-windows :px 0 :py 0 :spacing (upts 10)) (a-stack () - (starter-toolbar) - (starter-hedron)) + (starter-toolbar self) + (starter-hedron self))
(mk-part :socket (window-socket) :px (uin 2) :window-factory (lambda (socket glut-xy) (declare (ignorable socket)) (make-instance 'demo-window - :md-value (c-in (list (car (content .w.)))) + :value (c-in (list (car (content .w.)))) :content (content .w.) :glut-xy glut-xy)) - :gen-window-p (c? (md-value (cells::fm-find-one (upper self window) + :gen-window-p (c? (value (cells::fm-find-one (upper self window) :nested :must-find t :skip-tree self))))))
- - - (defparameter *starter-font* nil)
(defparameter *rot* 0) @@ -333,7 +328,7 @@
(defparameter *idle-angle* 0)
-(defun starter-toolbar () +(defun starter-toolbar (self) (a-row (:spacing (upts 10)) (mk-part :hw (ct-button) ;:inset (mkv2 (uPts 4)(uPts 2)) @@ -355,31 +350,10 @@ (kids *sys*))))
(mk-part :nested (ct-check-text) - :md-value (c-in nil) + :value (c-in nil) :title$ "Nested")))
-(defun starter-flag () - (a-row (:lighting :off) - (mk-part :one (ix-view) - :ll (u8ths -2) :lt 0 :lr (u8ths 2) :lb (downs (u8ths 2)) - :lighting nil - :pre-layer (with-layers +red+ (:x-mark t))) - (mk-part :canvasflag (ix-canvas-kid-sized) - :target-res 96 - :kids (the-kids - (mk-part :two (ix-view) - :px 0 :py 0 - :ll (u8ths -2) :lt 0 :lr (u8ths 2) :lb (downs (u8ths 2)) - :bkg-color (c? (trc nil "s mi" self (mouse-view .w.) - (^mouse-over-p)) - (if (^mouse-over-p) - +black+ +blue+)) - :pre-layer (with-layers (:rgba (^bkg-color)) :fill))) - :pre-layer (with-layers +black+)) - (mk-part :tree (ix-view) - :ll (u8ths -2) :lt 0 :lr (u8ths 2) :lb (downs (u8ths 2)) - :pre-layer (with-layers +green+ :fill)) - )) +
--- /project/cello/cvsroot/cello/cellodemo/hedron-decoration.lisp 2006/06/03 12:05:55 1.2 +++ /project/cello/cvsroot/cello/cellodemo/hedron-decoration.lisp 2008/04/11 09:22:55 1.3 @@ -33,23 +33,23 @@ (mk-part :spinning (ct-check-text) :title$ "spinning") (mk-part :wireframe (ct-check-text) - :md-value (c-in t) + :value (c-in t) :title$ "wireframe" :clipped nil :enabled t))
(a-stack () - (alabel "line width") + (a-label "line width") (make-slider :line-width :initial-pcts (list (mkv2 .05 .05))))
(a-stack () - (alabel "spin") + (a-label "spin") (make-slider :rotx :initial-pcts (list (mkv2 .15 .15))) (make-slider :roty :initial-pcts (list (mkv2 .15 .15))) (make-slider :rotz :initial-pcts (list (mkv2 .15 .15))))
(a-stack () - (alabel "scale") + (a-label "scale") (make-slider :scalex) (make-slider :scaley) (make-slider :scalez)) @@ -58,41 +58,41 @@ :justify :right)
(a-stack () - (alabel "color") + (a-label "color") (make-rgba-mixer :hedro-color :alpha 1 :init-all .5))
(a-stack (:collapsed t) - (alabel "specular") + (a-label "specular") (make-rgba-mixer :hedro-specular :init-all .8))
(a-stack () - (alabel "shiny") + (a-label "shiny") (make-slider :hedro-shiny)))
(a-stack () (mk-part :lights-on (ct-check-text) - :md-value (c-in t) + :value (c-in t) :title$ "glowing") (make-rgba-mixer :hedro-emission :init-all 0.3))
- (shape-options) + (shape-options self) ))))
-(defun hedron-tex-options () +(defun hedron-tex-options (self) (mk-part :tex-options (ix-inline) :orientation :vertical :justify :left :kids (c? (the-kids (a-row () - (hedron-shapes) + (hedron-shapes self) (test-image-group :shape-backer "window-bkgs" "hedron-bkgs") (test-image-group :shape-skin "Skin" "shapers" "cloudy")) - (hedron-texxing))))) + (hedron-texxing self)))))
-(defun hedron-shapes () +(defun hedron-shapes (self) (a-stack () - (alabel "Shape/Sides") + (a-label "Shape/Sides") (mk-part :scroller (ix-scroller) :mac-p t :scroll-bars '(:vertical) @@ -101,7 +101,7 @@ :content (c? (mk-part :shape (ix-inline) :orientation :vertical :pre-layer (with-layers +white+ :fill) - :md-value (c-in (list 'nurb)) + :value (c-in (list 'nurb)) :kids (c? (loop for shape in '(nurb cube 4 8 12 rhombic-dodecahedron 20 cylinder cone sphere torus sierpinski-sponge teapot cello) @@ -109,7 +109,7 @@ :radio self :associated-value shape :already-on-do nil - :text-color (c? (if (^md-value) + :text-color (c? (if (^value) +red+ +black+)) :pre-layer (c? (with-layers (:rgba (^text-color)))) @@ -118,7 +118,7 @@ :text$ (string-downcase (format nil "~d" shape))))))))))
-(defun hedron-texxing () +(defun hedron-texxing (self) (a-row (:spacing (u8ths 2)) (a-row () (let ((styles `((object . ,gl_object_linear) @@ -126,11 +126,11 @@ (sphere . ,gl_sphere_map)))) (mk-part :tex-gen (ct-radio-row) :spacing (upts 4) - :md-value (c-in (list gl_object_linear)) + :value (c-in (list gl_object_linear)) :clipped nil :kids (c? (mapcar (lambda (s) (mk-part :rb (ct-radio-push-button) - ;;:md-value (c? (see-if-on self)) + ;;:value (c? (see-if-on self)) :associated-value (cdr s) ;;:radio (c? (find-radio self)) :inset (mkv2 2 2) @@ -141,7 +141,7 @@ (let ((styles `((repeat . ,gl_repeat)(clamp . ,gl_clamp)))) (mk-part :tex-wrap (ct-radio-row) :spacing (upts 4) - :md-value (c-in (list gl_repeat)) + :value (c-in (list gl_repeat)) :clipped nil :kids (c? (mapcar (lambda (s) (mk-part :rb (ct-radio-push-button) @@ -153,17 +153,17 @@
-(defun hedron-backers () - (test-image-group :shape-backer "window-bkgs" "hedron-bkgs")) +(defun hedron-backers (self) + (test-image-group self :shape-backer "window-bkgs" "hedron-bkgs"))
-(defun test-image-group (md-name label$ dir-name$ &optional start$) +(defun test-image-group (self md-name label$ dir-name$ &optional start$) (let ((jpegs (mapcan (lambda (type) (directory (merge-pathnames (make-pathname :type type) (demo-image-subdir dir-name$)))) '("jpg" "bmp" "gif" "tif")))) (a-stack () - (alabel label$) + (a-label label$) (mk-part :scroller (ix-scroller) :mac-p t :scroll-bars '(:vertical) @@ -172,7 +172,7 @@ :content (c? (make-part md-name 'ix-inline :orientation :vertical :pre-layer (with-layers +white+ :fill) - :md-value (c-in (list (or (when start$ + :value (c-in (list (or (when start$ (find-if (lambda (jpeg) (search start$ (namestring jpeg))) jpegs)) @@ -183,7 +183,7 @@ :radio self :associated-value p :already-on-do :off - :text-color (c? (if (^md-value) + :text-color (c? (if (^value) +red+ +black+)) :pre-layer (c? (with-layers (:rgba (^text-color)))) --- /project/cello/cvsroot/cello/cellodemo/hedron-render.lisp 2006/06/03 12:05:55 1.2 +++ /project/cello/cvsroot/cello/cellodemo/hedron-render.lisp 2008/04/11 09:22:55 1.3 @@ -117,41 +117,41 @@
(gl-matrix-mode gl_modelview) (with-matrix (nil) - (let ((shape (car (md-value (fm^ :shape)))) - (wireframe-p (md-value (fm^ :wireframe))) - (tex-gen (or (car (md-value (fm^ :tex-gen))) + (let ((shape (car (value (fm^ :shape)))) + (wireframe-p (value (fm^ :wireframe))) + (tex-gen (or (car (value (fm^ :tex-gen))) gl_sphere_map)) - (tex-wrap (or (car (md-value (fm^ :tex-wrap))) + (tex-wrap (or (car (value (fm^ :tex-wrap))) gl_sphere_map)) - (line-width (or (md-value (fm^ :line-width)) + (line-width (or (value (fm^ :line-width)) (mkv2 4 0))) - (scalex (or (md-value (fm^ :scalex)) + (scalex (or (value (fm^ :scalex)) (mkv2 0 0))) - (scaley (or (md-value (fm^ :scaley)) + (scaley (or (value (fm^ :scaley)) (mkv2 0 0))) - (scalez (or (md-value (fm^ :scalez)) + (scalez (or (value (fm^ :scalez)) (mkv2 0 0))) - (size (or (md-value (fm^ :size)) + (size (or (value (fm^ :size)) 1)) - (height (or (md-value (fm^ :height)) + (height (or (value (fm^ :height)) 1)) - (base-r (or (md-value (fm^ :base-r)) + (base-r (or (value (fm^ :base-r)) 1)) - (top-r (or (md-value (fm^ :top-r)) + (top-r (or (value (fm^ :top-r)) 1)) - (inner-r (or (md-value (fm^ :inner-r)) + (inner-r (or (value (fm^ :inner-r)) 0.5)) - (outer-r (or (md-value (fm^ :outer-r)) + (outer-r (or (value (fm^ :outer-r)) 0.5)) - (sides (or (md-value (fm^ :sides)) + (sides (or (value (fm^ :sides)) 1)) - (rings (or (md-value (fm^ :rings)) + (rings (or (value (fm^ :rings)) 1)) - (slices (or (md-value (fm^ :slices)) + (slices (or (value (fm^ :slices)) 1)) - (stacks (or (md-value (fm^ :stacks)) + (stacks (or (value (fm^ :stacks)) 1)) - (levels (or (md-value (fm^ :levels)) + (levels (or (value (fm^ :levels)) 1)) ) (if (skin self) @@ -165,7 +165,7 @@ (cube .5) (cello ;(gl-translatef -100 0 0) ;;-1440) (rpchk 'hedron t nil self) - ;;(trc "evaluating md-value" self) + ;;(trc "evaluating value" self)
.5) (torus .5) --- /project/cello/cvsroot/cello/cellodemo/light-panel.lisp 2006/11/03 13:38:24 1.6 +++ /project/cello/cvsroot/cello/cellodemo/light-panel.lisp 2008/04/11 09:22:55 1.7 @@ -43,13 +43,13 @@ :lighting :on :text-font (ftgl-make :extruded *gui-style-default-face* 18 96 9) :rotation (let ((rx 0)(ry 0)(rz 0)) - (c? (bIf (spinning (md-value (fm-other :spinning))) + (c? (bIf (spinning (value (fm-other :spinning))) (macrolet ((radj (axis ixid) `(incf ,axis (if spinning - (* 10 (v2-h (md-value (fm-other ,ixid)))) + (* 10 (v2-h (value (fm-other ,ixid)))) 0)))) - (when (frame-ct .w.) + (when (frame-ct .togl) (list (radj rx :rotx) (radj ry :roty) (radj rz :rotz)))) @@ -83,10 +83,10 @@ :sound `((:click . ,(lambda (self) (declare (ignore self)) (make-sound :paths '("click") :gain .5 :source :default)))) - :md-value (c? (^rgba-value)) + :value (c? (^rgba-value)) :rgba-value (c? (make-rgba :fo (apply 'make-floatv (mapcar (lambda (k) - (v2-h (md-value k))) (^kids))))) + (v2-h (value k))) (^kids))))) :kids (c? (mapcar (lambda (c) (make-slider c :initial-pcts (list (mkv2 (or (slot-value self c) @@ -96,7 +96,7 @@ (defun make-rgba-mixer (md-name &rest iargs) (apply 'make-part md-name 'rgba-mixer iargs))
-(defun light-panel () +(defun light-panel (self) (a-row (:md-name 'light-panel ;; :px (u8ths 4) :py (u8ths (downs 4)) :lb (c? (^fill-parent-down)) :spacing (u8ths 2) :justify :top @@ -104,11 +104,11 @@
(a-stack (:spacing (u8ths 1) :justify :right) (a-stack ( :justify :right) - (alabel "Light model") + (a-label "Light model") (mk-part :light-model (rgba-mixer) :red .20 - :md-value (c? (cons gl_light_model_ambient (rgba-fo (^rgba-value)))))) - (alabel "World Color") + :value (c? (cons gl_light_model_ambient (rgba-fo (^rgba-value)))))) + (a-label "World Color") (make-rgba-mixer :world-color) (a-row () (make-lighting :light0 gl_light0 *light-pos-tl*) @@ -117,7 +117,7 @@ ;(make-lighting :light3 GL_LIGHT3 *LightPosTR*) ))
- (starter-hedron))) + (starter-hedron self)))
(defun make-lighting (md-name id pos) (make-instance 'ix-light @@ -125,26 +125,26 @@ :id id :initial-pos pos))
-(defun starter-hedron () +(defun starter-hedron (self) (a-row (:outset (u8ths 1) :spacing (u8ths 1) :lb (c? (^fill-parent-down))) (hedron-options) (a-stack (:spacing (u8ths 1) :justify :left) - (hedron-tex-options) + (hedron-tex-options self) (mk-part :hedron (hedron) :ll (u96ths -300) :lt (ups (u96ths 300)) :lr (u96ths 300) :lb (downs (u96ths 300)) :clipped t :lighting :on - :mat-ambi-diffuse (c? (md-value (fm-other :hedro-color))) - :mat-specular (c? (md-value (fm-other :hedro-specular))) - :mat-shiny (c? (v2-h (md-value (fm-other :hedro-shiny)))) - :mat-emission (c? (when (md-value (fm-other :lights-on)) - (md-value (fm-other :hedro-emission)))) + :mat-ambi-diffuse (c? (value (fm-other :hedro-color))) + :mat-specular (c? (value (fm-other :hedro-specular))) + :mat-shiny (c? (v2-h (value (fm-other :hedro-shiny)))) + :mat-emission (c? (when (value (fm-other :lights-on)) + (value (fm-other :hedro-emission)))) :backdrop (c? (assert (not *ogl-listing-p*)) (wand-ensure-typed 'wand-texture - (car (md-value (fm-other :shape-backer))) + (car (value (fm-other :shape-backer))) :tile-p nil)) :pre-layer (with-layers (:in 300) @@ -160,11 +160,11 @@ +white+)
:skin (c? (wand-ensure-typed 'wand-texture - (car (md-value (fm^ :shape-skin))))))))) + (car (value (fm^ :shape-skin)))))))))
-(defun shape-options () +(defun shape-options (self) (a-stack (:justify :right) (loop for spec in '((:size 5)(:height 5) (:base-r 5) (:top-r 5) @@ -176,11 +176,11 @@ :spacing (upts 2) :justify :center :visible (c? (find id (shape-ids - (car (md-value (without-c-dependency + (car (value (without-c-dependency (fm^ :shape)))))))) - (alabel (string-downcase id)) + (a-label (string-downcase id)) (make-slider id - :md-value-fn (lambda (drag-pct) + :value-fn (lambda (drag-pct) (* (expt (v2-h drag-pct) 2) max))))))))
(defmethod shape-ids ((shape (eql 'cone))) @@ -209,21 +209,21 @@ (defmodel ix-light (light ix-stack) ((initial-pos :initarg :initial-pos :initform nil :accessor initial-pos)) (:default-initargs - :md-value nil #+(or) (c? (when (md-value (fm-other :enabled)) + :value nil #+(or) (c? (when (value (fm-other :enabled)) (make-instance 'light :id id))) - :enabled (c? (md-value (fm-other :enabled))) - :pos (c? (md-value (fm-other :xyz-pos))) - :ambient (c? (rgba-fo (md-value (fm-other :ambient)))) - :diffuse (c? (rgba-fo (md-value (fm-other :diffuse)))) - :specular (c? (rgba-fo (md-value (fm-other :specular)))) - :cutoff (c? (round (* 180 (v2-h (md-value (fm-other :cutoff)))))) - :spot-exp (c? (round (* 128 (v2-h (md-value (fm-other :spot-exponent)))))) + :enabled (c? (value (fm-other :enabled))) + :pos (c? (value (fm-other :xyz-pos))) + :ambient (c? (rgba-fo (value (fm-other :ambient)))) + :diffuse (c? (rgba-fo (value (fm-other :diffuse)))) + :specular (c? (rgba-fo (value (fm-other :specular)))) + :cutoff (c? (round (* 180 (v2-h (value (fm-other :cutoff)))))) + :spot-exp (c? (round (* 128 (v2-h (value (fm-other :spot-exponent)))))) :justify :right :spacing (u16ths 1) :kids (c? (the-kids (mk-part :enabled (ct-check-text) - :md-value (c-in t) + :value (c-in t) :title$ "on/off";;(c? (string-downcase (string (md-name (upper self ix-light))))) :clipped nil :enabled t) @@ -233,18 +233,18 @@ ;;:justify-hz :right :text-font (font-ftgl-ensure :texture 'arialn 10) :pre-layer (with-layers +black+) - :text$ (c? (let ((fpos (md-value (fm-other :xyz-pos)))) + :text$ (c? (let ((fpos (value (fm-other :xyz-pos)))) (format nil "~6,,,d ~6,,,d ~6,,,d" (round (eltf fpos 0)) (round (eltf fpos 1))(round (eltf fpos 2)))))) (a-row (:md-name :xyz-pos - :md-value (c? (eko (nil "xyz c?") + :value (c? (eko (nil "xyz c?") (let* ((ks (^kids)) - (xy (md-value (car ks)))) + (xy (value (car ks)))) (make-ff-array :float (pct-xlate (v2-h xy) (ll .w.) (lr .w.) .30) (pct-xlate (v2-v xy) (lb .w.) (lt .w.) .50) - (eko (nil "light pos z" (v2-v (md-value (second ks)))) - (pct-xlate (v2-v (md-value (second ks))) + (eko (nil "light pos z" (v2-v (value (second ks)))) + (pct-xlate (v2-v (value (second ks))) *mgw-near* *mgw-far* 1.5)) 1))))) (make-slider :xy-pos @@ -255,7 +255,7 @@ :width (u8ths 1) :height (u8ths 5))) (a-stack (:justify :right) - (alabel "cutoff/spot") + (a-label "cutoff/spot") (make-slider :cutoff :initial-pcts (list (mkv2 .75 0)) :width (u8ths 4) @@ -265,11 +265,11 @@ :width (u8ths 4) :height (u8ths 1))) (a-stack (:justify :right) - (alabel "ambient") + (a-label "ambient") (make-rgba-mixer :ambient :init-all 0.1)) (a-stack (:justify :right) - (alabel "diffusion") + (a-label "diffusion") (make-rgba-mixer :diffuse)) (a-stack (:justify :right :visible nil :collapsed t) - (alabel "specular") + (a-label "specular") (make-rgba-mixer :specular)))))) --- /project/cello/cvsroot/cello/cellodemo/tutor-geometry.lisp 2006/06/26 17:05:20 1.3 +++ /project/cello/cvsroot/cello/cellodemo/tutor-geometry.lisp 2008/04/11 09:22:55 1.4 @@ -57,15 +57,15 @@ (tu-box :ftgrow :px 300 :py -500 :skin +yellow+ - :md-value (c? (degree-radians (mod (frame-ct .w.) 360))) - :ll (c? (+ -62.5 (* 62.5 (cos (^md-value))))) - :lt (c? (+ 62.5 (* -62.5 (sin (^md-value)))))) + :value (c? (degree-radians (mod (frame-ct .togl) 360))) + :ll (c? (+ -62.5 (* 62.5 (cos (^value))))) + :lt (c? (+ 62.5 (* -62.5 (sin (^value)))))) (mk-part :bye (ct-button) :px (c? (/ (l-width .w.) 2)) :py (c? (downs (/ (l-height .w.) 2))) :text$ "Close" :ct-action (lambda (self event) - (declare (ignorable event)) + (declare (ignorable self event)) (ctk::tcl-eval-ex ctk::*tki* "{destroy .}"))))))))