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@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"