view org/skin.org @ 16:d2e9f0d09475

remove useless function
author Robert McIntyre <rlm@mit.edu>
date Sun, 23 Oct 2011 11:51:15 -0700
parents c32f3eb9fdeb
children 014b14d48092
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))))
113 (defn update-ray-debug [node ray contacts]
114 (let [origin (.getChild node 0)]
115 (.setLocalTranslation origin (.getOrigin ray))
116 (.setColor (.getMaterial origin) "Color" (contact-color contacts))))
118 (defn init-node
119 [debug-node rays]
120 (println-repl "Init touch debug node.")
121 (.detachAllChildren debug-node)
122 (dorun
123 (for [ray rays]
124 (do
125 (.attachChild
126 debug-node
127 (doto (Node.)
128 (.attachChild (ray-origin-debug ray ColorRGBA/Gray))
129 ;;(.attachChild (ray-debug ray ColorRGBA/Gray))
130 ))))))
132 (defn manage-ray-debug-node [debug-node geom touch-data limit]
133 (let [rays (normal-rays limit geom)]
134 (if (not= (count (.getChildren debug-node)) (count touch-data))
135 (init-node debug-node rays))
136 (dorun
137 (for [n (range (count touch-data))]
138 (update-ray-debug
139 (.getChild debug-node n) (nth rays n) (nth touch-data n))))))
141 (defn touch-percieve [limit geom node]
142 (let [normals (normal-rays limit geom)]
144 (doall
145 (for [ray normals]
146 (do
147 (let [results (CollisionResults.)]
148 (.collideWith node ray results)
149 (let [answer (count (filter #(not (= geom (.getGeometry %))) results))
150 ;;color (contact-color answer)
151 ]
152 ;;(dorun (map #(println-repl (.getName (.getGeometry %))) results))
153 answer )))))))
155 (defn enable-debug [world]
156 (.enableDebug
157 (.getPhysicsSpace
158 (.getState
159 (.getStateManager world)
160 BulletAppState))
161 (asset-manager)))
163 (defn no-logging []
164 (.setLevel (Logger/getLogger "com.jme3") Level/OFF))
166 (defn set-accuracy [world new-accuracy]
167 (let [physics-manager (.getState (.getStateManager world) BulletAppState)]
168 (.setAccuracy (.getPhysicsSpace physics-manager) (float new-accuracy))))
171 (defn transparent-sphere []
172 (doto
173 (make-shape
174 (merge base-shape
175 {:position (Vector3f. 0 2 0)
176 :name "the blob."
177 :material "Common/MatDefs/Misc/Unshaded.j3md"
178 :texture "Textures/purpleWisp.png"
179 :physical? true
180 :mass 70
181 :color ColorRGBA/Blue
182 :shape (Sphere. 10 10 1)}))
183 (-> (.getMaterial)
184 (.getAdditionalRenderState)
185 (.setBlendMode RenderState$BlendMode/Alpha))
186 (.setQueueBucket RenderQueue$Bucket/Transparent)))
188 (defn transparent-box []
189 (doto
190 (make-shape
191 (merge base-shape
192 {:position (Vector3f. 0 2 0)
193 :name "box"
194 :material "Common/MatDefs/Misc/Unshaded.j3md"
195 :texture "Textures/purpleWisp.png"
196 :physical? true
197 :mass 70
198 :color ColorRGBA/Blue
199 :shape (Box. 1 1 1)}))
200 (-> (.getMaterial)
201 (.getAdditionalRenderState)
202 (.setBlendMode RenderState$BlendMode/Alpha))
203 (.setQueueBucket RenderQueue$Bucket/Transparent)))
205 (defn transparent-floor []
206 (doto
207 (box 5 0.2 5 :mass 0 :position (Vector3f. 0 -2 0)
208 :material "Common/MatDefs/Misc/Unshaded.j3md"
209 :texture "Textures/redWisp.png"
210 :name "floor")
211 (-> (.getMaterial)
212 (.getAdditionalRenderState)
213 (.setBlendMode RenderState$BlendMode/Alpha))
214 (.setQueueBucket RenderQueue$Bucket/Transparent)))
216 (defn test-skin []
217 (let [b
218 ;;(transparent-box)
219 (transparent-sphere)
220 ;;(sphere)
221 f (transparent-floor)
222 ;;controls
223 ;;(make-touch-sphere b)
224 ;;(make-touch b)
225 debug-node (Node.)
226 node (doto (Node.) (.attachChild b) (.attachChild f))
227 root-node (doto (Node.) (.attachChild node)
228 (.attachChild debug-node))
229 ]
231 (world
232 root-node
233 {"key-return" (fire-cannon-ball node)}
234 ;;no-op
235 (fn [world]
236 ;; (Capture/SimpleCaptureVideo
237 ;; world
238 ;; (file-str "/home/r/proj/cortex/tmp/blob.avi"))
239 ;; (no-logging)
240 (enable-debug world)
241 ;; (set-accuracy world (/ 1 60))
242 )
244 (fn [& _]
245 (let [touch-data (touch-percieve 0.2 b node)]
246 ;;(println-repl touch-data)
247 (manage-ray-debug-node debug-node b touch-data 0.2))
248 (Thread/sleep 10)
249 ;;(touch-print controls)
250 ;;(color-touch controls)
251 ))))
253 #+end_src
255 #+results: skin-main
256 : #'body.skin/test-skin
265 * COMMENT code generation
266 #+begin_src clojure :tangle ../src/body/skin.clj :noweb yes
267 <<skin-main>>
268 #+end_src