- cells-cvs@common-lisp.net - mailman3.common-lisp.net

[cells-cvs] CVS update: Directory change: cell-cultures/cell-cultures-user
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cell-cultures-user In directory common-lisp.net:/tmp/cvs-serv28655/cell-cultures-user Log Message: Directory /project/cells/cvsroot/cell-cultures/cell-cultures-user added to the repository Date: Thu Oct 28 02:16:44 2004 Author: ktilton New directory cell-cultures/cell-cultures-user added

1 0

[cells-cvs] CVS update: cell-cultures/utils-kt/defpackage.lisp cell-cultures/utils-kt/detritus.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/utils-kt In directory common-lisp.net:/tmp/cvs-serv27567/utils-kt Modified Files: defpackage.lisp detritus.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:42 2004 Author: ktilton Index: cell-cultures/utils-kt/defpackage.lisp diff -u cell-cultures/utils-kt/defpackage.lisp:1.5 cell-cultures/utils-kt/defpackage.lisp:1.6 --- cell-cultures/utils-kt/defpackage.lisp:1.5 Wed Jul 7 03:25:41 2004 +++ cell-cultures/utils-kt/defpackage.lisp Thu Oct 28 02:09:42 2004 @@ -24,14 +24,16 @@ (defpackage :utils-kt (:nicknames #:ukt) - (:use #:common-lisp - #-(or cormanlisp cmu sbcl) #:clos - #+sbcl #:sb-mop - #+mcl #:ccl) + (:use #:common-lisp + #-(or cormanlisp cmu sbcl) #:clos + #+sbcl #:sb-mop + #+mcl #:ccl) (:export #:utils-kt-reset - #:eko #:count-it #:count-of #:trc #:trcp - #:wdbg #:maptimes #:bwhen #:bif #:xor - "WITH-DYNAMIC-FN" #:last1 #:packed-flat! #:with-metrics - "TRUE" "SHORTC" #:intern$ #:defconstant-once "*COUNT*" "*STOP*" - "*DBG*" "*TRCDEPTH*" - #:make-fifo-queue #:fifo-add #:fifo-empty #:fifo-pop #:mapfifo)) + #:eko #:count-it #:count-of #:trc #:trcp + #:wdbg #:maptimes #:bwhen #:bif #:xor + "WITH-DYNAMIC-FN" #:last1 #:packed-flat! #:with-metrics + #-(or lispworks mcl) "TRUE" "SHORTC" + #:intern$ + #:defconstant-once "*COUNT*" "*STOP*" + "*DBG*" "*TRCDEPTH*" + #:make-fifo-queue #:fifo-add #:fifo-empty #:fifo-pop #:mapfifo)) Index: cell-cultures/utils-kt/detritus.lisp diff -u cell-cultures/utils-kt/detritus.lisp:1.1 cell-cultures/utils-kt/detritus.lisp:1.2 --- cell-cultures/utils-kt/detritus.lisp:1.1 Sat Jun 26 20:38:43 2004 +++ cell-cultures/utils-kt/detritus.lisp Thu Oct 28 02:09:42 2004 @@ -42,7 +42,7 @@ (copy-list (class-instance-slots c)))) -#-lispworks +#-(or lispworks mcl) (defun true (it) (declare (ignore it)) t) (defun false (it) (declare (ignore it))) (defun xor (c1 c2)

1 0

[cells-cvs] CVS update: cell-cultures/config/cl-magick-config.lisp cell-cultures/config/cellodemo-config.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/config In directory common-lisp.net:/tmp/cvs-serv27567/config Modified Files: cl-magick-config.lisp Removed Files: cellodemo-config.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:40 2004 Author: ktilton Index: cell-cultures/config/cl-magick-config.lisp diff -u cell-cultures/config/cl-magick-config.lisp:1.2 cell-cultures/config/cl-magick-config.lisp:1.3 --- cell-cultures/config/cl-magick-config.lisp:1.2 Fri Oct 1 06:01:32 2004 +++ cell-cultures/config/cl-magick-config.lisp Thu Oct 28 02:09:40 2004 @@ -31,13 +31,3 @@ (merge-pathnames (make-pathname :name "CORE_RL_wand_" :type "dll") cl-user::*cello-dynlib-directory*)) - -(setq *cl-magick-source-directory* - (merge-pathnames - (make-pathname :directory '(:relative "cl-magick")) - cl-user::*devel-root*)) - -(setq *magick-wand-templates* - (merge-pathnames - (make-pathname :directory '(:relative "image")) - *cl-magick-source-directory*))

1 0

[cells-cvs] CVS update: cell-cultures/cl-opengl/cl-opengl.asd cell-cultures/cl-opengl/cl-opengl.lisp cell-cultures/cl-opengl/gl-functions.lisp cell-cultures/cl-opengl/ogl-utils.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cl-opengl In directory common-lisp.net:/tmp/cvs-serv27567/cl-opengl Modified Files: cl-opengl.asd cl-opengl.lisp gl-functions.lisp ogl-utils.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:33 2004 Author: ktilton Index: cell-cultures/cl-opengl/cl-opengl.asd diff -u cell-cultures/cl-opengl/cl-opengl.asd:1.1 cell-cultures/cl-opengl/cl-opengl.asd:1.2 --- cell-cultures/cl-opengl/cl-opengl.asd:1.1 Sat Jun 26 20:38:40 2004 +++ cell-cultures/cl-opengl/cl-opengl.asd Thu Oct 28 02:09:33 2004 @@ -15,17 +15,20 @@ :maintainer "Kenny Tilton <ktilton(a)nyc.rr.com>" :licence "MIT" :description "Partial OpenGL Bindings" - :long-description "Poorly implemented bindings to half of OpenGL" + :long-description "Bindings to most of OpenGL, more on demand" :perform (load-op :after (op cl-opengl) (pushnew :cl-opengl cl:*features*)) + :depends-on (:utils-kt :ffi-extender) + :serial t :components ((:file "cl-opengl") (:file "gl-def" :depends-on ("cl-opengl")) (:file "gl-constants" :depends-on ("gl-def")) - (:file "gl-functions" :depends-on ("gl-constants")) - (:file "glu-functions" :depends-on ("gl-functions")) - (:file "glut-functions" :depends-on ("glu-functions")) - (:file "glut-def" :depends-on ("glut-functions")) - (:file "glut-extras" :depends-on ("glut-def")) - (:file "ogl-macros" :depends-on ("glut-extras")) - (:file "ogl-utils" :depends-on ("ogl-macros")) - (:file "nehe-14" :depends-on ("ogl-utils")))) + (:file "gl-functions" :depends-on ("gl-def")) + (:file "glu-functions" :depends-on ("gl-def")) + (:file "glut-functions" :depends-on ("gl-def")) + (:file "glut-def" :depends-on ("gl-def")) + (:file "glut-extras" :depends-on ("gl-def")) + (:file "ogl-macros" :depends-on ("gl-def")) + (:file "ogl-utils" :depends-on ("gl-def")) + (:file "nehe-14" :depends-on ("gl-def")) + )) Index: cell-cultures/cl-opengl/cl-opengl.lisp diff -u cell-cultures/cl-opengl/cl-opengl.lisp:1.3 cell-cultures/cl-opengl/cl-opengl.lisp:1.4 --- cell-cultures/cl-opengl/cl-opengl.lisp:1.3 Fri Oct 1 06:01:29 2004 +++ cell-cultures/cl-opengl/cl-opengl.lisp Thu Oct 28 02:09:33 2004 @@ -59,7 +59,7 @@ #:ogl-texture-delete #:ogl-texture-gen #:ogl-tex-gen-setup #:ogl-bounds #:ogl-scissor-box #:ogl-raster-pos-get #:ogl-pen-move #:with-bitmap-shifted - #:texture-name #:ogl-list-cache #:ogl-lists-delete + #:texture-name #:eltgli #:ogl-tex-activate #:gl-name)) (in-package :cl-opengl) @@ -69,8 +69,8 @@ (defparameter *glut-dynamic-lib* :unconfigured) (eval-when (compile load) - (load (merge-pathnames "cl-opengl-config.lisp" - cl-user::*cello-config-directory*))) + (load (merge-pathnames "cl-opengl-config" + cl-user::*cell-cultures-config*))) (defparameter *opengl-dll* nil) Index: cell-cultures/cl-opengl/gl-functions.lisp diff -u cell-cultures/cl-opengl/gl-functions.lisp:1.3 cell-cultures/cl-opengl/gl-functions.lisp:1.4 --- cell-cultures/cl-opengl/gl-functions.lisp:1.3 Fri Oct 1 06:01:29 2004 +++ cell-cultures/cl-opengl/gl-functions.lisp Thu Oct 28 02:09:33 2004 @@ -357,7 +357,8 @@ (glsizei width glsizei height glenum format glenum type glvoid *pixels)) (defun-ogl :void "open-gl" "glCopyPixels" ( glint x glint y glsizei width glsizei height glenum type )) -/* stenciling */ +#| stenciling |# + (defun-ogl :void "open-gl" "glStencilFunc" ( glenum func glint ref gluint mask )) (defun-ogl :void "open-gl" "glStencilMask" ( gluint mask )) (defun-ogl :void "open-gl" "glStencilOp" ( glenum fail glenum zfail glenum zpass )) Index: cell-cultures/cl-opengl/ogl-utils.lisp diff -u cell-cultures/cl-opengl/ogl-utils.lisp:1.4 cell-cultures/cl-opengl/ogl-utils.lisp:1.5 --- cell-cultures/cl-opengl/ogl-utils.lisp:1.4 Tue Oct 19 05:47:37 2004 +++ cell-cultures/cl-opengl/ogl-utils.lisp Thu Oct 28 02:09:33 2004 @@ -209,36 +209,6 @@ ((texture-name :accessor texture-name :initform nil) (texture-precedence :accessor texture-precedence :initform 0))) -(defparameter *ogl-display-lists* nil) - -(defmethod ogl-lists-delete (node) - (dsp-lists-delete (ogl-list-cache node))) - -(defmethod ogl-list-cache (other) - (declare (ignore other)) - *ogl-display-lists*) - -(defmethod (setf ogl-list-cache) (new-value other) - (declare (ignore other)) - (setf *ogl-display-lists* new-value)) - -(defun dsp-lists-delete (list-cache) - (dolist (k-dl list-cache) - (gl-delete-lists (cdr k-dl) 1))) - -(defun dsp-list-store (list node keys) - (push (cons keys list) (ogl-list-cache node))) - -(defun dsp-list-lookup (keys list) - (cdr (assoc keys list :test 'equal))) - -(defun dsp-list-dump (node) - (format t "display-lists for ~a" node) - (loop for (key . list) in (ogl-list-cache node) - do (format t "~d : ~a" list key))) - -(defparameter *new-listing* nil) - (defun flatten (&rest args) (mapcan (lambda (arg) (if (consp arg)

1 0

[cells-cvs] CVS update: cell-cultures/cl-openal/altypes.lisp cell-cultures/cl-openal/cl-openal.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cl-openal In directory common-lisp.net:/tmp/cvs-serv27567/cl-openal Modified Files: altypes.lisp cl-openal.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:31 2004 Author: ktilton Index: cell-cultures/cl-openal/altypes.lisp diff -u cell-cultures/cl-openal/altypes.lisp:1.1 cell-cultures/cl-openal/altypes.lisp:1.2 --- cell-cultures/cl-openal/altypes.lisp:1.1 Sat Jun 26 20:38:40 2004 +++ cell-cultures/cl-openal/altypes.lisp Thu Oct 28 02:09:25 2004 @@ -24,7 +24,6 @@ (dft al-bitfield #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-int :int integer) -(dft al-sizei :int integer) (dft al-uint #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) (dft al-ushort #-allegro-v5.0.1 :unsigned-int #+allegro-v5.0.1 :int integer) Index: cell-cultures/cl-openal/cl-openal.lisp diff -u cell-cultures/cl-openal/cl-openal.lisp:1.1 cell-cultures/cl-openal/cl-openal.lisp:1.2 --- cell-cultures/cl-openal/cl-openal.lisp:1.1 Sat Jun 26 20:38:40 2004 +++ cell-cultures/cl-openal/cl-openal.lisp Thu Oct 28 02:09:25 2004 @@ -46,8 +46,8 @@ (defparameter *audio-files* :unconfigured) (eval-when (compile load) - (load (merge-pathnames "cl-openal-config.lisp" - cl-user::*cello-config-directory*))) + (load (merge-pathnames "cl-openal-config" + cl-user::*cell-cultures-config*))) #+doit (xoa)

1 0

[cells-cvs] CVS update: cell-cultures/cl-magick/cl-magick.lisp cell-cultures/cl-magick/mgk-test.lisp cell-cultures/cl-magick/wand-pixels.lisp cell-cultures/cl-magick/wand-texture.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cl-magick In directory common-lisp.net:/tmp/cvs-serv27567/cl-magick Modified Files: cl-magick.lisp mgk-test.lisp wand-pixels.lisp wand-texture.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:22 2004 Author: ktilton Index: cell-cultures/cl-magick/cl-magick.lisp diff -u cell-cultures/cl-magick/cl-magick.lisp:1.2 cell-cultures/cl-magick/cl-magick.lisp:1.3 --- cell-cultures/cl-magick/cl-magick.lisp:1.2 Fri Oct 15 05:37:40 2004 +++ cell-cultures/cl-magick/cl-magick.lisp Thu Oct 28 02:09:21 2004 @@ -44,18 +44,18 @@ (in-package :cl-magick) (defparameter *magick-dynamic-lib* :unconfigured) -(defparameter *magick-wand-templates* :unconfigured) -(defparameter *cl-magick-source-directory* :unconfigured) (eval-when (:compile-toplevel :load-toplevel) - (load (merge-pathnames "cl-magick-config.lisp" - cl-user::*cello-config-directory*))) + (load (merge-pathnames "cl-magick-config" + cl-user::*cell-cultures-config*))) (defun magick-wand-template () (path-to-wand (merge-pathnames - (make-pathname :name "metal" :type "gif") - *magick-wand-templates*))) + (make-pathname + :directory '(:relative "templates") + :name "metal" :type "gif") + cl-user::*cell-cultures-graphics-directory*))) (defparameter *imagick-dll-loaded* nil) (defparameter *wands-loaded* nil) Index: cell-cultures/cl-magick/mgk-test.lisp diff -u cell-cultures/cl-magick/mgk-test.lisp:1.3 cell-cultures/cl-magick/mgk-test.lisp:1.4 --- cell-cultures/cl-magick/mgk-test.lisp:1.3 Fri Oct 15 05:37:40 2004 +++ cell-cultures/cl-magick/mgk-test.lisp Thu Oct 28 02:09:21 2004 @@ -23,18 +23,13 @@ (in-package :cl-magick) -;;;(defun test-images (images-subdir) -;;; (mapcan (lambda (ftype) -;;; (directory (merge-pathnames (make-pathname :type ftype) -;;; images-subdir (string ftype)))) -;;; '(jpg bmp gif tif png))) - #+cello (defun mgk-wand-dump (w &rest info) - (clo::trc "mgk-wand-dump" w info) - (clo::trc "> width" (magick-get-image-width w)) - (clo::trc "> height" (magick-get-image-height w)) - (clo::trc "> description" (magick-describe-image w))) + (ukt::trc "mgk-wand-dump" w info) + ;; (ukt::trc "> width" (magick-get-image-width w)) + ;; (ukt::trc "> height" (magick-get-image-height w)) + ;; (ukt::trc "> description" (magick-describe-image w)) + ) (defconstant wcx 640) ;; Window Width (defconstant wcy 480) ;; Window Height @@ -268,11 +263,10 @@ (defun test-image (filename filetype) (merge-pathnames (make-pathname - :directory '(:relative "test") + :directory '(:relative "shapers") :name (string filename) :type (string filetype)) - *cl-magick-source-directory*)) - + cl-user::*cell-cultures-graphics-directory*)) (defun r6init() (gl-enable gl_texture_2d) @@ -283,9 +277,9 @@ (gl-depth-func gl_lequal) (gl-hint gl_perspective_correction_hint gl_nicest) (setf *skin6* (mgk:wand-ensure-typed 'wand-texture - (clo::demo-image-file 'shapers "jmcbw512.jpg"))) + (test-image "jmcbw512" "jpg"))) (setf *grace* (mgk:wand-ensure-typed 'wand-pixels - (clo::demo-image-file 'shapers "grace.jpg")))) + (test-image "grace" "jpg")))) #+test Index: cell-cultures/cl-magick/wand-pixels.lisp diff -u cell-cultures/cl-magick/wand-pixels.lisp:1.2 cell-cultures/cl-magick/wand-pixels.lisp:1.3 --- cell-cultures/cl-magick/wand-pixels.lisp:1.2 Fri Oct 1 06:01:19 2004 +++ cell-cultures/cl-magick/wand-pixels.lisp Thu Oct 28 02:09:21 2004 @@ -44,7 +44,7 @@ :image-sz sz) (let ((y-move (downs (+ 0 (abs (- top bottom)))))) (with-bitmap-shifted (0 y-move) - (clo::trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) + ;;(ukt::trc nil "wand-render pixels move" 0 y-move :top top :bottom bottom) #+hush (if (ogl-get-boolean gl_current_raster_position_valid) (progn Index: cell-cultures/cl-magick/wand-texture.lisp diff -u cell-cultures/cl-magick/wand-texture.lisp:1.4 cell-cultures/cl-magick/wand-texture.lisp:1.5 --- cell-cultures/cl-magick/wand-texture.lisp:1.4 Fri Oct 15 05:37:40 2004 +++ cell-cultures/cl-magick/wand-texture.lisp Thu Oct 28 02:09:21 2004 @@ -26,7 +26,7 @@ (progn (defclass wand-texture (wand-image ogl-texture)()) - + (defmethod wand-release :after ((wand wand-texture)) (when (slot-value wand 'texture-name) (ogl-texture-delete (slot-value wand 'texture-name))))

1 0

[cells-cvs] CVS update: cell-cultures/cl-ftgl/cl-ftgl.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cl-ftgl In directory common-lisp.net:/tmp/cvs-serv27567/cl-ftgl Modified Files: cl-ftgl.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:20 2004 Author: ktilton Index: cell-cultures/cl-ftgl/cl-ftgl.lisp diff -u cell-cultures/cl-ftgl/cl-ftgl.lisp:1.4 cell-cultures/cl-ftgl/cl-ftgl.lisp:1.5 --- cell-cultures/cl-ftgl/cl-ftgl.lisp:1.4 Fri Oct 1 06:01:12 2004 +++ cell-cultures/cl-ftgl/cl-ftgl.lisp Thu Oct 28 02:09:16 2004 @@ -20,7 +20,7 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.4 2004/10/01 04:01:12 ktilton Exp $ +;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.5 2004/10/28 00:09:16 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -41,6 +41,7 @@ #:xftgl #:ftgl-render #:ftgl-font-ensure + #:ftgl-ensure-ifont #:cl-ftgl-set-home-dir #:cl-ftgl-get-home-dir #:cl-ftgl-set-dll-filename @@ -62,8 +63,8 @@ (defparameter *gui-style-button-face* :unconfigured) (eval-when (compile load eval) - (load (merge-pathnames "cl-ftgl-config.lisp" - cl-user::*cello-config-directory*))) + (load (merge-pathnames "cl-ftgl-config" + cl-user::*cell-cultures-config*))) ;; ---------------------------------------------------------------------------- ;; EXTERNAL DEPENDENCIES @@ -427,36 +428,14 @@ (defun ftgl-get-ascender (font) (or (ftgl-ascender font) (setf (ftgl-ascender font) - (fgc-ascender (ftgl-get-metrics-font font))))) + (fgc-ascender (ftgl-ensure-ifont font))))) (defun ftgl-get-descender (font) (or (ftgl-descender font) (setf (ftgl-descender font) - (fgc-descender (ftgl-get-metrics-font font))))) + (fgc-descender (ftgl-ensure-ifont font))))) -(defun ftgl-get-display-font (font) - (let ((cf (ftgl-get-metrics-font font))) - (assert cf) - (ukt::trc nil "FTGL-GET-DISPLAY-FONT sees" (ftgl-disp-ready-p font)) - (unless (ftgl-disp-ready-p font) - (when *ogl-listing-p* - (cells::c-break "bad time #1 for sizing? ~a ~a" *ogl-listing-p* font)) - (setf (ftgl-disp-ready-p font) t) - (typecase font - (ftgl-extruded - #+nyet (let ((*ogl-listing-p* t)) - (ukt::trc nil "ftgl-get-display-font> building glyphs for" font) - - (fgc-build-glyphs cf) - (ukt::trc nil "ftgl-get-display-font> glyphs built OK for" font))) - (ftgl-texture - #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font))) - (ftgl-pixmap - #+no (fgc-set-face-size cf (ftgl-size font) (ftgl-target-res font)))) - ) - cf)) - -(defun ftgl-get-metrics-font (font) +(defun ftgl-ensure-ifont (font) (or (ftgl-ifont font) (setf (ftgl-ifont font) (ftgl-font-make font)))) @@ -477,9 +456,8 @@ (error "Font not found: ~a" path)))) (defun ftgl-render (font s) - (let ((df (ftgl-get-display-font font))) - (uffi:with-cstring (cs s) - (fgc-render df cs)))) + (uffi:with-cstring (cs s) + (fgc-render (ftgl-ensure-ifont font) cs))) (defmethod fgc-font-make :before (font fpath) (declare (ignore font fpath)) @@ -506,11 +484,11 @@ (fgc-polygon-make fpath)) (defun ftgl-string-length (font cs) - (fgc-string-advance (ftgl-get-metrics-font font) cs)) + (fgc-string-advance (ftgl-ensure-ifont font) cs)) (defmethod font-bearing-x ((font ftgl) &optional (text "m")) (uffi:with-cstring (cs text) - (fgc-string-x (ftgl-get-metrics-font font) cs))) + (fgc-string-x (ftgl-ensure-ifont font) cs))) (defmethod font-bearing-x (font &optional text) (declare (ignorable font text))

1 0

[cells-cvs] CVS update: cell-cultures/cells/cells.asd cell-cultures/cells/cells.lisp cell-cultures/cells/defpackage.lisp cell-cultures/cells/fm-utilities.lisp cell-cultures/cells/link.lisp cell-cultures/cells/md-utilities.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv27567/cells Modified Files: cells.asd cells.lisp defpackage.lisp fm-utilities.lisp link.lisp md-utilities.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:13 2004 Author: ktilton Index: cell-cultures/cells/cells.asd diff -u cell-cultures/cells/cells.asd:1.2 cell-cultures/cells/cells.asd:1.3 --- cell-cultures/cells/cells.asd:1.2 Tue Jun 29 10:58:49 2004 +++ cell-cultures/cells/cells.asd Thu Oct 28 02:09:13 2004 @@ -3,20 +3,39 @@ ;(declaim (optimize (debug 2) (speed 1) (safety 1) (compilation-speed 1))) (declaim (optimize (debug 3) (speed 3) (safety 1) (compilation-speed 0))) -(operate 'load-op :asdf-aclproj) -(use-package :asdf-aclproj) - #+(or allegro lispworks cmu mcl clisp cormanlisp sbcl scl) -(defsystem :cells - :name "cells" +(asdf:defsystem :cells + :name "cells" :author "Kenny Tilton <ktilton(a)nyc.rr.com>" - :version "05-Nov-2003" + :version "18-Oct-2004" :maintainer "Kenny Tilton <ktilton(a)nyc.rr.com>" :licence "MIT Style" :description "Cells" :long-description "The Cells dataflow extension to CLOS." - :components ((lpr-project-file "cells"))) + :depends-on (:utils-kt) + :components (;;(lpr-project-file "cells") + (:file "defpackage") + (:file "cells" :depends-on ("defpackage")) + (:file "cell-types" :depends-on ("defpackage")) + (:file "integrity" :depends-on ("defpackage")) + (:file "constructors" :depends-on ("integrity" "cells")) + (:file "initialize" :depends-on ("cells")) + (:file "md-slot-value" :depends-on ("integrity" "cell-types")) + (:file "slot-utilities" :depends-on ("cells")) + (:file "optimization" :depends-on ("cells")) + (:file "link" :depends-on ("cells")) + (:file "propagate" :depends-on ("cells" "integrity")) + (:file "synapse" :depends-on ("cells")) + (:file "synapse-types" :depends-on ("cells")) + (:file "model-object" :depends-on ("defpackage")) + (:file "defmodel" :depends-on ("model-object" "propagate" "constructors")) + (:file "md-utilities" :depends-on ("cells")) + (:file "family" :depends-on ("defmodel")) + (:file "fm-utilities" :depends-on ("cells")) + (:file "family-values" :depends-on ("propagate" "defmodel" )) + (:file "test" :depends-on ("family")) + )) (defmethod perform ((o load-op) (c (eql (find-system :cells)))) ; (pushnew "CELLS" *modules* :test #'string=) Index: cell-cultures/cells/cells.lisp diff -u cell-cultures/cells/cells.lisp:1.4 cell-cultures/cells/cells.lisp:1.5 --- cell-cultures/cells/cells.lisp:1.4 Wed Jul 7 03:25:40 2004 +++ cell-cultures/cells/cells.lisp Thu Oct 28 02:09:13 2004 @@ -148,24 +148,6 @@ (format stream "~& >: often you mis-edit (c? (c? ...)) nesting is error")))) -;----------------------------- link debugging ----------------------- - - -(defun dump-users (c &optional (depth 0)) - (format t "~&~v,4t~s" depth c) - (dolist (user (c-users c)) - (dump-users user (+ 1 depth)))) - -(defun dump-useds (c &optional (depth 0)) - ;(c.trc "dump-useds> entry " c (+ 1 depth)) - (when (zerop depth) - (format t "x~&")) - (format t "~&|usd> ~v,8t~s" depth c) - (when (typep c 'c-ruled) - ;(c.trc "its ruled" c) - (dolist (used (cd-useds c)) - (dump-useds used (+ 1 depth))))) - (defun c-break (&rest args) (unless *stop* (c-stop args) Index: cell-cultures/cells/defpackage.lisp diff -u cell-cultures/cells/defpackage.lisp:1.5 cell-cultures/cells/defpackage.lisp:1.6 --- cell-cultures/cells/defpackage.lisp:1.5 Wed Jul 21 13:49:37 2004 +++ cell-cultures/cells/defpackage.lisp Thu Oct 28 02:09:13 2004 @@ -58,3 +58,4 @@ ) #+allegro (:shadowing-import-from #:excl #:fasl-write #:fasl-read #:gc) ) + Index: cell-cultures/cells/fm-utilities.lisp diff -u cell-cultures/cells/fm-utilities.lisp:1.2 cell-cultures/cells/fm-utilities.lisp:1.3 --- cell-cultures/cells/fm-utilities.lisp:1.2 Fri Oct 15 05:37:38 2004 +++ cell-cultures/cells/fm-utilities.lisp Thu Oct 28 02:09:13 2004 @@ -50,7 +50,6 @@ (defmethod container (self) (fm-parent self)) (defmethod container-typed ((self model-object) type) - (c-assert self) (let ((parent (container self))) ;; fm- or ps-parent (cond ((null parent) nil) Index: cell-cultures/cells/link.lisp diff -u cell-cultures/cells/link.lisp:1.1 cell-cultures/cells/link.lisp:1.2 --- cell-cultures/cells/link.lisp:1.1 Sat Jun 26 20:38:36 2004 +++ cell-cultures/cells/link.lisp Thu Oct 28 02:09:13 2004 @@ -133,3 +133,21 @@ (defun c-unlink-used (user used) (setf (cd-useds user) (delete used (cd-useds user)))) + +;----------------- link debugging --------------------- + +(defun dump-users (c &optional (depth 0)) + (format t "~&~v,4t~s" depth c) + (dolist (user (c-users c)) + (dump-users user (+ 1 depth)))) + +(defun dump-useds (c &optional (depth 0)) + ;(c.trc "dump-useds> entry " c (+ 1 depth)) + (when (zerop depth) + (format t "x~&")) + (format t "~&|usd> ~v,8t~s" depth c) + (when (typep c 'c-ruled) + ;(c.trc "its ruled" c) + (dolist (used (cd-useds c)) + (dump-useds used (+ 1 depth))))) + Index: cell-cultures/cells/md-utilities.lisp diff -u cell-cultures/cells/md-utilities.lisp:1.2 cell-cultures/cells/md-utilities.lisp:1.3 --- cell-cultures/cells/md-utilities.lisp:1.2 Wed Jul 7 03:25:40 2004 +++ cell-cultures/cells/md-utilities.lisp Thu Oct 28 02:09:13 2004 @@ -63,7 +63,7 @@ (trc nil "not-to-be cleared 2 fm-parent, eternal-rest" self)) (defmethod not-to-be ((self model-object)) - (trc self "not to be!!!" self) + (trc nil "not to be!!!" self) (if (md-untouchable self) (trc "not-to-be not quiescing untouchable" self) (md-quiesce self)))

1 0

[cells-cvs] CVS update: cell-cultures/cells/cells-test/cells-test.asd cell-cultures/cells/cells-test/test.lisp
by Kenny Tilton 28 Oct '04

28 Oct '04

Update of /project/cells/cvsroot/cell-cultures/cells/cells-test In directory common-lisp.net:/tmp/cvs-serv27567/cells/cells-test Modified Files: cells-test.asd test.lisp Log Message: Re-port to Lispworks/win32 Date: Thu Oct 28 02:09:11 2004 Author: ktilton Index: cell-cultures/cells/cells-test/cells-test.asd diff -u cell-cultures/cells/cells-test/cells-test.asd:1.3 cell-cultures/cells/cells-test/cells-test.asd:1.4 --- cell-cultures/cells/cells-test/cells-test.asd:1.3 Sun Jul 4 20:59:42 2004 +++ cell-cultures/cells/cells-test/cells-test.asd Thu Oct 28 02:09:10 2004 @@ -1,8 +1,5 @@ ;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp; Base: 10 -*- -(operate 'load-op :asdf-aclproj) -(use-package :asdf-aclproj) - #+(or allegro lispworks cmu mcl clisp cormanlispx sbcl scl) (asdf:defsystem :cells-test @@ -14,7 +11,19 @@ :description "Cells Regression Test/Documentation" :long-description "Informatively-commented regression tests for Cells" :serial t - :components ((lpr-project-file "cells-test"))) + :depends-on (:utils-kt :cells) + :components ((:file "test") + (:file "hello-world") + (:file "internal-combustion") + (:file "boiler-examples") + (:file "person") + (:file "df-interference") + (:file "test-family") + (:file "test-kid-slotting") + (:file "lazy-propagation") + (:file "output-setf") + (:file "test-lazy") + (:file "synapse-testing"))) (defmethod perform :after ((op load-op) (system (eql (find-system :cells-test)))) (cells::cv-test)) Index: cell-cultures/cells/cells-test/test.lisp diff -u cell-cultures/cells/cells-test/test.lisp:1.2 cell-cultures/cells/cells-test/test.lisp:1.3 --- cell-cultures/cells/cells-test/test.lisp:1.2 Thu Jul 1 05:48:54 2004 +++ cell-cultures/cells/cells-test/test.lisp Thu Oct 28 02:09:11 2004 @@ -95,7 +95,7 @@ (defun dft () (let ();(*c-debug* t)) (cell-reset) - (df-test t) + (df-test) )) (defun output-clear (slot-name)

1 0

[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
by Kenny Tilton 28 Oct '04

28 Oct '04

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"

1 0