/[cells]/cells-ode/test-c-ode.lisp
ViewVC logotype

Contents of /cells-ode/test-c-ode.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.5 - (show annotations)
Mon Jun 2 14:12:53 2008 UTC (5 years, 10 months ago) by phildebrandt
Branch: MAIN
CVS Tags: HEAD
Changes since 1.4: +5 -4 lines
attach joints by using slots body-1, body-2
1 #|
2
3 Cells-ODE -- A cells driven interface to cl-ode
4
5 Copyright (C) 2008 by Peter Hildebrandt
6
7 This library is free software; you can redistribute it and/or
8 modify it under the terms of the Lisp Lesser GNU Public License
9 (http://opensource.franz.com/preamble.html), known as the LLGPL.
10
11 This library is distributed WITHOUT ANY WARRANTY; without even
12 the implied warranty of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.
13
14 See the Lisp Lesser GNU Public License for more details.
15
16 |#
17
18
19 (in-package :c-ode)
20
21 (defvar *time* 0)
22
23 (defun tst-init ()
24 (ode-init)
25 (setf *time* 0)
26 (make-instance 'geom-plane :params (c-in #(0 0 1 0)) :md-name :plane))
27
28 (defun tst-bodies ()
29 (tst-init)
30 (make-instance 'body
31 :md-name :body1
32 :position (c-in #(0 -1 1))
33 :mass (c-in (make-instance 'sphere-mass :radius (c-in .5))))
34 (make-instance 'body
35 :md-name :body2
36 :position (c-in #(0 1 2))
37 :mass (c-in (make-instance 'capsule-mass :mass (c-in 5) :radius (c-in .5) :length (c-in .5) :orientation (c-in :z))))
38 (make-instance 'body
39 :md-name :body3
40 :position (c-in #(0 3 2))
41 :quaternion (c-in #(.7 1 0 0))
42 :mass (c-in (make-instance 'box-mass :mass (c-in 5) :size (c-in #(1 1 1)))))
43
44 (setf (mass (mass (obj :body1))) 10)
45
46 (make-instance 'geom-sphere :radius (c-in .5) :md-name :geom1 :body (obj :body1))
47 (make-instance 'geom-capsule :radius (c-in .5) :length (c-in .5) :md-name :geom2 :body (obj :body2))
48 (make-instance 'geom-box :length (c-in #(1 1 1)) :md-name :geom3 :body (obj :body3))
49
50 (format t "~&~%Use (obj :body[1-3]), (obj :geom[1-3]), or (obj :plane) to query objects.~%")
51 *world*)
52
53 (defun tst-joints ()
54 (tst-init)
55
56 (make-instance 'body :md-name :body1 :position (c-in #(10 0 .5)) :mass (make-instance 'sphere-mass :mass 30))
57 (make-instance 'geom-box :md-name :geom1 :size #(1 1 1) :body (obj :body1))
58 (make-instance 'body :md-name :body2 :position (c-in #(10.6 0 .5)) :mass (make-instance 'sphere-mass :mass .5))
59 (make-instance 'geom-box :md-name :geom2 :size #(.1 .5 .1) :body (obj :body2))
60
61 (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))
62 ; (attach (obj :joint) (obj :body1) (obj :body2))
63 )
64
65
66 (defun tst-run (&key (diag nil) (step-size .01))
67 (unless *objects*
68 (format t "Use (tst-bodies) or (tst-joints) to set up a test~%Use (tst-init) for a blank world.~%~%"))
69 (dotimes (i 50)
70 (when (= 0 (mod i 2))
71 (format t "~&~,2fs: ~{~&~a: (pos ~a, vel ~a)~#[~:;, ~]~}~%" *time*
72 (loop for name in '(:body1 :body2 :body3 :body4)
73 for body = (obj name)
74 if body collect name
75 and collect (position body)
76 and collect (linear-vel body))))
77 (ode-step :diag diag :step-size step-size)
78 (incf *time* step-size)))
79
80 (defun tst-cleanup ()
81 (ode-cleanup))
82

  ViewVC Help
Powered by ViewVC 1.1.5