Mercurial > cortex

annotate org/world.org @ 23:cab2da252494

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