view org/skin.org @ 26:bbffa41a12a9

moved apply-map to util.org from world.org, fixed some grammar problems, made examples more concise
author Robert McIntyre <rlm@mit.edu>
date Mon, 24 Oct 2011 05:41:50 -0700
parents 67d508a1e34d
children 6372c108c5c6
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)
31 (defn triangles [#^Geometry geom]
32 (let
33 [mesh (.getMesh geom)
34 triangles (transient [])]
35 (dorun
36 (for [n (range (.getTriangleCount mesh))]
37 (let [tri (Triangle.)]
38 (.getTriangle mesh n tri)
39 (.calculateNormal tri)
40 (.calculateCenter tri)
41 (conj! triangles tri))))
42 (persistent! triangles)))
44 (defn get-ray-origin
45 [geom tri]
46 (let [new (Vector3f.)]
47 (.calculateCenter tri)
48 (.localToWorld geom (.getCenter tri) new)
49 new))
51 (defn get-ray-direction
52 [geom tri]
53 (let [n+c (Vector3f.)]
54 (.calculateNormal tri)
55 (.calculateCenter tri)
56 (.localToWorld geom (.add (.getCenter tri) (.getNormal tri)) n+c)
57 (.subtract n+c (get-ray-origin geom tri))
58 ))
60 (defn ray-origin-debug
61 [ray color]
62 (make-shape
63 (assoc base-shape
64 :shape (Sphere. 5 5 0.05)
65 :name "arrow"
66 :color color
67 :texture false
68 :physical? false
69 :position
70 (.getOrigin ray))))
72 (defn ray-debug [ray color]
73 (make-shape
74 (assoc
75 base-shape
76 :name "debug-ray"
77 :physical? false
78 :shape (com.jme3.scene.shape.Line.
79 (.getOrigin ray)
80 (.add
81 (.getOrigin ray)
82 (.mult (.getDirection ray)
83 (float (.getLimit ray))))))))
86 (defn contact-color [contacts]
87 (case contacts
88 0 ColorRGBA/Gray
89 1 ColorRGBA/Blue
90 2 ColorRGBA/Green
91 3 ColorRGBA/Yellow
92 4 ColorRGBA/Orange
93 5 ColorRGBA/Red
94 6 ColorRGBA/Magenta
95 7 ColorRGBA/Pink
96 8 ColorRGBA/White))
98 (defn normal-rays
99 "returns rays"
100 [limit #^Geometry geom]
101 (vec
102 (map
103 (fn [tri]
104 (doto
105 (Ray. (get-ray-origin geom tri)
106 (get-ray-direction geom tri))
107 (.setLimit limit)))
108 (triangles geom))))
110 (defn update-ray-debug [node ray contacts]
111 (let [origin (.getChild node 0)]
112 (.setLocalTranslation origin (.getOrigin ray))
113 (.setColor (.getMaterial origin) "Color" (contact-color contacts))))
115 (defn init-node
116 [debug-node rays]
117 (println-repl "Init touch debug node.")
118 (.detachAllChildren debug-node)
119 (dorun
120 (for [ray rays]
121 (do
122 (.attachChild
123 debug-node
124 (doto (Node.)
125 (.attachChild (ray-origin-debug ray ColorRGBA/Gray))
126 (.attachChild (ray-debug ray ColorRGBA/Gray))
127 ))))))
129 (defn manage-ray-debug-node [debug-node geom touch-data limit]
130 (let [rays (normal-rays limit geom)]
131 (if (not= (count (.getChildren debug-node)) (count touch-data))
132 (init-node debug-node rays))
133 (dorun
134 (for [n (range (count touch-data))]
135 (update-ray-debug
136 (.getChild debug-node n) (nth rays n) (nth touch-data n))))))
138 (defn touch-percieve [limit geom node]
139 (let [normals (normal-rays limit geom)]
141 (doall
142 (for [ray normals]
143 (do
144 (let [results (CollisionResults.)]
145 (.collideWith node ray results)
146 (let [touch-objects (set (filter #(not (= geom %))
147 (map #(.getGeometry %) results)))]
148 ;;(dorun (map #(println-repl (.getName %)) touch-objects))
149 (count touch-objects))))))))
151 (defn enable-debug [world]
152 (.enableDebug
153 (.getPhysicsSpace
154 (.getState
155 (.getStateManager world)
156 BulletAppState))
157 (asset-manager)))
159 (defn no-logging []
160 (.setLevel (Logger/getLogger "com.jme3") Level/OFF))
162 (defn set-accuracy [world new-accuracy]
163 (let [physics-manager (.getState (.getStateManager world) BulletAppState)]
164 (.setAccuracy (.getPhysicsSpace physics-manager) (float new-accuracy))))
166 (defn transparent-sphere []
167 (doto
168 (make-shape
169 (merge base-shape
170 {:position (Vector3f. 0 2 0)
171 :name "the blob."
172 :material "Common/MatDefs/Misc/Unshaded.j3md"
173 :texture "Textures/purpleWisp.png"
174 :physical? true
175 :mass 70
176 :color ColorRGBA/Blue
177 :shape (Sphere. 10 10 1)}))
178 (-> (.getMaterial)
179 (.getAdditionalRenderState)
180 (.setBlendMode RenderState$BlendMode/Alpha))
181 (.setQueueBucket RenderQueue$Bucket/Transparent)))
183 (defn transparent-box []
184 (doto
185 (make-shape
186 (merge base-shape
187 {:position (Vector3f. 0 2 0)
188 :name "box"
189 :material "Common/MatDefs/Misc/Unshaded.j3md"
190 :texture "Textures/purpleWisp.png"
191 :physical? true
192 :mass 70
193 :color ColorRGBA/Blue
194 :shape (Box. 1 1 1)}))
195 (-> (.getMaterial)
196 (.getAdditionalRenderState)
197 (.setBlendMode RenderState$BlendMode/Alpha))
198 (.setQueueBucket RenderQueue$Bucket/Transparent)))
200 (defn transparent-floor []
201 (doto
202 (box 5 0.2 5 :mass 0 :position (Vector3f. 0 -2 0)
203 :material "Common/MatDefs/Misc/Unshaded.j3md"
204 :texture "Textures/redWisp.png"
205 :name "floor")
206 (-> (.getMaterial)
207 (.getAdditionalRenderState)
208 (.setBlendMode RenderState$BlendMode/Alpha))
209 (.setQueueBucket RenderQueue$Bucket/Transparent)))
211 (defn test-skin []
212 (let [b
213 ;;(transparent-box)
214 (transparent-sphere)
215 ;;(sphere)
216 f (transparent-floor)
217 debug-node (Node.)
218 node (doto (Node.) (.attachChild b) (.attachChild f))
219 root-node (doto (Node.) (.attachChild node)
220 (.attachChild debug-node))
221 ]
223 (world
224 root-node
225 {"key-return" (fire-cannon-ball node)}
226 (fn [world]
227 ;; (Capture/SimpleCaptureVideo
228 ;; world
229 ;; (file-str "/home/r/proj/cortex/tmp/blob.avi"))
230 ;; (no-logging)
231 ;;(enable-debug world)
232 ;; (set-accuracy world (/ 1 60))
233 )
235 (fn [& _]
236 (let [sensitivity 0.2
237 touch-data (touch-percieve sensitivity b node)]
238 (manage-ray-debug-node debug-node b touch-data sensitivity)
239 )
240 (Thread/sleep 10)
241 ))))
243 #+end_src
245 #+results: skin-main
246 : #'body.skin/test-skin
255 * COMMENT code generation
256 #+begin_src clojure :tangle ../src/body/skin.clj :noweb yes
257 <<skin-main>>
258 #+end_src