view org/skin.org @ 15:c32f3eb9fdeb

modified fire-cannon-ball to place the ball on a specific node
author Robert McIntyre <rlm@mit.edu>
date Sun, 23 Oct 2011 11:50:17 -0700
parents 3aa1ee6c6308
children d2e9f0d09475
line wrap: on
line source
1 #+title: SKIN!
2 #+author: Robert McIntyre
3 #+email: rlm@mit.edu
4 #+description: Simulating touch in JMonkeyEngine
5 #+SETUPFILE: ../../aurellem/org/setup.org
6 #+INCLUDE: ../../aurellem/org/level-0.org
7 #+babel: :mkdirp yes :noweb yes
9 let's see what checkboxes look like:
11 * test [1/2]
12 - [ ] item 1
13 - [X] item 2
16 * skin!
18 #+srcname: skin-main
19 #+begin_src clojure
20 (ns body.skin)
21 (use 'cortex.world)
22 (use 'cortex.import)
23 (use 'clojure.contrib.def)
24 (cortex.import/mega-import-jme3)
25 (rlm.rlm-commands/help)
27 (import java.util.logging.Level)
28 (import java.util.logging.Logger)
29 (use 'hello.brick-wall)
33 (defn triangles [#^Geometry geom]
34 (let
35 [mesh (.getMesh geom)
36 triangles (transient [])]
37 (dorun
38 (for [n (range (.getTriangleCount mesh))]
39 (let [tri (Triangle.)]
40 (.getTriangle mesh n tri)
41 (.calculateNormal tri)
42 (.calculateCenter tri)
43 (conj! triangles tri))))
44 (persistent! triangles)))
47 (defn get-ray-origin
48 [geom tri]
49 (let [new (Vector3f.)]
50 (.calculateCenter tri)
51 (.localToWorld geom (.getCenter tri) new)
52 new))
54 (defn get-ray-direction
55 [geom tri]
56 (let [n+c (Vector3f.)]
57 (.calculateNormal tri)
58 (.calculateCenter tri)
59 (.localToWorld geom (.add (.getCenter tri) (.getNormal tri)) n+c)
60 (.subtract n+c (get-ray-origin geom tri))
61 ))
63 (defn ray-origin-debug
64 [ray color]
65 (make-shape
66 (assoc base-shape
67 :shape (Sphere. 5 5 0.05)
68 :name "arrow"
69 :color color
70 :texture false
71 :physical? false
72 :position
73 (.getOrigin ray))))
75 (defn ray-debug [ray color]
76 (make-shape
77 (assoc
78 base-shape
79 :name "debug-ray"
80 :physical? false
81 :shape (com.jme3.scene.shape.Line.
82 (.getOrigin ray)
83 (.add
84 (.getOrigin ray)
85 (.mult (.getDirection ray)
86 (float (.getLimit ray))))))))
89 (defn contact-color [contacts]
90 (case contacts
91 0 ColorRGBA/Gray
92 1 ColorRGBA/Blue
93 2 ColorRGBA/Green
94 3 ColorRGBA/Yellow
95 4 ColorRGBA/Orange
96 5 ColorRGBA/Red
97 6 ColorRGBA/Magenta
98 7 ColorRGBA/Pink
99 8 ColorRGBA/White))
101 (defn normal-rays
102 "returns rays"
103 [limit #^Geometry geom]
104 (vec
105 (map
106 (fn [tri]
107 (doto
108 (Ray. (get-ray-origin geom tri)
109 (get-ray-direction geom tri))
110 (.setLimit limit)))
111 (triangles geom))))
114 (defn collision-debug [node result]
115 (println-repl "contact point: " (.getContactPoint result))
118 )
120 (defn update-ray-debug [node ray contacts]
121 (let [origin (.getChild node 0)]
122 (.setLocalTranslation origin (.getOrigin ray))
123 (.setColor (.getMaterial origin) "Color" (contact-color contacts))))
128 (defn init-node
129 [debug-node rays]
130 (println-repl "Init touch debug node.")
131 (.detachAllChildren debug-node)
132 (dorun
133 (for [ray rays]
134 (do
135 (.attachChild
136 debug-node
137 (doto (Node.)
138 (.attachChild (ray-origin-debug ray ColorRGBA/Gray))
139 ;;(.attachChild (ray-debug ray ColorRGBA/Gray))
140 ))))))
144 (defn manage-ray-debug-node [debug-node geom touch-data limit]
145 (let [rays (normal-rays limit geom)]
146 (if (not= (count (.getChildren debug-node)) (count touch-data))
147 (init-node debug-node rays))
148 (dorun
149 (for [n (range (count touch-data))]
150 (update-ray-debug
151 (.getChild debug-node n) (nth rays n) (nth touch-data n))))))
154 (defn touch-percieve [limit geom node]
155 (let [normals (normal-rays limit geom)]
157 (doall
158 (for [ray normals]
159 (do
160 (let [results (CollisionResults.)]
161 (.collideWith node ray results)
162 (let [answer (count (filter #(not (= geom (.getGeometry %))) results))
163 ;;color (contact-color answer)
164 ]
165 ;;(dorun (map #(println-repl (.getName (.getGeometry %))) results))
168 ;;(println-repl (.size results) "results for " ray)
169 ;;(doall (map (partial collision-debug node) results))
170 answer
171 )))))))
173 (defn enable-debug [world]
174 (.enableDebug
175 (.getPhysicsSpace
176 (.getState
177 (.getStateManager world)
178 BulletAppState))
179 (asset-manager)))
181 (defn no-logging []
182 (.setLevel (Logger/getLogger "com.jme3") Level/OFF))
184 (defn set-accuracy [world new-accuracy]
185 (let [physics-manager (.getState (.getStateManager world) BulletAppState)]
186 (.setAccuracy (.getPhysicsSpace physics-manager) (float new-accuracy))))
189 (defn transparent-sphere []
190 (doto
191 (make-shape
192 (merge base-shape
193 {:position (Vector3f. 0 2 0)
194 :name "the blob."
195 :material "Common/MatDefs/Misc/Unshaded.j3md"
196 :texture "Textures/purpleWisp.png"
197 :physical? true
198 :mass 70
199 :color ColorRGBA/Blue
200 :shape (Sphere. 10 10 1)}))
201 (-> (.getMaterial)
202 (.getAdditionalRenderState)
203 (.setBlendMode RenderState$BlendMode/Alpha))
204 (.setQueueBucket RenderQueue$Bucket/Transparent)))
206 (defn transparent-box []
207 (doto
208 (make-shape
209 (merge base-shape
210 {:position (Vector3f. 0 2 0)
211 :name "box"
212 :material "Common/MatDefs/Misc/Unshaded.j3md"
213 :texture "Textures/purpleWisp.png"
214 :physical? true
215 :mass 70
216 :color ColorRGBA/Blue
217 :shape (Box. 1 1 1)}))
218 (-> (.getMaterial)
219 (.getAdditionalRenderState)
220 (.setBlendMode RenderState$BlendMode/Alpha))
221 (.setQueueBucket RenderQueue$Bucket/Transparent)))
223 (defn transparent-floor []
224 (doto
225 (box 5 0.2 5 :mass 0 :position (Vector3f. 0 -2 0)
226 :material "Common/MatDefs/Misc/Unshaded.j3md"
227 :texture "Textures/redWisp.png"
228 :name "floor")
229 (-> (.getMaterial)
230 (.getAdditionalRenderState)
231 (.setBlendMode RenderState$BlendMode/Alpha))
232 (.setQueueBucket RenderQueue$Bucket/Transparent)))
234 (defn test-skin []
235 (let [b
236 ;;(transparent-box)
237 (transparent-sphere)
238 ;;(sphere)
239 f (transparent-floor)
240 ;;controls
241 ;;(make-touch-sphere b)
242 ;;(make-touch b)
243 debug-node (Node.)
244 node (doto (Node.) (.attachChild b) (.attachChild f))
245 root-node (doto (Node.) (.attachChild node)
246 (.attachChild debug-node))
247 ]
249 (world
250 root-node
251 {"key-return" (fire-cannon-ball node)}
252 ;;no-op
253 (fn [world]
254 ;; (Capture/SimpleCaptureVideo
255 ;; world
256 ;; (file-str "/home/r/proj/cortex/tmp/blob.avi"))
257 ;; (no-logging)
258 (enable-debug world)
259 ;; (set-accuracy world (/ 1 60))
260 )
262 (fn [& _]
263 (let [touch-data (touch-percieve 0.2 b node)]
264 ;;(println-repl touch-data)
265 (manage-ray-debug-node debug-node b touch-data 0.2))
266 (Thread/sleep 10)
267 ;;(touch-print controls)
268 ;;(color-touch controls)
269 ))))
271 #+end_src
273 #+results: skin-main
274 : #'body.skin/test-skin
283 * COMMENT code generation
284 #+begin_src clojure :tangle ../src/body/skin.clj :noweb yes
285 <<skin-main>>
286 #+end_src