[cells-cvs] CVS cells-ode
phildebrandt
phildebrandt at common-lisp.net
Sat Feb 9 14:02:17 UTC 2008
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 , at 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 , at 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+)))
+ , at 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)))
More information about the Cells-cvs
mailing list