[cells-cvs] CVS cells-ode

[phildebrandt]

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

Modified Files:
	joints.lisp test-c-ode.lisp 
Log Message:
attach joints by using slots body-1, body-2


--- /project/cells/cvsroot/cells-ode/joints.lisp	2008/06/01 20:26:49	1.4
+++ /project/cells/cvsroot/cells-ode/joints.lisp	2008/06/02 14:12:53	1.5
@@ -25,6 +25,8 @@
 (def-ode-model joint ()
   ((joint-type :type int :ode-slot type  :read-only t) ; returns one constant +ode:joint-type-...+
    (feedback-struct :ode nil :cell nil :initform (foreign-alloc 'ode:joint-feedback))
+   (body-1 :ode nil)
+   (body-2 :ode nil)
    (force-1 :ode nil)
    (torque-1 :ode nil)
    (force-2 :ode nil)
@@ -138,6 +140,15 @@
 (def-ode-method attach ((self joint) (body1 object) (body2 object)))
 (def-ode-method set-fixed ((self joint)))
 (def-ode-method get-body ((self joint) (index int)) object)
+
+(defobserver body-1 ((self joint))
+  (when (and new-value (^body-2))
+    (attach self new-value (^body-2))))
+
+(defobserver body-2 ((self joint))
+  (when (and new-value (^body-1))
+    (attach self (^body-1) new-value)))
+
 (defmethod bodies ((self joint))
   (list (get-body self 0) (get-body self 1)))
 
--- /project/cells/cvsroot/cells-ode/test-c-ode.lisp	2008/06/01 20:26:49	1.4
+++ /project/cells/cvsroot/cells-ode/test-c-ode.lisp	2008/06/02 14:12:53	1.5
@@ -55,11 +55,12 @@
   
   (make-instance 'body :md-name :body1 :position (c-in #(10 0 .5)) :mass (make-instance 'sphere-mass :mass 30))
   (make-instance 'geom-box :md-name :geom1 :size #(1 1 1) :body (obj :body1))
-  (make-instance 'body :md-name :body2 :position (c-in #(10 2 .5)) :mass (make-instance 'sphere-mass :mass .1))
-  (make-instance 'geom-box :md-name :geom2 :size #(.1 .1 .1) :body (obj :body2))
+  (make-instance 'body :md-name :body2 :position (c-in #(10.6 0 .5)) :mass (make-instance 'sphere-mass :mass .5))
+  (make-instance 'geom-box :md-name :geom2 :size #(.1 .5 .1) :body (obj :body2))
   
-  (make-instance 'hinge-joint :md-name :joint :axis #(0 1 0) :anchor #(10 1.2 .5))
-  (attach (obj :joint) (obj :body1) (obj :body2)))
+  (make-instance 'hinge-joint :md-name :joint :axis #(1 0 0) :anchor #(10.5 0.5 .5) :body-1 (obj :body1) :body-2 (obj :body2))
+  ;   (attach (obj :joint) (obj :body1) (obj :body2))
+  )
 
 
 (defun tst-run (&key (diag nil) (step-size .01))