[cello-cvs] CVS cello/cellodemo
ktilton
ktilton at common-lisp.net
Fri Apr 11 09:22:55 UTC 2008
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 .}"))))))))
More information about the Cello-cvs
mailing list