view org/skin.org @ 12:22c6878a1bc0

going to great debug view of new raycasting touch
author Robert McIntyre <rlm@mit.edu>
date Sun, 23 Oct 2011 11:03:52 -0700
parents a149692d3d1f
children 0eb2eac53361
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))
116 )
118 (def init-node
119 (fn [debug-node rays]
120 (.detachAllChildren debug-node)
121 (for [ray rays]
122 (.attachChild debug-node (ray-debug ray ColorRGBA/Gray))
123 (.attachChild debug-node (ray-origin-debug ray ColorRGBA/Gray))
127 (defn manage-ray-debug-node [debug-node ray color]
131 )
135 (defn touch-percieve [limit geom node debug-node]
136 (let [normals (normal-rays limit geom)]
138 (doall
139 (for [ray normals]
140 (do
141 (let [results (CollisionResults.)]
142 (.collideWith node ray results)
143 (let [answer (count (filter #(not (= geom (.getGeometry %))) results))
144 ;;color (contact-color answer)
145 ]
146 ;;(dorun (map #(println-repl (.getName (.getGeometry %))) results))
149 ;;(println-repl (.size results) "results for " ray)
150 ;;(doall (map (partial collision-debug node) results))
151 answer
152 )))))))
154 (defn enable-debug [world]
155 (.enableDebug
156 (.getPhysicsSpace
157 (.getState
158 (.getStateManager world)
159 BulletAppState))
160 (asset-manager)))
162 (defn no-logging []
163 (.setLevel (Logger/getLogger "com.jme3") Level/OFF))
165 (defn set-accuracy [world new-accuracy]
166 (let [physics-manager (.getState (.getStateManager world) BulletAppState)]
167 (.setAccuracy (.getPhysicsSpace physics-manager) (float new-accuracy))))
170 (defn transparent-sphere []
171 (doto
172 (make-shape
173 (merge base-shape
174 {:position (Vector3f. 0 2 0)
175 :name "the blob."
176 :material "Common/MatDefs/Misc/Unshaded.j3md"
177 :texture "Textures/purpleWisp.png"
178 :physical? true
179 :mass 70
180 :color ColorRGBA/Blue
181 :shape (Sphere. 10 10 1)}))
182 (-> (.getMaterial)
183 (.getAdditionalRenderState)
184 (.setBlendMode RenderState$BlendMode/Alpha))
185 (.setQueueBucket RenderQueue$Bucket/Transparent)))
187 (defn transparent-box []
188 (doto
189 (make-shape
190 (merge base-shape
191 {:position (Vector3f. 0 2 0)
192 :name "box"
193 :material "Common/MatDefs/Misc/Unshaded.j3md"
194 :texture "Textures/purpleWisp.png"
195 :physical? true
196 :mass 70
197 :color ColorRGBA/Blue
198 :shape (Box. 1 1 1)}))
199 (-> (.getMaterial)
200 (.getAdditionalRenderState)
201 (.setBlendMode RenderState$BlendMode/Alpha))
202 (.setQueueBucket RenderQueue$Bucket/Transparent)))
204 (defn transparent-floor []
205 (doto
206 (box 5 0.2 5 :mass 0 :position (Vector3f. 0 -2 0)
207 :material "Common/MatDefs/Misc/Unshaded.j3md"
208 :texture "Textures/redWisp.png"
209 :name "floor")
210 (-> (.getMaterial)
211 (.getAdditionalRenderState)
212 (.setBlendMode RenderState$BlendMode/Alpha))
213 (.setQueueBucket RenderQueue$Bucket/Transparent)))
215 (defn test-skin []
216 (let [b
217 (transparent-box)
218 ;;(transparent-sphere)
219 ;;(sphere)
220 f (transparent-floor)
221 ;;controls
222 ;;(make-touch-sphere b)
223 ;;(make-touch b)
224 debug-node (Node.)
225 node (doto (Node.) (.attachChild b) (.attachChild f))
226 root-node (doto (Node.) (.attachChild node)
227 (.attachChild debug-node))
228 ]
230 (world
231 root-node
232 {"key-return" (fire-cannon-ball)}
233 ;;no-op
234 (fn [world]
235 ;; (Capture/SimpleCaptureVideo
236 ;; world
237 ;; (file-str "/home/r/proj/cortex/tmp/blob.avi"))
238 ;; (no-logging)
239 (enable-debug world)
240 ;; (set-accuracy world (/ 1 60))
241 )
243 (fn [& _]
244 (println-repl
245 (touch-percieve 0.2 b node debug-node)
246 )
247 (Thread/sleep 10)
248 ;;(touch-print controls)
249 ;;(color-touch controls)
250 ))))
252 #+end_src
254 #+results: skin-main
255 : #'body.skin/test-skin
264 * COMMENT code generation
265 #+begin_src clojure :tangle ../src/body/skin.clj :noweb yes
266 <<skin-main>>
267 #+end_src