From ktilton at common-lisp.net Wed Dec 1 08:42:27 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Wed, 1 Dec 2004 09:42:27 +0100 (CET) Subject: [cells-cvs] CVS update: cello/glbind/ffx/arrays.lisp cello/glbind/ffx/build.lisp cello/glbind/ffx/callbacks.lisp cello/glbind/ffx/definers.lisp cello/glbind/ffx/ffx.asd Message-ID: <20041201084227.97A24884FB@common-lisp.net> Update of /project/cells/cvsroot/cello/glbind/ffx In directory common-lisp.net:/tmp/cvs-serv18151/glbind/ffx Removed Files: arrays.lisp build.lisp callbacks.lisp definers.lisp ffx.asd Log Message: Cleaning up Date: Wed Dec 1 09:42:24 2004 Author: ktilton From ktilton at common-lisp.net Wed Dec 1 08:43:13 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Wed, 1 Dec 2004 09:43:13 +0100 (CET) Subject: [cells-cvs] CVS update: cells/asdf.lisp cells/build-sys.lisp cells/build.lisp cells/calc-n-set.lisp cells/cell-types.lisp cells/cells.asd cells/cells.lisp cells/dataflow-management.lisp cells/debug.lisp cells/defmodel.lisp cells/detritus.lisp cells/family-values.lisp cells/family.lisp cells/flow-control.lisp cells/fm-utilities.lisp cells/initialize.lisp cells/link.lisp cells/md-slot-value.lisp cells/md-utilities.lisp cells/model-object.lisp cells/optimization.lisp cells/propagate.lisp cells/qells.lisp cells/qrock.lisp cells/slot-utilities.lisp cells/strings.lisp cells/strudel-object.lisp cells/synapse.lisp Message-ID: <20041201084313.31268884FC@common-lisp.net> Update of /project/cells/cvsroot/cells In directory common-lisp.net:/tmp/cvs-serv18186 Removed Files: asdf.lisp build-sys.lisp build.lisp calc-n-set.lisp cell-types.lisp cells.asd cells.lisp dataflow-management.lisp debug.lisp defmodel.lisp detritus.lisp family-values.lisp family.lisp flow-control.lisp fm-utilities.lisp initialize.lisp link.lisp md-slot-value.lisp md-utilities.lisp model-object.lisp optimization.lisp propagate.lisp qells.lisp qrock.lisp slot-utilities.lisp strings.lisp strudel-object.lisp synapse.lisp Log Message: Cleaning up Date: Wed Dec 1 09:42:55 2004 Author: ktilton From ktilton at common-lisp.net Wed Dec 1 08:43:23 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Wed, 1 Dec 2004 09:43:23 +0100 (CET) Subject: [cells-cvs] CVS update: cells/cells-test/boiler-examples.lisp cells/cells-test/cells-test.asd cells/cells-test/df-interference.lisp cells/cells-test/hello-world-q.lisp cells/cells-test/hello-world.lisp cells/cells-test/internal-combustion.lisp cells/cells-test/lazy-propagation.lisp cells/cells-test/person.lisp cells/cells-test/test-cyclicity.lisp cells/cells-test/test-family.lisp cells/cells-test/test-kid-slotting.lisp cells/cells-test/test.lisp Message-ID: <20041201084323.16108884FD@common-lisp.net> Update of /project/cells/cvsroot/cells/cells-test In directory common-lisp.net:/tmp/cvs-serv18186/cells-test Removed Files: boiler-examples.lisp cells-test.asd df-interference.lisp hello-world-q.lisp hello-world.lisp internal-combustion.lisp lazy-propagation.lisp person.lisp test-cyclicity.lisp test-family.lisp test-kid-slotting.lisp test.lisp Log Message: Cleaning up Date: Wed Dec 1 09:43:13 2004 Author: ktilton From ktilton at common-lisp.net Wed Dec 1 08:43:29 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Wed, 1 Dec 2004 09:43:29 +0100 (CET) Subject: [cells-cvs] CVS update: cells/doc/01-Cell-basics.lisp cells/doc/cells-read-me.txt cells/doc/hw.lisp Message-ID: <20041201084329.7D811884FE@common-lisp.net> Update of /project/cells/cvsroot/cells/doc In directory common-lisp.net:/tmp/cvs-serv18186/doc Removed Files: 01-Cell-basics.lisp cells-read-me.txt hw.lisp Log Message: Cleaning up Date: Wed Dec 1 09:43:23 2004 Author: ktilton From ktilton at common-lisp.net Wed Dec 1 08:43:36 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Wed, 1 Dec 2004 09:43:36 +0100 (CET) Subject: [cells-cvs] CVS update: cells/doc/use-cases/uc-ring-net.html cells/doc/use-cases/uc-ring-net.lisp cells/doc/use-cases/uc-ring-net.pdf cells/doc/use-cases/uc-ring-net.rtf Message-ID: <20041201084336.B4578884FF@common-lisp.net> Update of /project/cells/cvsroot/cells/doc/use-cases In directory common-lisp.net:/tmp/cvs-serv18186/doc/use-cases Removed Files: uc-ring-net.html uc-ring-net.lisp uc-ring-net.pdf uc-ring-net.rtf Log Message: Cleaning up Date: Wed Dec 1 09:43:30 2004 Author: ktilton From ktilton at common-lisp.net Sun Dec 5 04:49:59 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:49:59 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cell-cultures-user/config/cell-cultures-config.lisp Message-ID: <20041205044959.0D5DD885EF@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cell-cultures-user/config In directory common-lisp.net:/tmp/cvs-serv7571/cell-cultures-user/config Modified Files: cell-cultures-config.lisp Log Message: Cleaning up Date: Sun Dec 5 05:49:57 2004 Author: ktilton Index: cell-cultures/cell-cultures-user/config/cell-cultures-config.lisp diff -u cell-cultures/cell-cultures-user/config/cell-cultures-config.lisp:1.2 cell-cultures/cell-cultures-user/config/cell-cultures-config.lisp:1.3 --- cell-cultures/cell-cultures-user/config/cell-cultures-config.lisp:1.2 Wed Nov 17 13:31:22 2004 +++ cell-cultures/cell-cultures-user/config/cell-cultures-config.lisp Sun Dec 5 05:49:56 2004 @@ -14,7 +14,7 @@ (make-pathname :name "asdf":type "lisp") *dev-init*)))) -#-uffi +#+makessymbolshardfind (progn (push (merge-pathnames (make-pathname :directory '(:relative "uffi")) From ktilton at common-lisp.net Sun Dec 5 04:50:16 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:50:16 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cello/cello.lisp cell-cultures/cello/image.lisp Message-ID: <20041205045016.02864885F3@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cello In directory common-lisp.net:/tmp/cvs-serv7571/cello Modified Files: cello.lisp image.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:00 2004 Author: ktilton Index: cell-cultures/cello/cello.lisp diff -u cell-cultures/cello/cello.lisp:1.3 cell-cultures/cello/cello.lisp:1.4 --- cell-cultures/cello/cello.lisp:1.3 Thu Oct 28 02:08:56 2004 +++ cell-cultures/cello/cello.lisp Sun Dec 5 05:49:59 2004 @@ -33,3 +33,4 @@ #:cl-ftgl #:cl-magick)) +(in-package :cello) Index: cell-cultures/cello/image.lisp diff -u cell-cultures/cello/image.lisp:1.7 cell-cultures/cello/image.lisp:1.8 --- cell-cultures/cello/image.lisp:1.7 Wed Nov 17 13:31:24 2004 +++ cell-cultures/cello/image.lisp Sun Dec 5 05:49:59 2004 @@ -60,24 +60,24 @@ (defmodel ogl-node () ((dsp-list :initarg :dsp-list :accessor dsp-list :initform (c-formula (:lazy :until-asked) - (assert *w*) - (assert (not *ogl-listing-p*)) - (time (progn (ogl-dsp-list-prep self) - (when (every 'dsp-list (kids self)) - (let ((display-list-name (or .cache (gl-gen-lists 1))) - (*ogl-shared-resource-tender* - (ogl-shared-resource-tender self))) - - (gl-new-list display-list-name gl_compile) - (trc nil "starting display list" display-list-name self) - (let ((*ogl-listing-p* self) - *selecting* *render-clip-l* *render-clip-r* *render-clip-t* *render-clip-b*) - (with-metrics (nil nil "(funcall renderer)" self) - (ix-paint self))) - (trc nil "finished display list" display-list-name self) - (gl-end-list) - (setf (redisplayp (ogl-node-window self)) t) - display-list-name)))))) + (assert *w*) + (assert (not *ogl-listing-p*)) + (progn + (ogl-dsp-list-prep self) + (when (every 'dsp-list (kids self)) + (let ((display-list-name (or .cache (gl-gen-lists 1))) + (*ogl-shared-resource-tender* + (ogl-shared-resource-tender self))) + (gl-new-list display-list-name gl_compile) + (trc nil "starting display list" display-list-name self) + (let ((*ogl-listing-p* self) + *selecting* *render-clip-l* *render-clip-r* *render-clip-t* *render-clip-b*) + (with-metrics (nil nil "(funcall renderer)" self) + (ix-paint self))) + (trc nil "finished display list" display-list-name self) + (gl-end-list) + (setf (redisplayp (ogl-node-window self)) t) + display-list-name))))) (gl-name :initarg :gl-name :initform nil :accessor gl-name) (renderer :initarg :renderer :initform nil :accessor renderer))) From ktilton at common-lisp.net Sun Dec 5 04:50:25 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:50:25 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells-gtk-root/cells-gtk/display.lisp Message-ID: <20041205045025.673E1885F3@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv7571/cells-gtk-root/cells-gtk Modified Files: display.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:23 2004 Author: ktilton Index: cell-cultures/cells-gtk-root/cells-gtk/display.lisp diff -u cell-cultures/cells-gtk-root/cells-gtk/display.lisp:1.1 cell-cultures/cells-gtk-root/cells-gtk/display.lisp:1.2 --- cell-cultures/cells-gtk-root/cells-gtk/display.lisp:1.1 Thu Nov 18 12:52:55 2004 +++ cell-cultures/cells-gtk-root/cells-gtk/display.lisp Sun Dec 5 05:50:16 2004 @@ -117,7 +117,7 @@ (let ((id (gethash context (contexts self)))) (when id (with-gtk-string (str message) - (gtk-statusbar-push (id self) id str))))) + (gtk-statusbar-push (id self) id str))))) (defmethod pop-message ((self statusbar) &optional (context 'main)) (let ((id (gethash context (contexts self)))) From ktilton at common-lisp.net Sun Dec 5 04:50:42 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:50:42 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells/cell-types.lisp cell-cultures/cells/cells.asd cell-cultures/cells/md-slot-value.lisp cell-cultures/cells/md-utilities.lisp cell-cultures/cells/optimization.lisp cell-cultures/cells/propagate.lisp Message-ID: <20041205045042.2AB18885EF@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv7571/cells Modified Files: cell-types.lisp cells.asd md-slot-value.lisp md-utilities.lisp optimization.lisp propagate.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:33 2004 Author: ktilton Index: cell-cultures/cells/cell-types.lisp diff -u cell-cultures/cells/cell-types.lisp:1.2 cell-cultures/cells/cell-types.lisp:1.3 --- cell-cultures/cells/cell-types.lisp:1.2 Sun Jul 4 20:59:41 2004 +++ cell-cultures/cells/cell-types.lisp Sun Dec 5 05:50:32 2004 @@ -79,14 +79,51 @@ :initial-element 0) :type vector)) (defstruct (c-stream - (:include c-ruled) + (:include c-dependent) (:conc-name cs-)) values) -;;; (defmacro cell~ (&body body) -;;; `(make-c-stream -;;; :rule (lambda ,@*c-lambda* -;;; , at body))) +(defstruct streamer from stepper donep to) + +#+notyet +(defmacro c~~~ (&key (from 0) + stepper + (donep (c-lambda (> .cache (streamer-to slot-c)))) + to) + `(make-c-stream + :rule (c-lambda (make-streamer + :from ,from + :stepper ,stepper + :to ,to :donep ,donep)))) + +(defmethod md-slot-value-assume :around ((c c-stream) (s streamer)) + (bif (to (streamer-to s)) + (loop for slot-value = (streamer-from s) + then (bIf (stepper (streamer-stepper s)) + (funcall stepper c) + (incf slot-value)) + until (bIf (to (streamer-to s)) + (> slot-value to) + (bwhen (donep-test (streamer-donep s)) + (funcall donep-test c))) + do (progn + (print `(assume doing ,slot-value)) + (call-next-method c slot-value)))) + (c-optimize-away?! c)) + +#+test +(progn + (defmodel streamertest () + ((val :accessor val :initform (c~~~ :from 0 :to (^oval))) + (oval :initarg :oval :accessor oval :initform (c-in 0)))) + + (def-c-output val ((self streamertest)) + (print `(streamertest old ,old-value new ,new-value))) + + (cell-reset) + (let ((it (make-be 'streamertest :oval 5))) + ;;(setf (oval it) 5) + it)) (defstruct (c-drifter (:include c-dependent))) Index: cell-cultures/cells/cells.asd diff -u cell-cultures/cells/cells.asd:1.3 cell-cultures/cells/cells.asd:1.4 --- cell-cultures/cells/cells.asd:1.3 Thu Oct 28 02:09:13 2004 +++ cell-cultures/cells/cells.asd Sun Dec 5 05:50:32 2004 @@ -18,9 +18,9 @@ (:file "defpackage") (:file "cells" :depends-on ("defpackage")) (:file "cell-types" :depends-on ("defpackage")) - (:file "integrity" :depends-on ("defpackage")) + (:file "integrity" :depends-on ("cell-types")) (:file "constructors" :depends-on ("integrity" "cells")) - (:file "initialize" :depends-on ("cells")) + (:file "initialize" :depends-on ("cells" "cell-types")) (:file "md-slot-value" :depends-on ("integrity" "cell-types")) (:file "slot-utilities" :depends-on ("cells")) (:file "optimization" :depends-on ("cells")) @@ -33,7 +33,7 @@ (: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 "family-values" :depends-on ("family" "propagate" "defmodel" )) (:file "test" :depends-on ("family")) )) Index: cell-cultures/cells/md-slot-value.lisp diff -u cell-cultures/cells/md-slot-value.lisp:1.4 cell-cultures/cells/md-slot-value.lisp:1.5 --- cell-cultures/cells/md-slot-value.lisp:1.4 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/md-slot-value.lisp Sun Dec 5 05:50:32 2004 @@ -140,12 +140,15 @@ (if c (when (find c *causation*) - (if (c-cyclicp c) + (case (c-cyclicp c) + (:run-on (trc "cyclicity running on" c)) + ((t) (progn - (trc nil "cyclicity handled gracefully" c) + (trc "cyclicity handled gracefully" c) (c-pulse-update c :cyclicity-1) - (return-from md-slot-value new-value)) - (c-break "(setf md-slot-value) setf looping ~a ~a" c *causation*))) + (return-from md-slot-value new-value))) + (otherwise + (c-break "(setf md-slot-value) setf looping ~a ~a" c *causation*)))) (progn (c-break "(setf md-slot-value)> cellular slot ~a of ~a cannot be setf unless initialized as inputp" slot-name self))) @@ -158,7 +161,9 @@ new-value) -(defun md-slot-value-assume (c raw-value) + + +(defmethod md-slot-value-assume (c raw-value) (assert c) (trc nil "md-slot-value-assume entry:" c raw-value) (bif (c-pos (position c *causation*)) @@ -185,7 +190,8 @@ (c-value-state c) :valid (c-state c) :awake) - (c-optimize-away?! c) ;;; put optimize test here to avoid needless linking + (unless (typep c 'c-stream) ;; c-stream needs to run out first stream at least + (c-optimize-away?! c)) ;;; put optimize test here to avoid needless linking ; --- data flow propagation ----------- Index: cell-cultures/cells/md-utilities.lisp diff -u cell-cultures/cells/md-utilities.lisp:1.3 cell-cultures/cells/md-utilities.lisp:1.4 --- cell-cultures/cells/md-utilities.lisp:1.3 Thu Oct 28 02:09:13 2004 +++ cell-cultures/cells/md-utilities.lisp Sun Dec 5 05:50:32 2004 @@ -102,4 +102,5 @@ self) (defun make-be (class &rest initargs) - (to-be (apply 'make-instance class initargs))) \ No newline at end of file + (to-be (apply 'make-instance class initargs))) + Index: cell-cultures/cells/optimization.lisp diff -u cell-cultures/cells/optimization.lisp:1.1 cell-cultures/cells/optimization.lisp:1.2 --- cell-cultures/cells/optimization.lisp:1.1 Sat Jun 26 20:38:36 2004 +++ cell-cultures/cells/optimization.lisp Sun Dec 5 05:50:32 2004 @@ -31,12 +31,13 @@ (typecase c (c-dependent (if (and *c-optimizep* + (not (c-optimized-away-p c)) ;; c-streams come this way repeatedly even if optimized away (c-validp c) (not (c-synaptic c)) ;; no slot to cache invariant result, so they have to stay around) (null (cd-useds c))) (progn - (trc nil "optimizing away" c) + (trc nil "optimizing away" c (c-state c)) (count-it :c-optimized) (setf (c-state c) :optimized-away) Index: cell-cultures/cells/propagate.lisp diff -u cell-cultures/cells/propagate.lisp:1.4 cell-cultures/cells/propagate.lisp:1.5 --- cell-cultures/cells/propagate.lisp:1.4 Wed Sep 29 04:50:13 2004 +++ cell-cultures/cells/propagate.lisp Sun Dec 5 05:50:32 2004 @@ -161,7 +161,7 @@ (format t "~&output ~d (~a ~a) old: ~a" ,temp1 ',slotname ,loc-self ,oldvarg)) (format t "~&output ~d (~a ~a) new: ~a" ,temp1 ',slotname ,loc-self ,new-varg)))) `(defmethod c-output-slot-name - #-(or clisp cormanlisp) progn + #-(or clisp cormanlisp) progn #+(or clisp cormanlisp) :around ((slotname (eql ',slotname)) ,self-arg ,new-varg ,oldvarg ,oldvargboundp) (declare (ignorable ,@(flet ((arg-name (arg-spec) @@ -170,7 +170,8 @@ (atom arg-spec)))) (list (arg-name self-arg)(arg-name new-varg) (arg-name oldvarg)(arg-name oldvargboundp))))) - , at output-body)))) + , at output-body + #+(or clisp cormanlisp) (call-next-method))))) (defmacro bump-output-count (slotname) ;; pure test func `(if (get ',slotname :outputs) From ktilton at common-lisp.net Sun Dec 5 04:50:49 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:50:49 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cl-ftgl/cl-ftgl.lisp Message-ID: <20041205045049.51C1F885EF@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cl-ftgl In directory common-lisp.net:/tmp/cvs-serv7571/cl-ftgl Modified Files: cl-ftgl.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:46 2004 Author: ktilton Index: cell-cultures/cl-ftgl/cl-ftgl.lisp diff -u cell-cultures/cl-ftgl/cl-ftgl.lisp:1.6 cell-cultures/cl-ftgl/cl-ftgl.lisp:1.7 --- cell-cultures/cl-ftgl/cl-ftgl.lisp:1.6 Wed Nov 17 13:31:36 2004 +++ cell-cultures/cl-ftgl/cl-ftgl.lisp Sun Dec 5 05:50:41 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.6 2004/11/17 12:31:36 ktilton Exp $ +;;; $Header: /project/cells/cvsroot/cell-cultures/cl-ftgl/cl-ftgl.lisp,v 1.7 2004/12/05 04:50:41 ktilton Exp $ (defpackage #:cl-ftgl (:nicknames #:ftgl) @@ -178,11 +178,17 @@ #+test (cl-ftgl-test) +(defvar *start*) +(defvar *frames*) +(defun now () (/ (get-internal-real-time) internal-time-units-per-second)) + (defun cl-ftgl-test () + (setf *start* (now) + *frames* 0) (cl-ftgl-reset) (setq *test-fonts* (mapcar (lambda (mode) - (cons mode (ftgl-make mode *gui-style-default-face* 36 96 18))) + (cons mode (ftgl-make mode *gui-style-default-face* 48 96 18))) '(:texture :pixmap :bitmap :outline :polygon :extruded))) (ogl::lesson-14 'cl-ftgl-test-disp-fc)) @@ -194,7 +200,7 @@ (defun cl-ftgl-test-disp () - + (incf *frames*) (gl-load-identity) ;; Reset The Current Modelview Matrix (gl-clear-color 0.0 0.0 0.0 0.5) (gl-clear (+ gl_color_buffer_bit gl_depth_buffer_bit)) @@ -209,7 +215,9 @@ (gl-disable gl_lighting) (gl-translatef -100 -200 0) (gl-enable gl_texture_2d) - (ftgl-render (test-font :texture) "un-rotated texture") + (ftgl-render (test-font :texture) + (format nil "texture ~d" (floor (/ *frames* + (max 1 (- (now) *start*)))))) (gl-translatef 100 200 0) (gl-translatef -100 200 0) From ktilton at common-lisp.net Sun Dec 5 04:50:55 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:50:55 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/config/cl-ftgl-config.lisp Message-ID: <20041205045055.6DA9B885EF@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/config In directory common-lisp.net:/tmp/cvs-serv7571/config Modified Files: cl-ftgl-config.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:50 2004 Author: ktilton Index: cell-cultures/config/cl-ftgl-config.lisp diff -u cell-cultures/config/cl-ftgl-config.lisp:1.2 cell-cultures/config/cl-ftgl-config.lisp:1.3 --- cell-cultures/config/cl-ftgl-config.lisp:1.2 Fri Oct 1 06:01:32 2004 +++ cell-cultures/config/cl-ftgl-config.lisp Sun Dec 5 05:50:49 2004 @@ -35,6 +35,6 @@ #+linux '(:absolute "usr" "share" "fonts" "truetype") :type "ttf")) -(setq *gui-style-default-face* 'sylfaen) +(setq *gui-style-default-face* 'symbol) ;; 'sylfaen) (setq *gui-style-button-face* 'arialn) From ktilton at common-lisp.net Sun Dec 5 04:51:00 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:51:00 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/ffi-extender/arrays.lisp cell-cultures/ffi-extender/callbacks.lisp cell-cultures/ffi-extender/definers.lisp cell-cultures/ffi-extender/ffi-extender.lpr Message-ID: <20041205045100.87DA8885EF@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/ffi-extender In directory common-lisp.net:/tmp/cvs-serv7571/ffi-extender Modified Files: arrays.lisp callbacks.lisp definers.lisp ffi-extender.lpr Log Message: Cleaning up Date: Sun Dec 5 05:50:56 2004 Author: ktilton Index: cell-cultures/ffi-extender/arrays.lisp diff -u cell-cultures/ffi-extender/arrays.lisp:1.3 cell-cultures/ffi-extender/arrays.lisp:1.4 --- cell-cultures/ffi-extender/arrays.lisp:1.3 Wed Nov 17 13:31:51 2004 +++ cell-cultures/ffi-extender/arrays.lisp Sun Dec 5 05:50:54 2004 @@ -20,18 +20,11 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -(defpackage :ffi-extender - (:nicknames :ffx) - (:export - #:ff-elt #:ff-list - #:eltf #:eltd #:elti #:fgn-pa - #:with-ff-array-elements - #:make-ff-array - #:make-floatv #:ff-floatv-ensure - #:ffx-reset #:fgn-alloc #:fgn-free #:gllog #:glfree)) -(in-package :ffx) + +(in-package :ffx) + (defparameter *gl-rsrc* nil) (defparameter *fgn-mem* nil) @@ -188,4 +181,13 @@ (setf (ff-elt v :double n) (coerce value 'double-float))) (defmacro fgn-pa (pa n) - `(uffi:deref-array ,pa '(:array (* :void)) ,n)) \ No newline at end of file + `(uffi:deref-array ,pa '(:array (* :void)) ,n)) + +(eval-when (compile load eval) + (export '( + ff-elt ff-list + eltf eltd elti fgn-pa + with-ff-array-elements + make-ff-array + make-floatv ff-floatv-ensure + ffx-reset fgn-alloc fgn-free gllog glfree))) \ No newline at end of file Index: cell-cultures/ffi-extender/callbacks.lisp diff -u cell-cultures/ffi-extender/callbacks.lisp:1.2 cell-cultures/ffi-extender/callbacks.lisp:1.3 --- cell-cultures/ffi-extender/callbacks.lisp:1.2 Wed Nov 17 13:31:51 2004 +++ cell-cultures/ffi-extender/callbacks.lisp Sun Dec 5 05:50:54 2004 @@ -21,16 +21,6 @@ ;;; IN THE SOFTWARE. -(defpackage :ffi-extender - (:nicknames :ffx) - (:export - #:ff-register-callable - #:ff-defun-callable - #:ff-def-call - #:ff-pointer-address - )) - - (in-package :ffx) (defun ff-register-callable (callback-name) @@ -43,27 +33,23 @@ (defmacro ff-defun-callable (call-convention result-type name args &body body) (declare (ignorable result-type)) -#+lispworks - `(fli:define-foreign-callable - (,(symbol-name name) :result-type ,result-type :calling-convention ,call-convention) - (, at args) - , at body) -#+allegro - `(ff:defun-foreign-callable ,name ,args - (declare (:convention ,(ecase call-convention - (:cdecl :c) - (:stdcall :stdcall)))) - , at body)) - - -#+test ;; lw-sample -(fli:define-foreign-callable - ("square" :result-type :int) - ((arg-1 :int)) (* arg-1 arg-1)) + (let ((native-args (uffi::process-function-args args))) + #+lispworks + `(fli:define-foreign-callable + (,(symbol-name name) :result-type ,result-type :calling-convention ,call-convention) + (, at native-args) + , at body) + #+allegro + `(ff:defun-foreign-callable ,name ,native-args + (declare (:convention ,(ecase call-convention + (:cdecl :c) + (:stdcall :stdcall)))) + , at body))) + #+test -(ff-defun-callable :cdecl :int square ((arg-1 :int)) - (* arg-1 arg-1)) +(ff-defun-callable :cdecl :int square ((arg-1 :int)(data (* :void))) + (list data (* arg-1 arg-1))) (defmacro ff-def-call ((module iname ename) args) #+cormanlisp @@ -87,3 +73,9 @@ :module ,module :result-type :int)) + +(eval-when (compile load eval) + (export '(ff-register-callable + ff-defun-callable + ff-def-call + ff-pointer-address))) \ No newline at end of file Index: cell-cultures/ffi-extender/definers.lisp diff -u cell-cultures/ffi-extender/definers.lisp:1.1 cell-cultures/ffi-extender/definers.lisp:1.2 --- cell-cultures/ffi-extender/definers.lisp:1.1 Sat Jun 26 20:38:42 2004 +++ cell-cultures/ffi-extender/definers.lisp Sun Dec 5 05:50:55 2004 @@ -20,22 +20,25 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.1 2004/06/26 18:38:42 ktilton Exp $ +;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.2 2004/12/05 04:50:55 ktilton Exp $ + -(defpackage :ffi-extender - (:nicknames :ffx) - (:export - - #:defun-ffx #:defun-ffx-multi - #:dffr - #:dfc - #:dft - #:dfenum - #:make-ff-pointer - #:ff-pointer-address - )) +(defpackage :ffi-extender + (:nicknames :ffx)) +(eval-when (compile load eval) + (export '( + defun-ffx defun-ffx-multi + dffr + dfc + dft + dfenum + make-ff-pointer + ff-pointer-address + ))) + + (in-package :ffx) Index: cell-cultures/ffi-extender/ffi-extender.lpr diff -u cell-cultures/ffi-extender/ffi-extender.lpr:1.1 cell-cultures/ffi-extender/ffi-extender.lpr:1.2 --- cell-cultures/ffi-extender/ffi-extender.lpr:1.1 Sat Jun 26 20:38:42 2004 +++ cell-cultures/ffi-extender/ffi-extender.lpr Sun Dec 5 05:50:55 2004 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "6.2 [Windows] (Jun 26, 2002 11:39)"; common-graphics: "1.389.2.105.2.14"; -*- +;; -*- lisp-version: "6.2 [Windows] (Sep 3, 2004 12:04)"; common-graphics: "1.389.2.105.2.14"; -*- (in-package :common-graphics-user) @@ -9,7 +9,8 @@ :modules (list (make-instance 'module :name "definers.lisp") (make-instance 'module :name "callbacks.lisp") (make-instance 'module :name "arrays.lisp")) - :projects nil + :projects (list (make-instance 'project-module :name + "c:\\000000\\uffi\\uffi")) :libraries nil :distributed-files nil :project-package-name :ffi-extender From ktilton at common-lisp.net Sun Dec 5 04:51:04 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:51:04 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/utils-kt/utils-kt.asd Message-ID: <20041205045104.5B5A2885EF@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/utils-kt In directory common-lisp.net:/tmp/cvs-serv7571/utils-kt Modified Files: utils-kt.asd Log Message: Cleaning up Date: Sun Dec 5 05:51:03 2004 Author: ktilton Index: cell-cultures/utils-kt/utils-kt.asd diff -u cell-cultures/utils-kt/utils-kt.asd:1.1 cell-cultures/utils-kt/utils-kt.asd:1.2 --- cell-cultures/utils-kt/utils-kt.asd:1.1 Fri Nov 12 23:47:24 2004 +++ cell-cultures/utils-kt/utils-kt.asd Sun Dec 5 05:51:02 2004 @@ -17,9 +17,9 @@ :description "Kenny's Utilities" :long-description "Low-level utilities used by all of Kenny's projects" :components ((:file "defpackage") - (:file "debug") - (:file "detritus") - (:file "flow-control") + (:file "debug") + (:file "detritus") + (:file "flow-control") (:file "strings"))) (defmethod perform ((o load-op) (c (eql (find-system :utils-kt)))) From ktilton at common-lisp.net Sun Dec 5 04:50:32 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Sun, 5 Dec 2004 05:50:32 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.lisp Message-ID: <20041205045032.F06FC885F3@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv7571/cells-gtk-root/gtk-ffi Modified Files: gtk-ffi.lisp Log Message: Cleaning up Date: Sun Dec 5 05:50:26 2004 Author: ktilton Index: cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.lisp diff -u cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.lisp:1.1 cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.lisp:1.2 --- cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.lisp:1.1 Thu Nov 18 12:53:26 2004 +++ cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.lisp Sun Dec 5 05:50:25 2004 @@ -145,11 +145,11 @@ (user_data3 c-pointer)) (def-gtk-lib-functions :gtk - ;; main-loop - (gtk-init ((argc (c-ptr-null int)) - (argv c-pointer))) + ;; main-loop + (gtk-init ((argc (c-ptr-null int)) + (argv c-pointer))) (gtk-init-check ((argc (c-ptr-null int)) - (argv c-pointer)) + (argv c-pointer)) boolean) (gtk-events-pending () boolean) @@ -161,302 +161,302 @@ (gtk-main-quit ()) (gtk-get-current-event-time () uint32) - + ;;container (gtk-container-add ((container c-pointer) - (widget c-pointer)) - c-pointer) + (widget c-pointer)) + c-pointer) (gtk-container-remove ((container c-pointer) - (widget c-pointer))) - + (widget c-pointer))) + ;;box (gtk-box-pack-start ((box c-pointer) - (widget c-pointer) - (expand boolean) - (fill boolean) - (padding int))) + (widget c-pointer) + (expand boolean) + (fill boolean) + (padding int))) (gtk-box-pack-start-defaults ((box c-pointer) - (widget c-pointer))) + (widget c-pointer))) (gtk-box-set-homogeneous ((box c-pointer) - (homogeneous boolean))) + (homogeneous boolean))) (gtk-box-set-spacing ((box c-pointer) - (spacing int))) + (spacing int))) (gtk-hbox-new ((homogeneous boolean) - (spacing int)) + (spacing int)) c-pointer) (gtk-vbox-new ((homogeneous boolean) - (spacing int)) + (spacing int)) c-pointer) - + ;;table (gtk-table-new ((rows uint) - (columns uint) - (homogeneous boolean)) + (columns uint) + (homogeneous boolean)) c-pointer) (gtk-table-attach ((table c-pointer) - (child c-pointer) - (l-attach uint) - (r-attach uint) - (t-attach uint) - (b-attach uint) - (x-options int) - (y-options int) - (x-padding int) - (y-padding int))) + (child c-pointer) + (l-attach uint) + (r-attach uint) + (t-attach uint) + (b-attach uint) + (x-options int) + (y-options int) + (x-padding int) + (y-padding int))) (gtk-table-attach-defaults ((table c-pointer) - (child c-pointer) - (l-attach uint) - (r-attach uint) - (t-attach uint) - (b-attach uint))) + (child c-pointer) + (l-attach uint) + (r-attach uint) + (t-attach uint) + (b-attach uint))) (gtk-table-set-homogeneous ((table c-pointer) - (homogeneous boolean))) - + (homogeneous boolean))) + ;;paned (gtk-paned-add1 ((paned c-pointer) - (child c-pointer))) + (child c-pointer))) (gtk-paned-add2 ((paned c-pointer) - (child c-pointer))) + (child c-pointer))) (gtk-hpaned-new () c-pointer) (gtk-vpaned-new () c-pointer) - + ;;expander (gtk-expander-new ((label c-string)) c-pointer) (gtk-expander-set-expanded ((expander c-pointer) - (expanded boolean))) + (expanded boolean))) (gtk-expander-set-spacing ((expander c-pointer) - (spacing c-pointer))) + (spacing c-pointer))) (gtk-expander-set-label ((expander c-pointer) - (label c-pointer))) + (label c-pointer))) (gtk-expander-set-use-underline ((expander c-pointer) - (use-underline boolean))) + (use-underline boolean))) (gtk-expander-set-use-markup ((expander c-pointer) - (use-markup boolean))) + (use-markup boolean))) (gtk-expander-set-label-widget ((expander c-pointer) - (label-widget c-pointer))) - + (label-widget c-pointer))) + ;;alignment (gtk-alignment-new ((xalign single-float) - (yalign single-float) - (xscale single-float) - (yscale single-float)) + (yalign single-float) + (xscale single-float) + (yscale single-float)) c-pointer) (gtk-alignment-set ((alignment c-pointer) - (xalign single-float) - (yalign single-float) - (xscale single-float) - (yscale single-float))) + (xalign single-float) + (yalign single-float) + (xscale single-float) + (yscale single-float))) ;;frame (gtk-frame-new ((label c-string)) c-pointer) (gtk-frame-set-label ((frame c-pointer) - (label c-pointer))) + (label c-pointer))) (gtk-frame-set-label-widget ((frame c-pointer) - (label-widget c-pointer))) + (label-widget c-pointer))) (gtk-frame-set-label-align ((frame c-pointer) - (xalign single-float) - (yalign single-float))) + (xalign single-float) + (yalign single-float))) (gtk-frame-set-shadow-type ((frame c-pointer) - (shadow-type int))) + (shadow-type int))) ;;aspect-frame (gtk-aspect-frame-new ((label c-string) - (xalign single-float) - (yalign single-float) - (ratio single-float) - (obey_child boolean)) + (xalign single-float) + (yalign single-float) + (ratio single-float) + (obey_child boolean)) c-pointer) - + ;;separetor (gtk-hseparator-new () c-pointer) (gtk-vseparator-new () c-pointer) - + ;;scrolling (gtk-scrolled-window-new ((hadjustment c-pointer) - (vadjustment c-pointer)) + (vadjustment c-pointer)) c-pointer) (gtk-scrolled-window-set-policy ((scrolled-window c-pointer) - (h-policy int) - (v-policy int))) + (h-policy int) + (v-policy int))) (gtk-scrolled-window-add-with-viewport ((scrolled-window c-pointer) - (child c-pointer))) + (child c-pointer))) (gtk-scrolled-window-set-placement ((scrolled-window c-pointer) - (placement int))) + (placement int))) (gtk-scrolled-window-set-shadow-type ((scrolled-window c-pointer) - (type int))) - + (type int))) + ;;notebook (gtk-notebook-new () c-pointer) (gtk-notebook-append-page ((notebook c-pointer) - (child c-pointer) - (tab-label c-pointer)) + (child c-pointer) + (tab-label c-pointer)) int) (gtk-notebook-append-page-menu ((notebook c-pointer) - (child c-pointer) - (tab-label c-pointer) - (menu-label c-pointer)) + (child c-pointer) + (tab-label c-pointer) + (menu-label c-pointer)) int) (gtk-notebook-prepend-page ((notebook c-pointer) - (child c-pointer) - (tab-label c-pointer)) + (child c-pointer) + (tab-label c-pointer)) int) (gtk-notebook-prepend-page-menu ((notebook c-pointer) - (child c-pointer) - (tab-label c-pointer) - (menu-label c-pointer)) + (child c-pointer) + (tab-label c-pointer) + (menu-label c-pointer)) int) (gtk-notebook-insert-page ((notebook c-pointer) - (child c-pointer) - (tab-label c-pointer) - (pos int)) + (child c-pointer) + (tab-label c-pointer) + (pos int)) int) (gtk-notebook-insert-page-menu ((notebook c-pointer) - (child c-pointer) - (tab-label c-pointer) - (menu-label c-pointer) - (pos int)) + (child c-pointer) + (tab-label c-pointer) + (menu-label c-pointer) + (pos int)) int) (gtk-notebook-remove-page ((notebook c-pointer) - (page-num int))) + (page-num int))) (gtk-notebook-set-current-page ((notebook c-pointer) - (page-num int))) + (page-num int))) (gtk-notebook-set-tab-pos ((notebook c-pointer) - (pos int))) + (pos int))) (gtk-notebook-set-show-tabs ((notebook c-pointer) - (show-tabs boolean))) + (show-tabs boolean))) (gtk-notebook-set-show-border ((notebook c-pointer) - (show-border boolean))) + (show-border boolean))) (gtk-notebook-set-scrollable ((notebook c-pointer) - (scrollable boolean))) + (scrollable boolean))) (gtk-notebook-set-tab-border ((notebook c-pointer) - (border-width int))) + (border-width int))) (gtk-notebook-popup-enable ((notebook c-pointer))) (gtk-notebook-popup-disable ((notebook c-pointer))) (gtk-notebook-set-homogeneous-tabs ((notebook c-pointer) - (homogeneous-tabs boolean))) - + (homogeneous-tabs boolean))) + ;;label (gtk-label-new ((text c-pointer)) c-pointer) (gtk-label-set-text ((label c-pointer) - (text c-pointer))) + (text c-pointer))) (gtk-label-set-text-with-mnemonic ((label c-pointer) - (text c-pointer))) + (text c-pointer))) (gtk-label-set-line-wrap ((label c-pointer) - (wrap boolean))) + (wrap boolean))) (gtk-label-set-selectable ((label c-pointer) - (selectable boolean))) + (selectable boolean))) (gtk-label-set-use-markup ((label c-pointer) - (use-markup boolean))) + (use-markup boolean))) (gtk-label-set-markup ((label c-pointer) - (markup c-pointer))) + (markup c-pointer))) (gtk-label-set-markup-with-mnemonic ((label c-pointer) - (markup c-pointer))) - + (markup c-pointer))) + (gtk-accel-label-new ((str c-pointer)) c-pointer) (gtk-accel-label-set-accel-widget ((label c-pointer) - (widget c-pointer))) - + (widget c-pointer))) + ;;progress (gtk-progress-bar-new () c-pointer) (gtk-progress-bar-pulse ((pbar c-pointer))) (gtk-progress-bar-set-text ((pbar c-pointer) - (text c-string))) + (text c-string))) (gtk-progress-bar-set-fraction ((pbar c-pointer) - (fraction double-float))) + (fraction double-float))) (gtk-progress-bar-set-pulse-step ((pbar c-pointer) - (fraction double-float))) + (fraction double-float))) (gtk-progress-bar-set-orientation ((pbar c-pointer) - (orientation int))) + (orientation int))) (gtk-progress-bar-set-bar-style ((pbar c-pointer) - (style int))) + (style int))) (gtk-progress-bar-set-discrete-blocks ((pbar c-pointer) - (blocks uint))) + (blocks uint))) (gtk-progress-bar-set-activity-step ((pbar c-pointer) - (step uint))) + (step uint))) (gtk-progress-bar-set-activity-blocks ((pbar c-pointer) - (blocks uint))) + (blocks uint))) (gtk-progress-bar-update ((pbar c-pointer) - (percentage double-float))) - + (percentage double-float))) + ;;image (gtk-image-new-from-file ((filename c-string)) c-pointer) (gtk-image-new-from-stock ((stock c-string) - (icon-size int)) + (icon-size int)) c-pointer) (gtk-image-set-from-stock ((image c-pointer) - (stock c-string) - (icon-size int))) + (stock c-string) + (icon-size int))) (gtk-image-get-pixbuf ((image c-pointer)) c-pointer) - + ;;statusbar (gtk-statusbar-new () c-pointer) (gtk-statusbar-get-context-id ((sbar c-pointer) - (description c-string)) - uint) + (description c-string)) + uint) (gtk-statusbar-push ((sbar c-pointer) - (context-id uint) - (text c-pointer)) + (context-id uint) + (text c-string)) uint) (gtk-statusbar-pop ((sbar c-pointer) - (context-id uint))) + (context-id uint))) (gtk-statusbar-remove ((sbar c-pointer) - (context-id uint) - (message-id uint))) + (context-id uint) + (message-id uint))) (gtk-statusbar-set-has-resize-grip ((sbar c-pointer) - (setting boolean))) - + (setting boolean))) + ;;widget (gtk-widget-show ((widget c-pointer))) (gtk-widget-show-all ((widget c-pointer))) (gtk-widget-hide ((widget c-pointer))) (gtk-widget-destroy ((widget c-pointer))) (gtk-widget-set-sensitive ((widget c-pointer) - (sensitive boolean))) + (sensitive boolean))) (gtk-widget-set-size-request ((widget c-pointer) - (width int) - (height int))) + (width int) + (height int))) (gtk-widget-get-parent-window ((widget c-pointer)) c-pointer) (gtk-widget-add-accelerator ((widget c-pointer) - (gsignal c-string) - (accel-group c-pointer) - (key uint) - (mods int) - (flags int))) + (gsignal c-string) + (accel-group c-pointer) + (key uint) + (mods int) + (flags int))) (gtk-widget-grab-focus ((widget c-pointer))) - + ;;window (gtk-window-new ((type int)) - c-pointer) + c-pointer) (gtk-window-set-title ((widget c-pointer) - (title c-pointer))) + (title c-pointer))) (gtk-window-set-icon-from-file ((window c-pointer) - (filename c-string) - (err c-pointer)) + (filename c-string) + (err c-pointer)) boolean) (gtk-window-set-default-size ((widget c-pointer) - (width int) - (height int))) + (width int) + (height int))) (gtk-window-set-resizable ((widget c-pointer) - (resizable boolean))) + (resizable boolean))) (gtk-window-set-decorated ((widget c-pointer) - (decorated boolean))) + (decorated boolean))) (gtk-window-set-auto-startup-notification ((setting boolean))) (gtk-window-set-position ((widget c-pointer) - (position int))) + (position int))) (gtk-window-maximize ((widget c-pointer))) (gtk-window-unmaximize ((widget c-pointer))) (gtk-window-iconify ((widget c-pointer))) @@ -464,236 +464,236 @@ (gtk-window-fullscreen ((widget c-pointer))) (gtk-window-unfullscreen ((widget c-pointer))) (gtk-window-add-accel-group ((window c-pointer) - (accel-group c-pointer))) - + (accel-group c-pointer))) + ;;button (gtk-button-new () - c-pointer) + c-pointer) (gtk-button-set-label ((button c-pointer) - (label c-pointer))) + (label c-pointer))) (gtk-button-set-relief ((button c-pointer) - (style int))) + (style int))) (gtk-button-set-use-stock ((button c-pointer) - (use-stock boolean))) + (use-stock boolean))) ;;toggle-button (gtk-toggle-button-new () - c-pointer) + c-pointer) (gtk-toggle-button-set-mode ((button c-pointer) - (draw-indicator boolean))) + (draw-indicator boolean))) (gtk-toggle-button-set-active ((button c-pointer) - (active boolean))) + (active boolean))) (gtk-toggle-button-get-active ((button c-pointer)) - boolean) + boolean) ;;check-button (gtk-check-button-new () - c-pointer) + c-pointer) ;;radio-button (gtk-radio-button-new ((gslist c-pointer)) - c-pointer) + c-pointer) (gtk-radio-button-new-from-widget ((radio-group c-pointer)) - c-pointer) + c-pointer) ;;entry (gtk-entry-new () - c-pointer) + c-pointer) (gtk-entry-set-text ((entry c-pointer) - (text c-pointer))) + (text c-pointer))) (gtk-entry-get-text ((entry c-pointer)) - c-pointer) + c-pointer) (gtk-entry-set-max-length ((entry c-pointer) - (max-length int))) + (max-length int))) (gtk-entry-set-editable ((entry c-pointer) - (editable boolean))) + (editable boolean))) (gtk-entry-set-completion ((entry c-pointer) - (completion c-pointer))) + (completion c-pointer))) (gtk-entry-set-has-frame ((entry c-pointer) - (has-frame boolean))) - + (has-frame boolean))) + ;;entry-completion (gtk-entry-completion-new () c-pointer) (gtk-entry-completion-set-model ((completion c-pointer) - (model c-pointer))) + (model c-pointer))) (gtk-entry-completion-set-text-column ((completion c-pointer) - (column int))) - + (column int))) + ;;range (gtk-range-set-range ((range c-pointer) - (minval double-float) - (maxval double-float))) + (minval double-float) + (maxval double-float))) (gtk-range-set-value ((range c-pointer) - (val double-float))) + (val double-float))) (gtk-range-set-inverted ((range c-pointer) - (inverted boolean))) + (inverted boolean))) (gtk-range-set-increments ((range c-pointer) - (step double-float) - (page double-float))) + (step double-float) + (page double-float))) (gtk-range-set-update-policy ((range c-pointer) - (policy int))) + (policy int))) (gtk-range-get-value ((range c-pointer)) - double-float) - - ;;scale + double-float) + + ;;scale (gtk-scale-set-draw-value ((scale c-pointer) - (draw-value boolean))) + (draw-value boolean))) (gtk-scale-set-value-pos ((scale c-pointer) - (pos-type int))) + (pos-type int))) (gtk-scale-set-digits ((scale c-pointer) - (digits int))) - - ;;hscale + (digits int))) + + ;;hscale (gtk-hscale-new ((adjustment c-pointer)) c-pointer) (gtk-hscale-new-with-range ((minval double-float) - (maxval double-float) - (step double-float)) + (maxval double-float) + (step double-float)) c-pointer) - + ;;vscale (gtk-vscale-new ((adjustment c-pointer)) c-pointer) (gtk-vscale-new-with-range ((minval double-float) - (maxval double-float) - (step double-float)) + (maxval double-float) + (step double-float)) c-pointer) - + ;;spin-button (gtk-spin-button-new ((adjustment c-pointer) - (climb-rate double-float) - (digits uint)) + (climb-rate double-float) + (digits uint)) c-pointer) (gtk-spin-button-new-with-range ((minval double-float) - (maxval double-float) - (step double-float)) + (maxval double-float) + (step double-float)) c-pointer) (gtk-spin-button-set-value ((spin-button c-pointer) - (value double-float))) + (value double-float))) (gtk-spin-button-get-value ((spin-button c-pointer)) - double-float) + double-float) (gtk-spin-button-get-value-as-int ((spin-button c-pointer)) - int) + int) (gtk-spin-button-set-wrap ((spin-button c-pointer) - (wrap boolean))) - + (wrap boolean))) + ;;list-store (gtk-list-store-newv ((n-columns int) - (col-types (c-array-ptr int))) + (col-types (c-array-ptr int))) c-pointer) (gtk-list-store-set-valist ((store c-pointer) - (iter c-pointer) - (data c-pointer))) + (iter c-pointer) + (data c-pointer))) (gtk-list-store-set-value ((store c-pointer) - (iter c-pointer) - (column int) - (value c-pointer))) + (iter c-pointer) + (column int) + (value c-pointer))) (gtk-list-store-append ((list-store c-pointer) - (iter c-pointer))) + (iter c-pointer))) (gtk-list-store-clear ((list-store c-pointer))) - + ;;tree-store (gtk-tree-store-newv ((n-columns int) - (col-types (c-array-ptr int))) + (col-types (c-array-ptr int))) c-pointer) (gtk-tree-store-set-valist ((store c-pointer) - (iter c-pointer) - (data c-pointer))) + (iter c-pointer) + (data c-pointer))) (gtk-tree-store-set-value ((store c-pointer) - (iter c-pointer) - (column int) - (value c-pointer))) + (iter c-pointer) + (column int) + (value c-pointer))) (gtk-tree-store-append ((list-store c-pointer) - (iter c-pointer) - (parent c-pointer))) + (iter c-pointer) + (parent c-pointer))) (gtk-tree-store-clear ((list-store c-pointer))) - + ;;tree-view (gtk-tree-view-new () c-pointer) (gtk-tree-view-set-model ((tree-view c-pointer) - (model c-pointer))) + (model c-pointer))) (gtk-tree-view-insert-column ((tree-view c-pointer) - (column c-pointer) - (pos int)) + (column c-pointer) + (pos int)) int) (gtk-tree-view-get-selection ((tree-view c-pointer)) - c-pointer) - + c-pointer) + ;;tree-model (gtk-tree-model-get ((tree-model c-pointer) - (iter c-pointer) - (column int) - (data c-pointer) - (eof int))) + (iter c-pointer) + (column int) + (data c-pointer) + (eof int))) (gtk-tree-model-get-iter-from-string ((tree-model c-pointer) - (iter c-pointer) - (path c-string)) + (iter c-pointer) + (path c-string)) boolean) - + ;;tree-path (gtk-tree-path-new-from-string ((path c-string)) c-pointer) (gtk-tree-path-free ((path c-pointer))) - + ;;tree-selection - (gtk-tree-selection-set-mode ((sel c-pointer) - (mode int))) - (gtk-tree-selection-get-mode ((sel c-pointer)) - int) - (gtk-tree-selection-select-path ((sel c-pointer) - (path c-pointer))) - (gtk-tree-selection-get-selected ((sel c-pointer) - (model c-pointer) - (iter c-pointer)) - boolean) - (gtk-tree-selection-selected-foreach ((sel c-pointer) - (callback-f #.(callback-function ((model c-pointer) - (path c-pointer) - (iter c-pointer) - (data c-pointer)))) - (data c-pointer))) + (gtk-tree-selection-set-mode ((sel c-pointer) + (mode int))) + (gtk-tree-selection-get-mode ((sel c-pointer)) + int) + (gtk-tree-selection-select-path ((sel c-pointer) + (path c-pointer))) + (gtk-tree-selection-get-selected ((sel c-pointer) + (model c-pointer) + (iter c-pointer)) + boolean) + (gtk-tree-selection-selected-foreach ((sel c-pointer) + (callback-f #.(callback-function ((model c-pointer) + (path c-pointer) + (iter c-pointer) + (data c-pointer)))) + (data c-pointer))) ;;tree-view-column (gtk-tree-view-column-new () c-pointer) (gtk-tree-view-column-pack-start ((tree-column c-pointer) - (renderer c-pointer) - (expand boolean))) + (renderer c-pointer) + (expand boolean))) (gtk-tree-view-column-add-attribute ((tree-column c-pointer) - (renderer c-pointer) - (attribute c-string) - (column int))) + (renderer c-pointer) + (attribute c-string) + (column int))) (gtk-tree-view-column-set-spacing ((tree-column c-pointer) - (spacing int))) + (spacing int))) (gtk-tree-view-column-set-visible ((tree-column c-pointer) - (spacing boolean))) + (spacing boolean))) (gtk-tree-view-column-set-reorderable ((tree-column c-pointer) - (resizable boolean))) + (resizable boolean))) (gtk-tree-view-column-set-sort-column-id ((tree-column c-pointer) - (col-id int))) + (col-id int))) (gtk-tree-view-column-set-sort-indicator ((tree-column c-pointer) - (resizable boolean))) + (resizable boolean))) (gtk-tree-view-column-set-resizable ((tree-column c-pointer) - (resizable boolean))) + (resizable boolean))) (gtk-tree-view-column-set-fixed-width ((tree-column c-pointer) - (fixed-width int))) + (fixed-width int))) (gtk-tree-view-column-set-min-width ((tree-column c-pointer) - (min-width int))) + (min-width int))) (gtk-tree-view-column-set-max-width ((tree-column c-pointer) - (max-width int))) + (max-width int))) (gtk-tree-view-column-set-title ((tree-column c-pointer) - (title c-pointer))) + (title c-pointer))) (gtk-tree-view-column-set-expand ((tree-column c-pointer) - (expand boolean))) + (expand boolean))) (gtk-tree-view-column-set-clickable ((tree-column c-pointer) - (clickable boolean))) + (clickable boolean))) (gtk-tree-view-column-set-cell-data-func ((tree-column c-pointer) - (cell-renderer c-pointer) - (func #.(callback-function ((tree-column c-pointer) - (cell-renderer c-pointer) - (tree-model c-pointer) - (iter c-pointer) - (data c-pointer)))) - (data c-pointer) - (destroy c-pointer))) + (cell-renderer c-pointer) + (func #.(callback-function ((tree-column c-pointer) + (cell-renderer c-pointer) + (tree-model c-pointer) + (iter c-pointer) + (data c-pointer)))) + (data c-pointer) + (destroy c-pointer))) ;;cell-renderers (gtk-cell-renderer-text-new () c-pointer) @@ -701,154 +701,154 @@ c-pointer) (gtk-cell-renderer-pixbuf-new () c-pointer) - + ;;combo-box (gtk-combo-box-new-text () c-pointer) (gtk-combo-box-append-text ((combo-box c-pointer) - (text c-pointer))) + (text c-pointer))) (gtk-combo-box-remove-text ((combo-box c-pointer) - (position int))) + (position int))) (gtk-combo-box-set-active ((combo-box c-pointer) - (index int))) + (index int))) (gtk-combo-box-get-active ((combo-box c-pointer)) int) - + ;;toolbar (gtk-toolbar-new () c-pointer) (gtk-toolbar-insert ((toolbar c-pointer) - (item c-pointer) - (pos int))) + (item c-pointer) + (pos int))) (gtk-toolbar-set-show-arrow ((toolbar c-pointer) - (show-arrow boolean))) + (show-arrow boolean))) (gtk-toolbar-set-orientation ((toolbar c-pointer) - (orientation int))) + (orientation int))) (gtk-toolbar-set-tooltips ((toolbar c-pointer) - (enable boolean))) + (enable boolean))) (gtk-toolbar-set-style ((toolbar c-pointer) - (style int))) - + (style int))) + ;;tooltips (gtk-tooltips-new () c-pointer) (gtk-tooltips-set-tip ((tooltips c-pointer) - (widget c-pointer) - (tip-text c-pointer) - (tip-private c-string))) + (widget c-pointer) + (tip-text c-pointer) + (tip-private c-string))) (gtk-tooltips-enable ((tooltips c-pointer))) (gtk-tooltips-disable ((tooltips c-pointer))) (gtk-tooltips-set-delay ((tooltips c-pointer) - (delay uint))) + (delay uint))) ;;tool-item (gtk-tool-item-new () c-pointer) (gtk-tool-item-set-homogeneous ((tool-item c-pointer) - (homogeneous boolean))) + (homogeneous boolean))) (gtk-tool-item-set-expand ((tool-item c-pointer) - (expand boolean))) + (expand boolean))) (gtk-tool-item-set-tooltip ((tool-item c-pointer) - (tooltips c-pointer) - (tip-text c-string) - (tip-private c-string))) + (tooltips c-pointer) + (tip-text c-string) + (tip-private c-string))) (gtk-tool-item-set-is-important ((tool-item c-pointer) - (is-important boolean))) - + (is-important boolean))) + (gtk-separator-tool-item-new () - c-pointer) + c-pointer) (gtk-separator-tool-item-set-draw ((item c-pointer) - (draw boolean))) - + (draw boolean))) + ;;tool-button (gtk-tool-button-new ((icon-widget c-pointer) - (label c-pointer)) + (label c-pointer)) c-pointer) (gtk-tool-button-new-from-stock ((stock-id c-string)) c-pointer) (gtk-tool-button-set-label ((tool-button c-pointer) - (label c-pointer))) + (label c-pointer))) (gtk-tool-button-set-use-underline ((tool-button c-pointer) - (use-underline boolean))) + (use-underline boolean))) (gtk-tool-button-set-stock-id ((tool-button c-pointer) - (stock-id c-string))) + (stock-id c-string))) (gtk-tool-button-set-icon-widget ((tool-button c-pointer) - (icon-widget c-pointer))) + (icon-widget c-pointer))) (gtk-tool-button-set-label-widget ((tool-button c-pointer) - (label-widget c-pointer))) + (label-widget c-pointer))) ;;menu (gtk-menu-shell-append ((menu-shell c-pointer) - (child c-pointer))) + (child c-pointer))) (gtk-menu-shell-prepend ((menu-shell c-pointer) - (child c-pointer))) + (child c-pointer))) (gtk-menu-shell-insert ((menu-shell c-pointer) - (child c-pointer) - (position int))) + (child c-pointer) + (position int))) (gtk-menu-bar-new () c-pointer) - + (gtk-menu-new () c-pointer) (gtk-menu-set-title ((menu c-pointer) - (title c-string))) + (title c-string))) (gtk-menu-attach ((menu c-pointer) - (child c-pointer) - (lattach uint) - (rattach uint) - (tattach uint) - (battach uint))) + (child c-pointer) + (lattach uint) + (rattach uint) + (tattach uint) + (battach uint))) (gtk-menu-attach-to-widget ((menu c-pointer) - (widget c-pointer) - (func #.(callback-function ((widget c-pointer) - (menu c-pointer)))))) - + (widget c-pointer) + (func #.(callback-function ((widget c-pointer) + (menu c-pointer)))))) + (gtk-menu-popup ((menu c-pointer) - (p-menu-shell c-pointer) - (p-menu-item c-pointer) - (func #.(callback-function ((menu c-pointer) - (x (c-ptr int)) - (y (c-ptr int)) - (push-in (c-ptr boolean)) - (data c-pointer)))) - (data c-pointer) - (button uint) - (activate-time uint32))) - + (p-menu-shell c-pointer) + (p-menu-item c-pointer) + (func #.(callback-function ((menu c-pointer) + (x (c-ptr int)) + (y (c-ptr int)) + (push-in (c-ptr boolean)) + (data c-pointer)))) + (data c-pointer) + (button uint) + (activate-time uint32))) + (gtk-menu-item-new () c-pointer) (gtk-menu-item-new-with-label ((label c-string)) c-pointer) (gtk-menu-item-set-right-justified ((menu-item c-pointer) - (right-justified boolean))) + (right-justified boolean))) (gtk-menu-item-set-submenu ((menu-item c-pointer) - (submenu c-pointer))) + (submenu c-pointer))) (gtk-menu-item-remove-submenu ((menu-item c-pointer))) (gtk-menu-item-set-accel-path ((menu-item c-pointer) - (acell-path c-pointer))) + (acell-path c-pointer))) (gtk-accel-map-add-entry ((accel-path c-pointer) - (accel-key uint) - (accel-mods int))) + (accel-key uint) + (accel-mods int))) (gtk-check-menu-item-new () c-pointer) (gtk-check-menu-item-new-with-label ((label c-string)) c-pointer) (gtk-check-menu-item-set-active ((check-menu c-pointer) - (active boolean))) + (active boolean))) (gtk-check-menu-item-get-active ((check-menu c-pointer)) boolean) - + (gtk-radio-menu-item-new ((group c-pointer)) c-pointer) (gtk-radio-menu-item-new-from-widget ((group c-pointer)) c-pointer) (gtk-radio-menu-item-new-with-label ((group c-pointer) - (label c-string)) + (label c-string)) c-pointer) (gtk-radio-menu-item-new-with-label-from-widget ((radio c-pointer) - (label c-string)) + (label c-string)) c-pointer) (gtk-radio-menu-item-get-group ((radio c-pointer)) c-pointer) @@ -858,89 +858,89 @@ (gtk-image-menu-item-new-with-label ((label c-string)) c-pointer) (gtk-image-menu-item-new-from-stock ((stock-id c-string) - (accel-group c-pointer)) + (accel-group c-pointer)) c-pointer) (gtk-image-menu-item-set-image ((menu-item c-pointer) - (image c-pointer))) - - + (image c-pointer))) + + (gtk-separator-menu-item-new () c-pointer) (gtk-tearoff-menu-item-new () c-pointer) - + ;;calendar (gtk-calendar-new () c-pointer) (gtk-calendar-get-date ((cal c-pointer) - (year c-pointer) - (month c-pointer) - (day c-pointer))) + (year c-pointer) + (month c-pointer) + (day c-pointer))) (gtk-calendar-select-month ((cal c-pointer) - (month uint) - (year uint)) + (month uint) + (year uint)) int) (gtk-calendar-select-day ((cal c-pointer) - (day uint))) - + (day uint))) + ;;arrow (gtk-arrow-new ((arrow-type int) - (shadow-type int)) + (shadow-type int)) c-pointer) (gtk-arrow-set ((arrow c-pointer) - (arrow-type int) - (shadow-type int))) - + (arrow-type int) + (shadow-type int))) + ;;dialog (gtk-dialog-new () c-pointer) (gtk-dialog-run ((dialog c-pointer)) int) (gtk-dialog-response ((dialog c-pointer) - (response-id int))) + (response-id int))) (gtk-dialog-add-button ((dialog c-pointer) - (button-text c-string) - (response-id int)) + (button-text c-string) + (response-id int)) c-pointer) (gtk-dialog-add-action-widget ((dialog c-pointer) - (child c-pointer) - (response-id c-pointer))) + (child c-pointer) + (response-id c-pointer))) (gtk-dialog-set-has-separator ((dialog c-pointer) - (has-separator boolean))) + (has-separator boolean))) (gtk-dialog-set-default-response ((dialog c-pointer) - (response-id int))) + (response-id int))) ;;message-dialog (gtk-message-dialog-new ((parent c-pointer) - (flags int) - (type int) - (buttons int) - (message c-string)) + (flags int) + (type int) + (buttons int) + (message c-string)) c-pointer) (gtk-message-dialog-set-markup ((dialog c-pointer) - (str c-string))) + (str c-string))) ;;file-chooser (gtk-file-chooser-set-action ((chooser c-pointer) - (action int))) + (action int))) (gtk-file-chooser-set-local-only ((chooser c-pointer) - (local-only boolean))) + (local-only boolean))) (gtk-file-chooser-set-select-multiple ((chooser c-pointer) - (select-multiple boolean))) + (select-multiple boolean))) (gtk-file-chooser-set-current-name ((chooser c-pointer) - (name c-string))) + (name c-string))) (gtk-file-chooser-set-filename ((chooser c-pointer) - (filename c-string)) + (filename c-string)) boolean) (gtk-file-chooser-get-filename ((chooser c-pointer)) c-string :malloc-free) (gtk-file-chooser-get-filenames ((chooser c-pointer)) c-pointer) (gtk-file-chooser-set-current-folder ((chooser c-pointer) - (folder c-string)) + (folder c-string)) boolean) (gtk-file-chooser-get-current-folder ((chooser c-pointer)) c-string :malloc-free) (gtk-file-chooser-set-uri ((chooser c-pointer) - (uri c-string)) + (uri c-string)) boolean) (gtk-file-chooser-get-uri ((chooser c-pointer)) c-string :malloc-free) @@ -949,102 +949,102 @@ (gtk-file-chooser-get-uris ((chooser c-pointer)) c-pointer) (gtk-file-chooser-set-current-folder-uri ((chooser c-pointer) - (folder c-string)) + (folder c-string)) boolean) (gtk-file-chooser-get-current-folder-uri ((chooser c-pointer)) c-string :malloc-free) (gtk-file-chooser-set-use-preview-label ((chooser c-pointer) - (use-label boolean))) + (use-label boolean))) (gtk-file-chooser-add-filter ((chooser c-pointer) - (filter c-pointer))) + (filter c-pointer))) (gtk-file-chooser-set-filter ((chooser c-pointer) - (filter c-pointer))) + (filter c-pointer))) ;;file-chooser-widget (gtk-file-chooser-widget-new ((action int)) c-pointer) ;;file-chooser-dialog (gtk-file-chooser-dialog-new ((title c-string) - (parent c-pointer) - (action int) - (cancel-text c-string) - (cancel-response-id int) - (accept-text c-string) - (accept-response-id int) - (null c-pointer)) + (parent c-pointer) + (action int) + (cancel-text c-string) + (cancel-response-id int) + (accept-text c-string) + (accept-response-id int) + (null c-pointer)) c-pointer) - ;;file-filter + ;;file-filter (gtk-file-filter-new () c-pointer) (gtk-file-filter-set-name ((filter c-pointer) - (name c-string))) + (name c-string))) (gtk-file-filter-add-mime-type ((filter c-pointer) - (mime-type c-string))) + (mime-type c-string))) (gtk-file-filter-add-pattern ((filter c-pointer) - (pattern c-string))) - + (pattern c-string))) + ;;text-view (gtk-text-view-new () c-pointer) (gtk-text-view-set-buffer ((text-view c-pointer) - (buffer c-pointer))) + (buffer c-pointer))) ;;text-buffer (gtk-text-buffer-new ((table c-pointer)) c-pointer) (gtk-text-buffer-set-text ((buffer c-pointer) - (text c-pointer) - (len int))) - + (text c-pointer) + (len int))) + ;;text-tag-table (gtk-text-tag-table-new () c-pointer) - + ;;accel-group (gtk-accel-group-new () c-pointer) - + ;;ui-manager (gtk-ui-manager-new () c-pointer) (gtk-ui-manager-set-add-tearoffs ((ui-manager c-pointer) - (add-tearoffs boolean))) + (add-tearoffs boolean))) (gtk-ui-manager-insert-action-group ((ui-manager c-pointer) - (action-group c-pointer) - (pos int))) + (action-group c-pointer) + (pos int))) (gtk-ui-manager-get-toplevels ((ui-manager c-pointer) - (types int)) + (types int)) c-pointer) - + ;;action-group (gtk-action-group-new ((name c-string)) c-pointer) (gtk-action-group-set-sensitive ((action-group c-pointer) - (sensitive boolean))) + (sensitive boolean))) (gtk-action-group-set-visible ((action-group c-pointer) - (visible boolean))) + (visible boolean))) (gtk-action-group-add-action ((action-group c-pointer) - (action c-pointer))) + (action c-pointer))) (gtk-action-group-remove-action ((action-group c-pointer) - (action c-pointer))) + (action c-pointer))) (gtk-action-group-add-action-with-accel ((action-group c-pointer) - (action c-pointer) - (accel c-string))) + (action c-pointer) + (accel c-string))) ;;action (gtk-action-new ((name c-string) - (label c-pointer) - (tooltip c-pointer) - (stock-id c-string)) + (label c-pointer) + (tooltip c-pointer) + (stock-id c-string)) c-pointer) - + (gtk-event-box-new () c-pointer) (gtk-event-box-set-above-child ((event-box c-pointer) - (above boolean))) + (above boolean))) (gtk-event-box-set-visible-window ((event-box c-pointer) - (visible-window boolean))) + (visible-window boolean))) -) + ) (def-c-struct gdk-event-button (type int) From ktilton at common-lisp.net Mon Dec 6 20:26:08 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Mon, 6 Dec 2004 21:26:08 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells/cells.asd cell-cultures/cells/integrity.lisp Message-ID: <20041206202608.372E1880A8@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv26849/cells Modified Files: cells.asd integrity.lisp Log Message: Add one dependency to ASDF, plus minor stuff to port cells-gtk to Lispworks Date: Mon Dec 6 21:26:07 2004 Author: ktilton Index: cell-cultures/cells/cells.asd diff -u cell-cultures/cells/cells.asd:1.4 cell-cultures/cells/cells.asd:1.5 --- cell-cultures/cells/cells.asd:1.4 Sun Dec 5 05:50:32 2004 +++ cell-cultures/cells/cells.asd Mon Dec 6 21:26:06 2004 @@ -18,7 +18,7 @@ (:file "defpackage") (:file "cells" :depends-on ("defpackage")) (:file "cell-types" :depends-on ("defpackage")) - (:file "integrity" :depends-on ("cell-types")) + (:file "integrity" :depends-on ("cell-types" "cells")) (:file "constructors" :depends-on ("integrity" "cells")) (:file "initialize" :depends-on ("cells" "cell-types")) (:file "md-slot-value" :depends-on ("integrity" "cell-types")) Index: cell-cultures/cells/integrity.lisp diff -u cell-cultures/cells/integrity.lisp:1.4 cell-cultures/cells/integrity.lisp:1.5 --- cell-cultures/cells/integrity.lisp:1.4 Fri Jul 9 05:53:04 2004 +++ cell-cultures/cells/integrity.lisp Mon Dec 6 21:26:06 2004 @@ -106,6 +106,8 @@ (defun finish-business (&aux task some-output setfs (setf-ct 0)) (declare (ignorable setfs)) + (assert (ufb-queue :user-notify)) + (assert (consp (ufb-queue :user-notify))) (tagbody notify-users ;--- notify users ------------------------------ @@ -126,7 +128,7 @@ (cond (task (setf some-output t) - (trc nil "finish-business outputting--------------------------") + (trc nil "finish-business outputting------------------------") (funcall task) (go next-output)) (some-output From ktilton at common-lisp.net Mon Dec 6 20:26:14 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Mon, 6 Dec 2004 21:26:14 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/ffi-extender/definers.lisp Message-ID: <20041206202614.7CD74880A8@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/ffi-extender In directory common-lisp.net:/tmp/cvs-serv26849/ffi-extender Modified Files: definers.lisp Log Message: Add one dependency to ASDF, plus minor stuff to port cells-gtk to Lispworks Date: Mon Dec 6 21:26:09 2004 Author: ktilton Index: cell-cultures/ffi-extender/definers.lisp diff -u cell-cultures/ffi-extender/definers.lisp:1.2 cell-cultures/ffi-extender/definers.lisp:1.3 --- cell-cultures/ffi-extender/definers.lisp:1.2 Sun Dec 5 05:50:55 2004 +++ cell-cultures/ffi-extender/definers.lisp Mon Dec 6 21:26:08 2004 @@ -20,13 +20,15 @@ ;;; FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR THE USE OR OTHER DEALINGS ;;; IN THE SOFTWARE. -;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.2 2004/12/05 04:50:55 ktilton Exp $ +;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.3 2004/12/06 20:26:08 ktilton Exp $ (defpackage :ffi-extender (:nicknames :ffx)) +(in-package :ffx) + (eval-when (compile load eval) (export '( defun-ffx defun-ffx-multi @@ -37,10 +39,6 @@ make-ff-pointer ff-pointer-address ))) - - - -(in-package :ffx) (defun ff-pointer-address (ff-ptr) #-lispworks ff-ptr From ktilton at common-lisp.net Mon Dec 6 20:28:20 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Mon, 6 Dec 2004 21:28:20 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells-gtk-root/INSTALL.TXT cell-cultures/cells-gtk-root/asdf.lisp cell-cultures/cells-gtk-root/load.lisp Message-ID: <20041206202820.B8469880A8@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root Removed Files: INSTALL.TXT asdf.lisp load.lisp Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:28:18 2004 Author: ktilton From ktilton at common-lisp.net Mon Dec 6 20:28:34 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Mon, 6 Dec 2004 21:28:34 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells-gtk-root/cells-gtk/actions.lisp cell-cultures/cells-gtk-root/cells-gtk/addon.lisp cell-cultures/cells-gtk-root/cells-gtk/buttons.lisp cell-cultures/cells-gtk-root/cells-gtk/callback.lisp cell-cultures/cells-gtk-root/cells-gtk/cells-gtk.asd cell-cultures/cells-gtk-root/cells-gtk/cells-gtk.lisp cell-cultures/cells-gtk-root/cells-gtk/dialogs.lisp cell-cultures/cells-gtk-root/cells-gtk/display.lisp cell-cultures/cells-gtk-root/cells-gtk/entry.lisp cell-cultures/cells-gtk-root/cells-gtk/gtk-app.lisp cell-cultures/cells-gtk-root/cells-gtk/layout.lisp cell-cultures/cells-gtk-root/cells-gtk/menus.lisp cell-cultures/cells-gtk-root/cells-gtk/textview.lisp cell-cultures/cells-gtk-root/cells-gtk/tree-view.lisp cell-cultures/cells-gtk-root/cells-gtk/widgets.lisp Message-ID: <20041206202834.060CC884F7@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/cells-gtk In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root/cells-gtk Removed Files: actions.lisp addon.lisp buttons.lisp callback.lisp cells-gtk.asd cells-gtk.lisp dialogs.lisp display.lisp entry.lisp gtk-app.lisp layout.lisp menus.lisp textview.lisp tree-view.lisp widgets.lisp Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:28:21 2004 Author: ktilton From ktilton at common-lisp.net Mon Dec 6 20:29:10 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Mon, 6 Dec 2004 21:29:10 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-addon.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-buttons.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-dialogs.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-display.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-entry.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-gtk.asd cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-gtk.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-layout.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-menus.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-textview.lisp cell-cultures/cells-gtk-root/cells-gtk/test-gtk/test-tree-view.lisp Message-ID: <20041206202910.0E961880A8@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/cells-gtk/test-gtk In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root/cells-gtk/test-gtk Removed Files: test-addon.lisp test-buttons.lisp test-dialogs.lisp test-display.lisp test-entry.lisp test-gtk.asd test-gtk.lisp test-layout.lisp test-menus.lisp test-textview.lisp test-tree-view.lisp Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:28:34 2004 Author: ktilton From ktilton at common-lisp.net Mon Dec 6 20:29:19 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Mon, 6 Dec 2004 21:29:19 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.asd cell-cultures/cells-gtk-root/gtk-ffi/gtk-ffi.lisp Message-ID: <20041206202919.0D089884F7@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/gtk-ffi In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root/gtk-ffi Removed Files: gtk-ffi.asd gtk-ffi.lisp Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:29:11 2004 Author: ktilton From ktilton at common-lisp.net Mon Dec 6 20:29:27 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Mon, 6 Dec 2004 21:29:27 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells-gtk-root/test-images/small.png cell-cultures/cells-gtk-root/test-images/splash.png cell-cultures/cells-gtk-root/test-images/tst.gif Message-ID: <20041206202927.79011880A8@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells-gtk-root/test-images In directory common-lisp.net:/tmp/cvs-serv26909/cells-gtk-root/test-images Removed Files: small.png splash.png tst.gif Log Message: Move cells-gtk from Cells project to Cells-gtk project on common-lisp.net Date: Mon Dec 6 21:29:20 2004 Author: ktilton From ktilton at common-lisp.net Thu Dec 9 23:01:41 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Fri, 10 Dec 2004 00:01:41 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells/cells.lisp cell-cultures/cells/propagate.lisp Message-ID: <20041209230141.979AA885F6@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv24507/cells Modified Files: cells.lisp propagate.lisp Log Message: Backing out possibly good change to c-output-slot mechanism intended to improve programmability under Corman and CLisp, which do not handle progn method combination normally used by c-output-slot-name, just to get Vasilis's original Clisp cells-gtk working. This fix can go back in if cells-gtk gets properly ported to UFFI. Date: Fri Dec 10 00:01:30 2004 Author: ktilton Index: cell-cultures/cells/cells.lisp diff -u cell-cultures/cells/cells.lisp:1.5 cell-cultures/cells/cells.lisp:1.6 --- cell-cultures/cells/cells.lisp:1.5 Thu Oct 28 02:09:13 2004 +++ cell-cultures/cells/cells.lisp Fri Dec 10 00:01:23 2004 @@ -94,18 +94,12 @@ (define-condition unbound-cell (unbound-slot) ()) -#-(or cormanlisp clisp) (defgeneric c-output-slot-name (slotname self new old old-boundp) + #-(or cormanlisp clisp) (:method-combination progn)) -#+(and (not cells-testing) (or cormanlisp clisp)) -(defmethod c-output-slot-name (slot-name self new old old-boundp) - (declare (ignorable slot-name self new old old-boundp))) - #-cells-testing -(defmethod c-output-slot-name - #-(or cormanlisp clisp) progn - #+(or cormanlisp clisp) :before +(defmethod c-output-slot-name #-(or cormanlisp clisp) progn (slot-name self new old old-boundp) (declare (ignorable slot-name self new old old-boundp))) Index: cell-cultures/cells/propagate.lisp diff -u cell-cultures/cells/propagate.lisp:1.5 cell-cultures/cells/propagate.lisp:1.6 --- cell-cultures/cells/propagate.lisp:1.5 Sun Dec 5 05:50:32 2004 +++ cell-cultures/cells/propagate.lisp Fri Dec 10 00:01:23 2004 @@ -161,7 +161,7 @@ (format t "~&output ~d (~a ~a) old: ~a" ,temp1 ',slotname ,loc-self ,oldvarg)) (format t "~&output ~d (~a ~a) new: ~a" ,temp1 ',slotname ,loc-self ,new-varg)))) `(defmethod c-output-slot-name - #-(or clisp cormanlisp) progn #+(or clisp cormanlisp) :around + #-(or clisp cormanlisp) progn ;;broke cells-gtk #+(or clisp cormanlisp) :around ((slotname (eql ',slotname)) ,self-arg ,new-varg ,oldvarg ,oldvargboundp) (declare (ignorable ,@(flet ((arg-name (arg-spec) @@ -171,7 +171,8 @@ (list (arg-name self-arg)(arg-name new-varg) (arg-name oldvarg)(arg-name oldvargboundp))))) , at output-body - #+(or clisp cormanlisp) (call-next-method))))) + ;;broke cells-gtk #+(or clisp cormanlisp) (call-next-method) + )))) (defmacro bump-output-count (slotname) ;; pure test func `(if (get ',slotname :outputs) From ktilton at common-lisp.net Tue Dec 14 03:53:05 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Tue, 14 Dec 2004 04:53:05 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cells/cells.lisp Message-ID: <20041214035305.BC0F2885E4@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cells In directory common-lisp.net:/tmp/cvs-serv10251/cells Modified Files: cells.lisp Log Message: No idea how the OpenGL stuff changed. Mostly bringing ffi-extender up to date. Date: Tue Dec 14 04:53:04 2004 Author: ktilton Index: cell-cultures/cells/cells.lisp diff -u cell-cultures/cells/cells.lisp:1.6 cell-cultures/cells/cells.lisp:1.7 --- cell-cultures/cells/cells.lisp:1.6 Fri Dec 10 00:01:23 2004 +++ cell-cultures/cells/cells.lisp Tue Dec 14 04:53:03 2004 @@ -104,7 +104,6 @@ (declare (ignorable slot-name self new old old-boundp))) - ; -------- cell conditions (not much used) --------------------------------------------- (define-condition xcell () ;; new 2k0227 From ktilton at common-lisp.net Tue Dec 14 03:53:32 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Tue, 14 Dec 2004 04:53:32 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/cl-opengl/cl-opengl.lisp cell-cultures/cl-opengl/cl-opengl.lpr cell-cultures/cl-opengl/gl-constants.lisp cell-cultures/cl-opengl/gl-def.lisp cell-cultures/cl-opengl/gl-functions.lisp cell-cultures/cl-opengl/glut-extras.lisp cell-cultures/cl-opengl/glut-functions.lisp cell-cultures/cl-opengl/nehe-14.lisp cell-cultures/cl-opengl/ogl-macros.lisp cell-cultures/cl-opengl/ogl-utils.lisp Message-ID: <20041214035332.703A7885E5@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/cl-opengl In directory common-lisp.net:/tmp/cvs-serv10251/cl-opengl Modified Files: cl-opengl.lisp cl-opengl.lpr gl-constants.lisp gl-def.lisp gl-functions.lisp glut-extras.lisp glut-functions.lisp nehe-14.lisp ogl-macros.lisp ogl-utils.lisp Log Message: No idea how the OpenGL stuff changed. Mostly bringing ffi-extender up to date. Date: Tue Dec 14 04:53:09 2004 Author: ktilton Index: cell-cultures/cl-opengl/cl-opengl.lisp diff -u cell-cultures/cl-opengl/cl-opengl.lisp:1.5 cell-cultures/cl-opengl/cl-opengl.lisp:1.6 --- cell-cultures/cl-opengl/cl-opengl.lisp:1.5 Wed Nov 17 13:31:45 2004 +++ cell-cultures/cl-opengl/cl-opengl.lisp Tue Dec 14 04:53:05 2004 @@ -26,7 +26,7 @@ (defpackage #:cl-opengl (:nicknames #:ogl) - (:use #:common-lisp #:uffi #:ffx) + (:use #:common-lisp #:ffx) (:export #:*ogl-listing-p* #:glut-get-window #:glut-set-window Index: cell-cultures/cl-opengl/cl-opengl.lpr diff -u cell-cultures/cl-opengl/cl-opengl.lpr:1.1 cell-cultures/cl-opengl/cl-opengl.lpr:1.2 --- cell-cultures/cl-opengl/cl-opengl.lpr:1.1 Sat Jun 26 20:38:40 2004 +++ cell-cultures/cl-opengl/cl-opengl.lpr Tue Dec 14 04:53:05 2004 @@ -1,4 +1,4 @@ -;; -*- lisp-version: "6.2 [Windows] (Jun 26, 2002 11:39)"; common-graphics: "1.389.2.105.2.14"; -*- +;; -*- lisp-version: "6.2 [Windows] (Sep 3, 2004 12:04)"; common-graphics: "1.389.2.105.2.14"; -*- (in-package :common-graphics-user) @@ -18,7 +18,7 @@ (make-instance 'module :name "ogl-utils.lisp") (make-instance 'module :name "nehe-14.lisp")) :projects (list (make-instance 'project-module :name - "..\\ffi-extender\\ffi-extender")) + "c:\\cell-cultures\\ffi-extender\\ffi-extender")) :libraries nil :distributed-files nil :project-package-name :cl-opengl Index: cell-cultures/cl-opengl/gl-constants.lisp diff -u cell-cultures/cl-opengl/gl-constants.lisp:1.2 cell-cultures/cl-opengl/gl-constants.lisp:1.3 --- cell-cultures/cl-opengl/gl-constants.lisp:1.2 Fri Oct 15 05:37:55 2004 +++ cell-cultures/cl-opengl/gl-constants.lisp Tue Dec 14 04:53:05 2004 @@ -22,6 +22,7 @@ (in-package #:cl-opengl) + #| blendingfactordest |# (dfc gl_zero 0) (dfc gl_one 1) Index: cell-cultures/cl-opengl/gl-def.lisp diff -u cell-cultures/cl-opengl/gl-def.lisp:1.2 cell-cultures/cl-opengl/gl-def.lisp:1.3 --- cell-cultures/cl-opengl/gl-def.lisp:1.2 Fri Oct 1 06:01:29 2004 +++ cell-cultures/cl-opengl/gl-def.lisp Tue Dec 14 04:53:05 2004 @@ -28,6 +28,7 @@ ;;(cells::count-it ,(intern (string-upcase name$) :keyword)) (glec ',(intern name$))))) + (defun aforef (o n) (uffi:deref-array o '(:array :int) n)) Index: cell-cultures/cl-opengl/gl-functions.lisp diff -u cell-cultures/cl-opengl/gl-functions.lisp:1.4 cell-cultures/cl-opengl/gl-functions.lisp:1.5 --- cell-cultures/cl-opengl/gl-functions.lisp:1.4 Thu Oct 28 02:09:33 2004 +++ cell-cultures/cl-opengl/gl-functions.lisp Tue Dec 14 04:53:05 2004 @@ -25,7 +25,6 @@ (defparameter *ogl-listing-p* nil) (defun-ogl :void "open-gl" "glFlush" ()) - (defun-ogl :void "open-gl" "glMaterialfv" (glenum face glenum pname glfloat *params)) Index: cell-cultures/cl-opengl/glut-extras.lisp diff -u cell-cultures/cl-opengl/glut-extras.lisp:1.3 cell-cultures/cl-opengl/glut-extras.lisp:1.4 --- cell-cultures/cl-opengl/glut-extras.lisp:1.3 Fri Oct 15 05:37:55 2004 +++ cell-cultures/cl-opengl/glut-extras.lisp Tue Dec 14 04:53:05 2004 @@ -43,7 +43,7 @@ (cl-opengl-init) (unless *glut-dll* (print (list "loading GLUT" *glut-dynamic-lib* (probe-file *glut-dynamic-lib*))) - (assert (setq *glut-dll* (uffi:load-foreign-library *glut-dynamic-lib* + (assert (setq *glut-dll* (ffx:load-foreign-library *glut-dynamic-lib* :force-load #+lispworks nil #-lispworks t :module "glut")) () "Unable to load GLUT from: ~a" *glut-dynamic-lib* )) @@ -57,7 +57,7 @@ (setf (eltf argc 0) 0) (unwind-protect (progn - (glut-init argc (uffi:make-null-pointer '(:array :cstring))) + (glut-init argc (ffx:make-null-pointer '(:array :cstring))) (print "glut initialised") ) (fgn-free argc)))) @@ -73,13 +73,13 @@ (or (not (zerop (glgeterror))) (zerop w)))) -(let ((mm (uffi:allocate-foreign-object :int 1))) +(let ((mm (ffx:allocate-foreign-object :int 1))) (defun get-matrix-mode () (glgetintegerv gl_matrix_mode mm) (uffi:deref-array mm '(:array :int) 0))) -(let ((mm (uffi:allocate-foreign-object :int 1)) - (sd (uffi:allocate-foreign-object :int 1))) +(let ((mm (ffx:allocate-foreign-object :int 1)) + (sd (ffx:allocate-foreign-object :int 1))) (defun get-stack-depth () (glgetintegerv gl_matrix_mode mm) (let ((mmi (uffi:deref-array mm '(:array :int) 0))) @@ -93,7 +93,7 @@ (uffi:deref-array sd '(:array :int) 0)))) (defun cello-matrix-mode (&optional (tag :anon)) - (let ((mm (uffi:allocate-foreign-object :int 1)) + (let ((mm (ffx:allocate-foreign-object :int 1)) ) (glgetintegerv gl_matrix_mode mm) (let ((mmi (uffi:deref-array mm '(:array :int) 0))) @@ -104,7 +104,7 @@ ((eql mmi gl_texture) :texture) (t (break "gl-stack-depth> unexpected matrix mode ~a ~a" tag mmi))) - (uffi::free-foreign-object mm))))) + (ffx:free-foreign-object mm))))) (defun glut-stroke-string (font string) "Font must already have been converted to a pointer, string must be Lisp string" Index: cell-cultures/cl-opengl/glut-functions.lisp diff -u cell-cultures/cl-opengl/glut-functions.lisp:1.2 cell-cultures/cl-opengl/glut-functions.lisp:1.3 --- cell-cultures/cl-opengl/glut-functions.lisp:1.2 Wed Nov 17 13:31:45 2004 +++ cell-cultures/cl-opengl/glut-functions.lisp Tue Dec 14 04:53:05 2004 @@ -70,10 +70,13 @@ (ff-defun-callable :cdecl :void mgwclose () (print "closing callback entered")) +(FF:DEFUN-FOREIGN-CALLABLE MGWCLOSE (:VOID) (DECLARE (:CONVENTION :C)) + (PRINT "closing callback entered")) + (defpackage #:cl-opengl (:nicknames #:ogl) (:use) - (:export mgwclose #:freeg #:glut-bitmap-string #:glut-stroke-string)) + (:export #:mgwclose #:freeg #:glut-bitmap-string #:glut-stroke-string)) (defun freeg () t) Index: cell-cultures/cl-opengl/nehe-14.lisp diff -u cell-cultures/cl-opengl/nehe-14.lisp:1.2 cell-cultures/cl-opengl/nehe-14.lisp:1.3 --- cell-cultures/cl-opengl/nehe-14.lisp:1.2 Fri Oct 15 05:37:55 2004 +++ cell-cultures/cl-opengl/nehe-14.lisp Tue Dec 14 04:53:05 2004 @@ -114,13 +114,13 @@ (glut-init-window-size 640 480) ;; Window Size If We Start In Windowed Mode (let ((key "NeHe's OpenGL Framework")) - (uffi:with-cstring (key-native key) + (ffx:with-cstring (key-native key) (glut-create-window key-native))) ;(init) ; // Our Initialization ;; Set up the callbacks in OpenGL/GLUT (glut-display-func (ff-register-callable dispfunc)) - (glut-wm-close-func (ff-register-callable 'mgwclose)) + (glut-wm-close-func (ff-register-callable mgwclose)) (glut-keyboard-func (ff-register-callable 'mgwkey)) (gl-matrix-mode gl_projection) Index: cell-cultures/cl-opengl/ogl-macros.lisp diff -u cell-cultures/cl-opengl/ogl-macros.lisp:1.3 cell-cultures/cl-opengl/ogl-macros.lisp:1.4 --- cell-cultures/cl-opengl/ogl-macros.lisp:1.3 Fri Oct 15 05:37:55 2004 +++ cell-cultures/cl-opengl/ogl-macros.lisp Tue Dec 14 04:53:05 2004 @@ -102,11 +102,11 @@ (declare (ignorable load-oglfont-p)) (unless *opengl-dll* (print "loading open GL/GLU") - (uffi:load-foreign-library + (ffx:load-foreign-library *gl-dynamic-lib* :module "open-gl") ;; -lispworks#-lispworks - (setf *opengl-dll* (uffi:load-foreign-library *glu-dynamic-lib* + (setf *opengl-dll* (ffx:load-foreign-library *glu-dynamic-lib* :module "gl-util")))) (defun glec (&optional (id :anon)) Index: cell-cultures/cl-opengl/ogl-utils.lisp diff -u cell-cultures/cl-opengl/ogl-utils.lisp:1.5 cell-cultures/cl-opengl/ogl-utils.lisp:1.6 --- cell-cultures/cl-opengl/ogl-utils.lisp:1.5 Thu Oct 28 02:09:33 2004 +++ cell-cultures/cl-opengl/ogl-utils.lisp Tue Dec 14 04:53:05 2004 @@ -139,7 +139,7 @@ ;;(cells::count-it :normalize-3f) (values (+ (/ x m)) (+ (/ y m)) (+ (/ z m))))))) -(uffi:def-foreign-type bool* (* glboolean)) +(ffx:def-foreign-type bool* (* glboolean)) #-lispworks (declaim (type bool* *ogl-boolean*)) @@ -151,7 +151,7 @@ (gl-get-booleanv gl-code *ogl-boolean*) (not (zerop (uffi:deref-array *ogl-boolean* '(:array glboolean) 0)))) -(uffi:def-foreign-type glint* (* glint)) +(ffx:def-foreign-type glint* (* glint)) #-lispworks (declaim (type glint* *ogl-int*)) From ktilton at common-lisp.net Tue Dec 14 03:53:42 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Tue, 14 Dec 2004 04:53:42 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/ffi-extender/arrays.lisp cell-cultures/ffi-extender/callbacks.lisp cell-cultures/ffi-extender/definers.lisp cell-cultures/ffi-extender/ffi-extender.asd cell-cultures/ffi-extender/ffi-extender.lpr Message-ID: <20041214035342.AD082885E6@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/ffi-extender In directory common-lisp.net:/tmp/cvs-serv10251/ffi-extender Modified Files: arrays.lisp callbacks.lisp definers.lisp ffi-extender.asd ffi-extender.lpr Log Message: No idea how the OpenGL stuff changed. Mostly bringing ffi-extender up to date. Date: Tue Dec 14 04:53:33 2004 Author: ktilton Index: cell-cultures/ffi-extender/arrays.lisp diff -u cell-cultures/ffi-extender/arrays.lisp:1.4 cell-cultures/ffi-extender/arrays.lisp:1.5 --- cell-cultures/ffi-extender/arrays.lisp:1.4 Sun Dec 5 05:50:54 2004 +++ cell-cultures/ffi-extender/arrays.lisp Tue Dec 14 04:53:31 2004 @@ -190,4 +190,5 @@ with-ff-array-elements make-ff-array make-floatv ff-floatv-ensure - ffx-reset fgn-alloc fgn-free gllog glfree))) \ No newline at end of file + ffx-reset fgn-alloc fgn-free gllog glfree))) + Index: cell-cultures/ffi-extender/callbacks.lisp diff -u cell-cultures/ffi-extender/callbacks.lisp:1.3 cell-cultures/ffi-extender/callbacks.lisp:1.4 --- cell-cultures/ffi-extender/callbacks.lisp:1.3 Sun Dec 5 05:50:54 2004 +++ cell-cultures/ffi-extender/callbacks.lisp Tue Dec 14 04:53:31 2004 @@ -78,4 +78,4 @@ (export '(ff-register-callable ff-defun-callable ff-def-call - ff-pointer-address))) \ No newline at end of file + ff-pointer-address))) Index: cell-cultures/ffi-extender/definers.lisp diff -u cell-cultures/ffi-extender/definers.lisp:1.3 cell-cultures/ffi-extender/definers.lisp:1.4 --- cell-cultures/ffi-extender/definers.lisp:1.3 Mon Dec 6 21:26:08 2004 +++ cell-cultures/ffi-extender/definers.lisp Tue Dec 14 04:53:31 2004 @@ -20,8 +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/ffi-extender/definers.lisp,v 1.3 2004/12/06 20:26:08 ktilton Exp $ - +;; $Header: /project/cells/cvsroot/cell-cultures/ffi-extender/definers.lisp,v 1.4 2004/12/14 03:53:31 ktilton Exp $ (defpackage :ffi-extender Index: cell-cultures/ffi-extender/ffi-extender.asd diff -u cell-cultures/ffi-extender/ffi-extender.asd:1.1 cell-cultures/ffi-extender/ffi-extender.asd:1.2 --- cell-cultures/ffi-extender/ffi-extender.asd:1.1 Sat Jun 26 20:38:42 2004 +++ cell-cultures/ffi-extender/ffi-extender.asd Tue Dec 14 04:53:32 2004 @@ -16,5 +16,5 @@ :long-description "FFI conveniences wrapping UFFI or native FFI" :depends-on (:uffi) :components ((:file "definers") - (:file "arrays") - (:file "callbacks"))) + (:file "arrays" :depends-on ("definers")) + (:file "callbacks" :depends-on ("definers")))) Index: cell-cultures/ffi-extender/ffi-extender.lpr diff -u cell-cultures/ffi-extender/ffi-extender.lpr:1.2 cell-cultures/ffi-extender/ffi-extender.lpr:1.3 --- cell-cultures/ffi-extender/ffi-extender.lpr:1.2 Sun Dec 5 05:50:55 2004 +++ cell-cultures/ffi-extender/ffi-extender.lpr Tue Dec 14 04:53:32 2004 @@ -10,7 +10,7 @@ (make-instance 'module :name "callbacks.lisp") (make-instance 'module :name "arrays.lisp")) :projects (list (make-instance 'project-module :name - "c:\\000000\\uffi\\uffi")) + "c:\\00\\uffi\\uffi")) :libraries nil :distributed-files nil :project-package-name :ffi-extender From ktilton at common-lisp.net Tue Dec 14 03:57:13 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Tue, 14 Dec 2004 04:57:13 +0100 (CET) Subject: [cells-cvs] CVS update: Directory change: cell-cultures/hello-c Message-ID: <20041214035713.D2B4D885E3@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/hello-c In directory common-lisp.net:/tmp/cvs-serv10342/hello-c Log Message: Directory /project/cells/cvsroot/cell-cultures/hello-c added to the repository Date: Tue Dec 14 04:57:13 2004 Author: ktilton New directory cell-cultures/hello-c added From ktilton at common-lisp.net Tue Dec 14 03:58:58 2004 From: ktilton at common-lisp.net (Kenny Tilton) Date: Tue, 14 Dec 2004 04:58:58 +0100 (CET) Subject: [cells-cvs] CVS update: cell-cultures/hello-c/aggregates.lisp cell-cultures/hello-c/arrays.lisp cell-cultures/hello-c/callbacks.lisp cell-cultures/hello-c/definers.lisp cell-cultures/hello-c/functions.lisp cell-cultures/hello-c/hello-c.asd cell-cultures/hello-c/hello-c.lpr cell-cultures/hello-c/libraries.lisp cell-cultures/hello-c/objects.lisp cell-cultures/hello-c/os.lisp cell-cultures/hello-c/package.lisp cell-cultures/hello-c/primitives.lisp cell-cultures/hello-c/readmacros-mcl.lisp cell-cultures/hello-c/strings.lisp Message-ID: <20041214035858.1C2B68850A@common-lisp.net> Update of /project/cells/cvsroot/cell-cultures/hello-c In directory common-lisp.net:/tmp/cvs-serv10374/hello-c Added Files: aggregates.lisp arrays.lisp callbacks.lisp definers.lisp functions.lisp hello-c.asd hello-c.lpr libraries.lisp objects.lisp os.lisp package.lisp primitives.lisp readmacros-mcl.lisp strings.lisp Log Message: Initialization of HELLO-C, the UFFI fork Date: Tue Dec 14 04:58:49 2004 Author: ktilton