view org/skin.org @ 32:97703c7f020e

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