Update of /project/cells/cvsroot/cells-ode In directory clnet:/tmp/cvs-serv23636

Modified Files: collision.lisp mass.lisp objects.lisp simulate.lisp types.lisp world.lisp Log Message: some more fixes

--- /project/cells/cvsroot/cells-ode/collision.lisp 2008/02/09 11:18:12 1.2 +++ /project/cells/cvsroot/cells-ode/collision.lisp 2008/02/09 14:02:16 1.3 @@ -47,9 +47,11 @@ (:default-initargs :ode-id (error "Use mk-quad-tree-space to create a quad-tree-space")))

-(defun mk-quad-tree-space (center extents depth) - (make-instance 'quad-tree-space - :ode-id (call-ode quad-tree-space-create (((null-pointer)) (center vector) (extents vector) (depth int))))) +(defun mk-quad-tree-space (center extents depth &rest initargs) + (apply #'make-instance + 'quad-tree-space + :ode-id (call-ode quad-tree-space-create (((null-pointer)) (center vector-3-ptr) (extents vector-3-ptr) (depth int))) + initargs))

;;; @@ -85,14 +87,6 @@ (format t "~&called collide -- result ~a~%" res) res))

-;;; kt> ACL still complains about the comma even tho this is featured out!!! -;;; -;;;#+bbzzt (collide (,geom-1 -;;; ,geom-2 -;;; ,max-contacts -;;; (foreign-slot-value (mem-aref ,contacts 'ode:contact 0) 'ode:contact 'ode:geom) -;;; (foreign-type-size 'ode:contact))) - (defmacro do-contacts ((contact geom-1 geom-2 &key (max-contacts +max-collision-contacts+)) &body body) (with-uniqs (contacts num-contacts) `(with-foreign-object (,contacts 'ode:contact ,max-contacts) @@ -115,8 +109,10 @@ (defun make-with (type slots-and-types) (multiple-value-bind (slots types) (parse-typed-args slots-and-types) `(defmacro ,(intern-string 'with type) (,type (&optional ,@(mapcar #'(lambda (slot) `(,slot ',(gensym (string slot)))) slots)) &body body) + (declare (ignorable ,@slots)) (list 'with-foreign-slots (list ',(mapcar #'ode-sym slots) ,type ',(ode-sym type)) (append (list 'let (list ,@(mapcar #'(lambda (slot type) `(list ,slot ',(make-from-ode type nil (list (ode-sym slot))))) slots types))) + (list (list 'declare (append '(ignorable) ,(append '(list) slots)))) body))))))

(defmacro def-with-ode (type (&rest slots-and-types)) @@ -133,7 +129,10 @@ (with-uniqs mode `(with-foreign-slots (,(append ode-params '(ode:mode)) ,ode-surface ode:surface-parameters) (let ,(append (list (list mode 0)) params) - (macrolet ((select-max (&rest params) `(progn ,@(mapcar #'(lambda (param) `(setf ,param (max (,param ,',geom-1) (,param ,',geom-2)))) ',params)))) + (macrolet ((select-max (&rest params) `(progn ,@(mapcar #'(lambda (param) `(setf ,param (max (,param ,',geom-1) (,param ,',geom-2)))) params))) + (select-avg (&rest params) `(progn ,@(mapcar #'(lambda (param) `(setf ,param (/ (+ (,param ,',geom-1) (,param ,',geom-2)) 2))) params))) + (select-min (&rest params) `(progn ,@(mapcar #'(lambda (param) `(setf ,param (min (,param ,',geom-1) (,param ,',geom-2)))) params))) +) ,select) ,@(loop for sym in params for ode-sym in ode-params collecting `(when ,sym @@ -162,7 +161,9 @@ (with-contact contact (surface contact-geom friction-dir-1) (with-contact-geom contact-geom (pos normal) (with-surface-parameters (surface geom-1 geom-2) - (progn (select-max mu bounce bounce-vel)) + (progn (select-min mu) + (select-avg bounce-vel) + (select-max bounce)) (mk-collision)))))))))

;;; --- /project/cells/cvsroot/cells-ode/mass.lisp 2008/02/09 11:18:12 1.2 +++ /project/cells/cvsroot/cells-ode/mass.lisp 2008/02/09 14:02:17 1.3 @@ -122,8 +122,8 @@ (defobserver length ((self cylinder-mass) newval) (set-cylinder-total self (mass self) (mass-dir (orientation self)) (radius self) newval))

-;;;(defmethod echo-slots append ((self capsule-mass)) kt> duplicates same above -;;; '(radius orientation length)) +(defmethod echo-slots append ((self cylinder-mass)) + '(radius orientation length))

;;; box mass

--- /project/cells/cvsroot/cells-ode/objects.lisp 2008/02/09 11:18:12 1.2 +++ /project/cells/cvsroot/cells-ode/objects.lisp 2008/02/09 14:02:17 1.3 @@ -65,7 +65,6 @@

(defmethod update ((self ode-object)) "called to update cells model after step" - (declare (ignorable self)) ;; kt> ACL does not consider this ignored since the method param was specialized self)

(defmethod ode-destroy ((self ode-object)) --- /project/cells/cvsroot/cells-ode/simulate.lisp 2008/02/09 11:18:12 1.2 +++ /project/cells/cvsroot/cells-ode/simulate.lisp 2008/02/09 14:02:17 1.3 @@ -30,8 +30,6 @@ ;;; stepping ;;;

-(def-ode-method step-fast1 ((self world) (step-size number) (max-iterations int))) -;;;(def-ode-method step ((self world) (step-size number))) kt> same in world.lisp

(defun ode-step (&key (step-size 0.01) (diag t) (fast-step nil) (max-iterations 20)) "steps the world by step-size seconds" --- /project/cells/cvsroot/cells-ode/types.lisp 2008/02/09 11:18:12 1.2 +++ /project/cells/cvsroot/cells-ode/types.lisp 2008/02/09 14:02:17 1.3 @@ -8,7 +8,7 @@ (defconstant +precision+ 'single-float) (define-constant +infinity+ 1.0e8 "prevent overflows")

-(ukt:eval-now! +(eval-now! ;;; unknown type (defmethod make-with-ode (name type body &optional (self 'self)) (declare (ignorable self name)) @@ -124,6 +124,19 @@ `(let ((ptr (progn ,@body))) ,rest))))

+ ;;; vector-3-ptr + + (defmethod make-with-ode (name (type (eql 'vector-3-ptr)) body &optional (self 'self)) + (declare (ignorable self name)) + (let ((vec (intern-string name type))) + `(with-foreign-object (,vec 'ode:real 3) + ,@(loop for i from 0 below 3 + collect `(setf (mem-aref ,vec 'ode:real ,i) (coerce (aref ,name ,i) +precision+))) + ,@body))) + + (defmethod make-convert (name (type (eql 'vector-3-ptr))) + `(,(intern-string name type))) + ;;; quaternion

--- /project/cells/cvsroot/cells-ode/world.lisp 2008/02/09 11:18:12 1.3 +++ /project/cells/cvsroot/cells-ode/world.lisp 2008/02/09 14:02:17 1.4 @@ -10,9 +10,10 @@ (def-ode-model environment (collideable-object) () (:default-initargs - :ode-id (null-pointer))) + :ode-id (null-pointer) + :md-name :environment))

-(defparameter *environment* (make-instance 'environment :md-name :environment) "static environment") +(defparameter *environment* (make-instance 'environment) "static environment")

;;; ;;; world @@ -37,7 +38,8 @@ (contact-max-correcting-vel :auto-update nil) (contact-surface-layer :auto-update nil)) (:default-initargs - :ode-id (call-ode world-create ()))) + :ode-id (call-ode world-create ()) + :md-name :world))

(defmethod initialize-instance :after ((self world) &rest initargs) (declare (ignore initargs)) @@ -51,9 +53,7 @@ (def-ode-method impulse-to-force ((self world) (step-size number) (impulse vector) (result vector)))

(def-ode-method step ((self world) (step-size number))) - -(def-ode-method quick-step ((self world) (step-size number))) - +(def-ode-method step-fast1 ((self world) (step-size number) (max-iterations int)))