view org/world.org @ 23:cab2da252494

split off the rest of cortex.org
author Robert McIntyre <rlm@mit.edu>
date Sun, 23 Oct 2011 23:54:26 -0700
parents
children e965675ec4d0
line wrap: on
line source
1 #+title: A world for the creatures to live
2 #+author: Robert McIntyre
3 #+email: rlm@mit.edu
4 #+description: Simulating senses for AI research using JMonkeyEngine3
5 #+SETUPFILE: ../../aurellem/org/setup.org
6 #+INCLUDE: ../../aurellem/org/level-0.org
7 #+babel: :mkdirp yes :noweb yes :exports both
11 *** World
13 It is comvienent to wrap the JME elements that deal with creating a
14 world, creation of basic objects, and Keyboard input with a nicer
15 interface (at least for my purposes).
17 #+srcname: world-inputs
18 #+begin_src clojure :results silent
19 (ns cortex.world)
20 (require 'cortex.import)
21 (use 'clojure.contrib.def)
22 (rlm.rlm-commands/help)
23 (cortex.import/mega-import-jme3)
25 (defvar *app-settings*
26 (doto (AppSettings. true)
27 (.setFullscreen false)
28 (.setTitle "Aurellem.")
29 ;; disable 32 bit stuff for now
30 ;;(.setAudioRenderer "Send")
31 )
32 "These settings control how the game is displayed on the screen for
33 debugging purposes. Use binding forms to change this if desired.
34 Full-screen mode does not work on some computers.")
36 (defn asset-manager
37 "returns a new, configured assetManager" []
38 (JmeSystem/newAssetManager
39 (.getResource
40 (.getContextClassLoader (Thread/currentThread))
41 "com/jme3/asset/Desktop.cfg")))
43 (defmacro no-exceptions
44 "Sweet relief like I never knew."
45 [& forms]
46 `(try ~@forms (catch Exception e# (.printStackTrace e#))))
48 (defn thread-exception-removal []
49 (println "removing exceptions from " (Thread/currentThread))
50 (.setUncaughtExceptionHandler
51 (Thread/currentThread)
52 (proxy [Thread$UncaughtExceptionHandler] []
53 (uncaughtException
54 [thread thrown]
55 (println "uncaught-exception thrown in " thread)
56 (println (.getMessage thrown))))))
58 (def println-repl (bound-fn [& args] (apply println args)))
60 (use '[pokemon [lpsolve :only [constant-map]]])
62 (defn no-op [& _])
64 (defn all-keys
65 "Construct a map of strings representing all the manual inputs from
66 either the keyboard or mouse."
67 []
68 (let [inputs (constant-map KeyInput)]
69 (assoc
70 (zipmap (map (fn [field]
71 (.toLowerCase (re-gsub #"_" "-" field))) (vals inputs))
72 (map (fn [val] (KeyTrigger. val)) (keys inputs)))
73 ;;explicitly add mouse controls
74 "mouse-left" (MouseButtonTrigger. 0)
75 "mouse-middle" (MouseButtonTrigger. 2)
76 "mouse-right" (MouseButtonTrigger. 1))))
78 (defn initialize-inputs
79 "more java-interop cruft to establish keybindings for a particular virtual world"
80 [game input-manager key-map]
81 (doall (map (fn [[name trigger]]
82 (.addMapping ^InputManager input-manager
83 name (into-array (class trigger) [trigger]))) key-map))
84 (doall (map (fn [name]
85 (.addListener ^InputManager input-manager game
86 (into-array String [name]))) (keys key-map))))
88 #+end_src
90 These functions are all for debug controlling of the world through
91 keyboard and mouse.
93 We reuse =constant-map= from =pokemon.lpsolve= to get the numerical
94 values for all the keys defined in the =KeyInput= class. The
95 documentation for =constant-map= is:
97 #+begin_src clojure :results output
98 (doc pokemon.lpsolve/constant-map)
99 #+end_src
101 #+results:
102 : -------------------------
103 : pokemon.lpsolve/constant-map
104 : ([class])
105 : Takes a class and creates a map of the static constant integer
106 : fields with their names. This helps with C wrappers where they have
107 : just defined a bunch of integer constants instead of enums
110 Then, =all-keys= converts the constant names like =KEY_J= to the more
111 clojure-like =key-j=, and returns a map from these keys to
112 jMonkeyEngine KeyTrigger objects, the use of which will soon become
113 apparent. =all-keys= also adds the three mouse button controls to the
114 map.
116 #+srcname: world
117 #+begin_src clojure :results silent
118 (in-ns 'cortex.world)
120 (defn traverse
121 "apply f to every non-node, deeply"
122 [f node]
123 (if (isa? (class node) Node)
124 (dorun (map (partial traverse f) (.getChildren node)))
125 (f node)))
127 (def gravity (Vector3f. 0 -9.81 0))
129 (defn world
130 [root-node key-map setup-fn update-fn]
131 (let [physics-manager (BulletAppState.)
132 shadow-renderer (BasicShadowRenderer. (asset-manager) (int 256))
133 ;;maybe use a better shadow renderer someday!
134 ;;shadow-renderer (PssmShadowRenderer. (asset-manager) 256 1)
135 ]
136 (doto
137 (proxy [SimpleApplication ActionListener] []
138 (simpleInitApp
139 []
140 (no-exceptions
141 (.setTimer this (IsoTimer. 60))
142 ;; Create key-map.
143 (.setFrustumFar (.getCamera this) 300)
144 (initialize-inputs this (.getInputManager this) (all-keys))
145 ;; Don't take control of the mouse
146 (org.lwjgl.input.Mouse/setGrabbed false)
147 ;; add all objects to the world
148 (.attachChild (.getRootNode this) root-node)
149 ;; enable physics
150 ;; add a physics manager
151 (.attach (.getStateManager this) physics-manager)
152 (.setGravity (.getPhysicsSpace physics-manager) gravity)
155 ;; go through every object and add it to the physics manager
156 ;; if relavant.
157 (traverse (fn [geom]
158 (dorun
159 (for [n (range (.getNumControls geom))]
160 (do
161 (println-repl "adding control " (.getControl geom n))
162 (.add (.getPhysicsSpace physics-manager)
163 (.getControl geom n))))))
164 (.getRootNode this))
165 ;;(.addAll (.getPhysicsSpace physics-manager) (.getRootNode this))
167 (setup-fn this)
168 (.setDirection shadow-renderer
169 (.normalizeLocal (Vector3f. -1 -1 -1)))
170 (.addProcessor (.getViewPort this) shadow-renderer)
171 (.setShadowMode (.getRootNode this) RenderQueue$ShadowMode/Off)
172 ))
173 (simpleUpdate
174 [tpf]
175 (no-exceptions
176 (update-fn this tpf)))
177 (onAction
178 [binding value tpf]
179 ;; whenever a key is pressed, call the function returned from
180 ;; key-map.
181 (no-exceptions
182 (if-let [react (key-map binding)]
183 (react this value)))))
184 ;; don't show a menu to change options.
186 (.setShowSettings false)
187 (.setPauseOnLostFocus false)
188 (.setSettings *app-settings*))))
190 (defn apply-map
191 "Like apply, but works for maps and functions that expect an implicit map
192 and nothing else as in (fn [& {}]).
193 ------- Example -------
194 (defn jjj [& {:keys [www] :or {www \"oh yeah\"} :as env}] (println www))
195 (apply-map jjj {:www \"whatever\"})
196 -->\"whatever\""
197 [fn m]
198 (apply fn (reduce #(into %1 %2) [] m)))
200 #+end_src
203 =world= is the most important function here.
204 *** TODO more documentation
206 #+srcname: world-shapes
207 #+begin_src clojure :results silent
208 (in-ns 'cortex.world)
209 (defrecord shape-description
210 [name
211 color
212 mass
213 friction
214 texture
215 material
216 position
217 rotation
218 shape
219 physical?])
221 (def base-shape
222 (shape-description.
223 "default-shape"
224 false
225 ;;ColorRGBA/Blue
226 1.0 ;; mass
227 1.0 ;; friction
228 ;; texture
229 "Textures/Terrain/BrickWall/BrickWall.jpg"
230 ;; material
231 "Common/MatDefs/Misc/Unshaded.j3md"
232 Vector3f/ZERO
233 Quaternion/IDENTITY
234 (Box. Vector3f/ZERO 0.5 0.5 0.5)
235 true))
237 (defn make-shape
238 [#^shape-description d]
239 (let [asset-manager (if (:asset-manager d) (:asset-manager d) (asset-manager))
240 mat (Material. asset-manager (:material d))
241 geom (Geometry. (:name d) (:shape d))]
242 (if (:texture d)
243 (let [key (TextureKey. (:texture d))]
244 (.setGenerateMips key true)
245 (.setTexture mat "ColorMap" (.loadTexture asset-manager key))))
246 (if (:color d) (.setColor mat "Color" (:color d)))
247 (.setMaterial geom mat)
248 (if-let [rotation (:rotation d)] (.rotate geom rotation))
249 (.setLocalTranslation geom (:position d))
250 (if (:physical? d)
251 (let [impact-shape (doto (GImpactCollisionShape.
252 (.getMesh geom)) (.setMargin 0))
253 physics-control (RigidBodyControl.
254 ;;impact-shape ;; comment to disable
255 (float (:mass d)))]
256 (.createJmeMesh impact-shape)
257 (.addControl geom physics-control)
258 ;;(.setSleepingThresholds physics-control (float 0) (float 0))
259 (.setFriction physics-control (:friction d))))
260 ;;the default is to keep this node in the physics engine forever.
261 ;;these commands must come after the control is added to the geometry.
262 ;;
263 geom))
265 (defn box
266 ([l w h & {:as options}]
267 (let [options (merge base-shape options)]
268 (make-shape (assoc options
269 :shape (Box. l w h)))))
270 ([] (box 0.5 0.5 0.5)))
272 (defn sphere
273 ([r & {:as options}]
274 (let [options (merge base-shape options)]
275 (make-shape (assoc options
276 :shape (Sphere. 32 32 (float r))))))
277 ([] (sphere 0.5)))
279 (defn add-element
280 ([game element node]
281 (.addAll
282 (.getPhysicsSpace
283 (.getState
284 (.getStateManager game)
285 BulletAppState))
286 element)
287 (.attachChild node element))
288 ([game element]
289 (add-element game element (.getRootNode game))))
292 (defn set-gravity*
293 [game gravity]
294 (traverse
295 (fn [geom]
296 (if-let
297 [control (.getControl geom RigidBodyControl)]
298 (do
299 (.setGravity control gravity)
300 (.applyImpulse control Vector3f/ZERO Vector3f/ZERO)
301 )))
302 (.getRootNode game)))
304 #+end_src
306 These are convienence functions for creating JME objects and
307 manipulating a world.