[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