/[cells-ode]/cells-ode/geoms.lisp
ViewVC logotype

Contents of /cells-ode/geoms.lisp

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1.1.1.1 - (show annotations) (vendor branch)
Tue Jun 3 08:26:45 2008 UTC (5 years, 10 months ago) by phildebrandt
Branch: MAIN, phildebrandt
CVS Tags: initial, HEAD
Changes since 1.1: +0 -0 lines
initial import
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 ;;;
20 ;;; geom
21 ;;;
22
23 (in-package :c-ode)
24
25
26 (defvar *space* (null-pointer) "ODE space for collision detection")
27
28 (def-ode-model (general-geom :ode-class geom) (collideable-object)
29 ((geom-obj :ode nil :cell nil)
30 (space :type object :read-only t)
31 (geom-class :type int :ode-slot class :read-only t) ; one of ode:+...-class+
32
33 (body :ode nil :cell nil :initform *environment*)
34 ; (category-bits) ; TODO -- missing ulong type
35 ; (collide-bits) ; TODO -- missing ulong type
36
37 ))
38
39 (export! ode-space)
40 (defmethod ode-space ((self general-geom))
41 (^space))
42
43 (defmethod ode-destroy ((self general-geom))
44 (call-ode geom-destroy ((self object)))
45 (call-next-method))
46
47 (defmethod id ((self general-geom))
48 (geom-obj self))
49
50 (defmethod echo-slots append ((self general-geom))
51 '())
52
53 (def-ode-method is-space ((self general-geom geom)) bool)
54
55 (def-ode-method enable ((self general-geom geom)))
56 (def-ode-method disable ((self general-geom geom)))
57 (def-ode-method is-enabled ((self general-geom geom)) bool)
58
59 ;;;
60 ;;; placable geoms
61 ;;;
62
63 (def-ode-model geom (general-geom)
64 ((body :type object)
65 (position :type vector)
66 (quaternion :type quaternion :result-arg t)
67 ))
68
69 (export! ode-position)
70 (defmethod ode-position ((self geom))
71 (^position))
72
73 (defmethod echo-slots append ((self geom))
74 '(position quaternion))
75
76 ;;; sphere
77
78 (def-ode-model geom-sphere (geom)
79 ((radius :type number :initform (c-in 1) :auto-update nil))
80 (:default-initargs
81 :geom-obj (call-ode create-sphere ((*space* object) (1 number)))))
82
83 (def-ode-method point-depth ((self geom-sphere) (point vector)) number) ; inside is positive
84
85 (defmethod echo-slots append ((self geom-sphere))
86 '(radius))
87
88 ;;; box
89
90 (def-ode-model geom-box (geom)
91 ((lengths :type vector :initform (c-in #(1 1 1)) :auto-update nil))
92 (:default-initargs
93 :geom-obj (call-ode create-box ((*space* object) (#(1 1 1) vector)))))
94
95 (def-ode-method point-depth ((self geom-box) (point vector)) number) ; inside is positive
96
97 (defmethod echo-slots append ((self geom-box))
98 '(lengths))
99
100 ;;; capsule (aligned along Z axis)
101
102 (def-ode-model geom-capsule (geom)
103 ((radius :ode nil)
104 (length :ode nil)
105 )
106 (:default-initargs
107 :geom-obj (call-ode create-capsule ((*space* object) (1 number) (1 number)))))
108
109 (export! ode-length)
110 (defmethod ode-length ((self geom-capsule))
111 (^length))
112
113 (def-ode-method set-params ((self geom-capsule) (radius number) (length number)))
114
115 (defobserver radius ((self geom-capsule) newval)
116 (when newval
117 (set-params self newval (length self))))
118
119 (defobserver length ((self geom-capsule) newval)
120 (when newval
121 (set-params self (radius self) newval)))
122
123 (def-ode-method point-depth ((self geom-capsule) (point vector)) number) ; inside is positive
124
125 (defmethod echo-slots append ((self geom-capsule))
126 '(radius length))
127
128 ;;;
129 ;;; non-placeable geoms
130 ;;;
131
132 ;;; plane
133
134 (def-ode-model geom-plane (general-geom)
135 ((params :type vector-4 :initform (c-in #(0 0 1 0)) :result-arg t :auto-update nil) ; coefficients of ax+by+cz=d
136 )
137 (:default-initargs
138 :geom-obj (call-ode create-plane ((*space* object) (#(0 0 1 0) vector-4)))))
139
140 (def-ode-method point-depth ((self geom-plane) (point vector)) number) ; inside is positive
141
142 (defmethod echo-slots append ((self geom-plane))
143 '())
144
145
146 ;;; ray
147
148 (def-ode-model geom-ray (general-geom)
149 ((length :type number :initform (c-in 1))
150 (starting-point :ode nil)
151 (direction :ode nil))
152 (:default-initargs
153 :geom-obj (call-ode create-ray ((*space* object) (1 number)))))
154
155 (export! ode-length)
156 (defmethod ode-length ((self geom-ray))
157 (^length))
158
159 (def-ode-method (ray-set :ode-name set) ((self geom-ray) (starting-point vector) (direction vector)))
160
161 (defobserver starting-point ((self geom-ray) newval)
162 (when newval (ray-set self newval (length self))))
163
164 (defobserver direction ((self geom-ray) newval)
165 (when newval (ray-set self (direction self) newval)))
166
167 (defmethod echo-slots append ((self geom-ray))
168 '(length starting-point direction))
169
170
171
172
173 ;;; TODO: triangle mesh class
174
175 ;;;
176 ;;; Geom transform
177 ;;;
178
179 ;;; create a geom, position it relative to the origin, remove it from the space
180 ;;; then attach the transform to it and use the transform instead of the geom
181
182 (def-ode-model geom-transform ()
183 ((geom :type object)
184 (cleanup :type bool)
185 (mode :type bool :auto-update nil :initform (c-in t))) ; t --> the transform is reported to collide, can use (body geom)
186 (:default-initargs
187 :ode-id (call-ode create-geom-transform ((*space* object)))))
188
189 (defmethod echo-slots append ((self geom-transform))
190 '(geom cleanup mode))
191
192
193
194
195
196
197
198
199

  ViewVC Help
Powered by ViewVC 1.1.5