[cells-cvs] CVS update: cell-cultures/cellodemo/cellodemo.lisp cell-cultures/cellodemo/demo-window.lisp cell-cultures/cellodemo/hedron-decoration.lisp cell-cultures/cellodemo/light-panel.lisp

[Kenny Tilton]

Update of /project/cells/cvsroot/cell-cultures/cellodemo
In directory common-lisp.net:/tmp/cvs-serv27567/cellodemo

Modified Files:
	cellodemo.lisp demo-window.lisp hedron-decoration.lisp 
	light-panel.lisp 
Log Message:
Re-port to Lispworks/win32
Date: Thu Oct 28 02:09:03 2004
Author: ktilton

Index: cell-cultures/cellodemo/cellodemo.lisp
diff -u cell-cultures/cellodemo/cellodemo.lisp:1.3 cell-cultures/cellodemo/cellodemo.lisp:1.4
--- cell-cultures/cellodemo/cellodemo.lisp:1.3	Fri Oct 15 05:37:30 2004
+++ cell-cultures/cellodemo/cellodemo.lisp	Thu Oct 28 02:09:03 2004
@@ -22,15 +22,9 @@
 
 (in-package :cello)
 
-(defparameter *cellodemo-images* :unconfigured)
-
-
-(load (merge-pathnames "cellodemo-config.lisp"
-        cl-user::*cello-config-directory*))
-
 (defun demo-image-subdir (subdir)
   (merge-pathnames (make-pathname :directory `(:relative ,(string subdir)))
-    *cellodemo-images*))
+    cl-user::*cell-cultures-graphics-directory*))
 
 (defun demo-image-file (subdir file)
   (merge-pathnames file


Index: cell-cultures/cellodemo/demo-window.lisp
diff -u cell-cultures/cellodemo/demo-window.lisp:1.5 cell-cultures/cellodemo/demo-window.lisp:1.6
--- cell-cultures/cellodemo/demo-window.lisp:1.5	Tue Oct 19 05:47:33 2004
+++ cell-cultures/cellodemo/demo-window.lisp	Thu Oct 28 02:09:03 2004
@@ -22,7 +22,6 @@
 
 (in-package :cello)
 
-
 (defun cello-test ()
   (let ((cells::*c-debug* (get-internal-real-time)))
     (run-stylish-demos '(light-panel ft-jpg tu-geo ftgl-test demo-scroller)
@@ -42,7 +41,11 @@
                  :px 48 :py -48
                  :outset (u8ths 2)
                  :skin (c? (wand-ensure-typed 'wand-texture
-                             (cello-runtime-file "brushdmtl.jpg")))
+                             (merge-pathnames
+                              (make-pathname
+                               :name "brushdmtl"
+                               :type "jpg")
+                              cl-user::*cell-cultures-graphics-directory*)))
                  :pre-layer (c? (let ((tx-name (texture-name (^skin)))
                                       (tx-size (image-size (^skin))))
                                   (with-layers :on +white+
@@ -132,9 +135,8 @@
                       :wand (magick-wand-template)
                       :splice-wand (magick-wand-template)
                       :pathname (merge-pathnames
-                                 (make-pathname 
-                                  :name "bingo" :type "mpg")
-                                 *user-temp-directory*))))
+                                 (make-pathname :name "bingo" :type "mpg")
+                                 cl-user::*cell-cultures-output-directory*))))
     
     :display-continuous nil
     :md-name :demo-w
@@ -148,11 +150,10 @@
     :snapshot-pathnamer (lambda (self)
                           (merge-pathnames
                            (make-pathname
-                             :directory `(:relative "graphics" "out")
                              :name (format nil "snap-me-~3,,,'0 at A"
                                      (snapshot-release-id self))
                              :type "jpg")
-                           cl-user::*devel-root*))
+                           cl-user::*cell-cultures-output-directory*))
     
     :pre-layer (c? (with-layers
                        +white+
@@ -233,7 +234,7 @@
 
 (defun demo-control-panel ()
   (a-row (:spacing (u8ths 2) :justify :center)
-    #+shh (mk-part :rate (frame-rate-text))
+     (mk-part :rate (frame-rate-text))
     (a-stack (:spacing (u16ths 1))
       (texture-picker)
       (demo-picker))
@@ -268,7 +269,7 @@
 
 (defun texture-picker (&aux (backdrops 
                              (directory
-                              (demo-image-subdir "backdrops"))))
+                              (demo-image-subdir "window-bkgs"))))
   (a-row (:spacing (u8ths 1))
     (alabel "Skins")
     (mk-part :texture-picker (ct-radio-row)


Index: cell-cultures/cellodemo/hedron-decoration.lisp
diff -u cell-cultures/cellodemo/hedron-decoration.lisp:1.4 cell-cultures/cellodemo/hedron-decoration.lisp:1.5
--- cell-cultures/cellodemo/hedron-decoration.lisp:1.4	Tue Oct 19 05:47:33 2004
+++ cell-cultures/cellodemo/hedron-decoration.lisp	Thu Oct 28 02:09:03 2004
@@ -85,7 +85,7 @@
     :kids (c? (the-kids
                (a-row ()
                  (hedron-shapes)
-                 (test-image-group :shape-backer "Backdrops" "hedron-bkgs")
+                 (test-image-group :shape-backer "window-bkgs" "hedron-bkgs")
                  (test-image-group :shape-skin "Skin" "shapers" "cloudy"))
                (hedron-texxing)))))
 
@@ -153,7 +153,7 @@
 
 
 (defun hedron-backers ()
-  (test-image-group :shape-backer "Backdrops" "hedron-bkgs"))
+  (test-image-group :shape-backer "window-bkgs" "hedron-bkgs"))
 
 (defun test-image-group (md-name label$ dir-name$ &optional start$)
   (let ((jpegs (mapcan (lambda (type)


Index: cell-cultures/cellodemo/light-panel.lisp
diff -u cell-cultures/cellodemo/light-panel.lisp:1.3 cell-cultures/cellodemo/light-panel.lisp:1.4
--- cell-cultures/cellodemo/light-panel.lisp:1.3	Fri Oct 15 05:37:30 2004
+++ cell-cultures/cellodemo/light-panel.lisp	Thu Oct 28 02:09:03 2004
@@ -59,9 +59,11 @@
   (^nurb)
   (ogl-dsp-list-prep (backdrop self)))
 
-(defmethod not-to-be ((self hedron))
-  (when (^nurb)
-    (glu-delete-nurbs-renderer (^nurb))))
+(defmethod not-to-be :after ((self hedron))
+  (bwhen (q (^quadric))
+    (glu-delete-quadric q))
+  (bwhen (n (^nurb))
+    (glu-delete-nurbs-renderer n)))
 
 (defmethod display-text$ ((self Hedron))
   "quick dirty ugly hack to satisfy ix-styled ogl-disp-list-prep"