1.1 --- /dev/null	Thu Jan 01 00:00:00 1970 +0000
     1.2 +++ b/org/world.org	Sun Oct 23 23:54:26 2011 -0700
     1.3 @@ -0,0 +1,308 @@
     1.4 +#+title: A world for the creatures to live
     1.5 +#+author: Robert McIntyre
     1.6 +#+email: rlm@mit.edu
     1.7 +#+description: Simulating senses for AI research using JMonkeyEngine3
     1.8 +#+SETUPFILE: ../../aurellem/org/setup.org
     1.9 +#+INCLUDE: ../../aurellem/org/level-0.org
    1.10 +#+babel: :mkdirp yes :noweb yes :exports both
    1.11 +
    1.12 +
    1.13 +
    1.14 +*** World
    1.15 +
    1.16 +It is comvienent to wrap the JME elements that deal with creating a
    1.17 +world, creation of basic objects, and Keyboard input with a nicer
    1.18 +interface (at least for my purposes).
    1.19 +
    1.20 +#+srcname: world-inputs
    1.21 +#+begin_src clojure :results silent
    1.22 +(ns cortex.world)
    1.23 +(require 'cortex.import)
    1.24 +(use 'clojure.contrib.def)
    1.25 +(rlm.rlm-commands/help)
    1.26 +(cortex.import/mega-import-jme3)
    1.27 +
    1.28 +(defvar *app-settings*
    1.29 +  (doto (AppSettings. true)
    1.30 +    (.setFullscreen false)
    1.31 +    (.setTitle "Aurellem.")
    1.32 +    ;; disable 32 bit stuff for now
    1.33 +    ;;(.setAudioRenderer "Send")
    1.34 +    )
    1.35 +  "These settings control how the game is displayed on the screen for
    1.36 +   debugging purposes.  Use binding forms to change this if desired.
    1.37 +   Full-screen mode does not work on some computers.")
    1.38 +
    1.39 +(defn asset-manager
    1.40 +  "returns a new, configured assetManager" []
    1.41 +  (JmeSystem/newAssetManager
    1.42 +   (.getResource
    1.43 +    (.getContextClassLoader (Thread/currentThread))
    1.44 +    "com/jme3/asset/Desktop.cfg")))
    1.45 +
    1.46 +(defmacro no-exceptions
    1.47 +  "Sweet relief like I never knew."
    1.48 +  [& forms]
    1.49 +  `(try ~@forms (catch Exception e# (.printStackTrace e#))))
    1.50 +
    1.51 +(defn thread-exception-removal []
    1.52 +  (println "removing exceptions from " (Thread/currentThread))
    1.53 +  (.setUncaughtExceptionHandler
    1.54 +   (Thread/currentThread)
    1.55 +   (proxy [Thread$UncaughtExceptionHandler] []
    1.56 +     (uncaughtException
    1.57 +      [thread thrown]
    1.58 +      (println "uncaught-exception thrown in " thread)
    1.59 +      (println (.getMessage thrown))))))
    1.60 +
    1.61 +(def println-repl (bound-fn [& args] (apply println args)))
    1.62 +
    1.63 +(use '[pokemon [lpsolve :only [constant-map]]])
    1.64 +
    1.65 +(defn no-op [& _])
    1.66 +
    1.67 +(defn all-keys
    1.68 +  "Construct a map of strings representing all the manual inputs from
    1.69 +   either the keyboard or mouse." 
    1.70 +  []
    1.71 +  (let [inputs (constant-map KeyInput)]
    1.72 +    (assoc
    1.73 +	(zipmap (map (fn [field]
    1.74 +		       (.toLowerCase (re-gsub #"_" "-" field))) (vals inputs))
    1.75 +		(map (fn [val] (KeyTrigger. val)) (keys inputs)))
    1.76 +      ;;explicitly add mouse controls
    1.77 +      "mouse-left" (MouseButtonTrigger. 0)
    1.78 +      "mouse-middle" (MouseButtonTrigger. 2)
    1.79 +      "mouse-right" (MouseButtonTrigger. 1))))
    1.80 +
    1.81 +(defn initialize-inputs
    1.82 +  "more java-interop cruft to establish keybindings for a particular virtual world"
    1.83 +  [game  input-manager key-map]
    1.84 +  (doall (map (fn [[name trigger]]
    1.85 +		(.addMapping ^InputManager input-manager
    1.86 +			     name (into-array (class trigger) [trigger]))) key-map))
    1.87 +  (doall (map (fn [name] 
    1.88 +		(.addListener ^InputManager input-manager game
    1.89 +			      (into-array String  [name]))) (keys key-map))))
    1.90 +
    1.91 +#+end_src
    1.92 +
    1.93 +These functions are all for debug controlling of the world through
    1.94 +keyboard and mouse. 
    1.95 +
    1.96 +We reuse  =constant-map= from =pokemon.lpsolve= to get the numerical
    1.97 +values for all the keys defined in the =KeyInput= class. The
    1.98 +documentation for =constant-map= is:
    1.99 +
   1.100 +#+begin_src clojure :results output
   1.101 +(doc pokemon.lpsolve/constant-map)
   1.102 +#+end_src
   1.103 +
   1.104 +#+results:
   1.105 +: -------------------------
   1.106 +: pokemon.lpsolve/constant-map
   1.107 +: ([class])
   1.108 +:   Takes a class and creates a map of the static constant integer
   1.109 +:   fields with their names.  This helps with C wrappers where they have
   1.110 +:   just defined a bunch of integer constants instead of enums
   1.111 +
   1.112 +
   1.113 +Then, =all-keys= converts the constant names like =KEY_J= to the more
   1.114 +clojure-like =key-j=, and returns a map from these keys to
   1.115 +jMonkeyEngine KeyTrigger objects, the use of which will soon become
   1.116 +apparent. =all-keys= also adds the three mouse button controls to the
   1.117 +map.
   1.118 +
   1.119 +#+srcname: world
   1.120 +#+begin_src clojure :results silent
   1.121 +(in-ns 'cortex.world)
   1.122 +
   1.123 +(defn traverse
   1.124 +  "apply f to every non-node, deeply"
   1.125 +  [f node]
   1.126 +  (if (isa? (class node) Node)
   1.127 +    (dorun (map (partial traverse f) (.getChildren node)))
   1.128 +    (f node)))
   1.129 +
   1.130 +(def gravity (Vector3f. 0 -9.81 0))
   1.131 +
   1.132 +(defn world
   1.133 +  [root-node key-map setup-fn update-fn]
   1.134 +  (let [physics-manager (BulletAppState.)
   1.135 +	shadow-renderer (BasicShadowRenderer. (asset-manager) (int 256))
   1.136 +	;;maybe use a better shadow renderer someday!
   1.137 +	;;shadow-renderer (PssmShadowRenderer. (asset-manager) 256 1)
   1.138 +	]   	
   1.139 +  (doto
   1.140 +      (proxy [SimpleApplication ActionListener] []
   1.141 +	(simpleInitApp
   1.142 +	 []
   1.143 +	 (no-exceptions
   1.144 +	  (.setTimer this (IsoTimer. 60))
   1.145 +	  ;; Create key-map.
   1.146 +	  (.setFrustumFar (.getCamera this) 300)
   1.147 +	  (initialize-inputs this (.getInputManager this) (all-keys))
   1.148 +	  ;; Don't take control of the mouse
   1.149 +	  (org.lwjgl.input.Mouse/setGrabbed false)
   1.150 +	  ;; add all objects to the world
   1.151 +	  (.attachChild (.getRootNode this) root-node)
   1.152 +	  ;; enable physics
   1.153 +	  ;; add a physics manager
   1.154 +	  (.attach (.getStateManager this) physics-manager)
   1.155 +	  (.setGravity (.getPhysicsSpace physics-manager) gravity)
   1.156 +
   1.157 +
   1.158 +	  ;; go through every object and add it to the physics manager
   1.159 +	  ;; if relavant.
   1.160 +	   (traverse (fn [geom]
   1.161 +		       (dorun
   1.162 +			(for [n (range (.getNumControls geom))]
   1.163 +			  (do
   1.164 +			    (println-repl "adding control " (.getControl geom n))
   1.165 +			    (.add (.getPhysicsSpace physics-manager)
   1.166 +				  (.getControl geom n))))))
   1.167 +		     (.getRootNode this))
   1.168 +	  ;;(.addAll (.getPhysicsSpace physics-manager) (.getRootNode this))
   1.169 +
   1.170 +	  (setup-fn this)
   1.171 +	  (.setDirection shadow-renderer
   1.172 +			 (.normalizeLocal (Vector3f. -1 -1 -1)))
   1.173 +	  (.addProcessor (.getViewPort this) shadow-renderer)
   1.174 +	  (.setShadowMode (.getRootNode this) RenderQueue$ShadowMode/Off)
   1.175 +	  ))
   1.176 +	(simpleUpdate
   1.177 +	 [tpf]
   1.178 +	 (no-exceptions
   1.179 +	  (update-fn this tpf))) 
   1.180 +	(onAction
   1.181 +	 [binding value tpf]
   1.182 +	 ;; whenever a key is pressed, call the function returned from
   1.183 +	 ;; key-map.
   1.184 +	 (no-exceptions
   1.185 +	  (if-let [react (key-map binding)]
   1.186 +	    (react this value)))))
   1.187 +    ;; don't show a menu to change options.
   1.188 +    
   1.189 +    (.setShowSettings false)
   1.190 +    (.setPauseOnLostFocus false)
   1.191 +    (.setSettings *app-settings*))))
   1.192 +
   1.193 +(defn apply-map
   1.194 +  "Like apply, but works for maps and functions that expect an implicit map
   1.195 +   and nothing else as in (fn [& {}]).
   1.196 +------- Example -------
   1.197 + (defn jjj [& {:keys [www] :or {www \"oh yeah\"} :as env}] (println www))
   1.198 + (apply-map jjj {:www \"whatever\"})
   1.199 +  -->\"whatever\""
   1.200 +  [fn m]
   1.201 +  (apply fn (reduce #(into %1 %2) [] m)))
   1.202 +
   1.203 +#+end_src 
   1.204 +
   1.205 +
   1.206 +=world= is the most important function here.  
   1.207 +***  TODO more documentation
   1.208 +
   1.209 +#+srcname: world-shapes
   1.210 +#+begin_src clojure :results silent
   1.211 +(in-ns 'cortex.world)
   1.212 +(defrecord shape-description
   1.213 +  [name
   1.214 +   color
   1.215 +   mass
   1.216 +   friction
   1.217 +   texture
   1.218 +   material
   1.219 +   position
   1.220 +   rotation
   1.221 +   shape
   1.222 +   physical?])
   1.223 +
   1.224 +(def base-shape
   1.225 +     (shape-description.
   1.226 +      "default-shape"
   1.227 +      false
   1.228 +      ;;ColorRGBA/Blue
   1.229 +      1.0 ;; mass
   1.230 +      1.0 ;; friction
   1.231 +      ;; texture
   1.232 +      "Textures/Terrain/BrickWall/BrickWall.jpg"
   1.233 +      ;; material
   1.234 +      "Common/MatDefs/Misc/Unshaded.j3md"
   1.235 +      Vector3f/ZERO
   1.236 +      Quaternion/IDENTITY
   1.237 +      (Box. Vector3f/ZERO 0.5 0.5 0.5)
   1.238 +      true))
   1.239 +
   1.240 +(defn make-shape
   1.241 +  [#^shape-description d]
   1.242 +  (let [asset-manager (if (:asset-manager d) (:asset-manager d) (asset-manager))
   1.243 +        mat (Material. asset-manager (:material d))
   1.244 +	geom (Geometry. (:name d) (:shape d))]
   1.245 +    (if (:texture d)
   1.246 +      (let [key (TextureKey. (:texture d))]
   1.247 +	(.setGenerateMips key true)
   1.248 +	(.setTexture mat "ColorMap" (.loadTexture asset-manager key))))
   1.249 +    (if (:color d) (.setColor mat "Color" (:color d)))
   1.250 +    (.setMaterial geom mat)
   1.251 +    (if-let [rotation (:rotation d)] (.rotate geom rotation))
   1.252 +    (.setLocalTranslation geom (:position d))
   1.253 +    (if (:physical? d)
   1.254 +      (let [impact-shape (doto (GImpactCollisionShape. 
   1.255 +                                (.getMesh geom)) (.setMargin 0))
   1.256 +	    physics-control (RigidBodyControl.
   1.257 +			     ;;impact-shape ;; comment to disable 
   1.258 +			     (float (:mass d)))]
   1.259 +	(.createJmeMesh impact-shape)
   1.260 +	(.addControl geom physics-control)
   1.261 +	;;(.setSleepingThresholds physics-control (float 0) (float 0))
   1.262 +	(.setFriction physics-control (:friction d))))
   1.263 +    ;;the default is to keep this node in the physics engine forever.
   1.264 +    ;;these commands must come after the control is added to the geometry.
   1.265 +    ;;
   1.266 +    geom))
   1.267 +  
   1.268 +(defn box
   1.269 +  ([l w h & {:as options}]
   1.270 +     (let [options (merge base-shape options)]
   1.271 +       (make-shape (assoc options
   1.272 +		     :shape (Box. l w h)))))
   1.273 +  ([] (box 0.5 0.5 0.5)))
   1.274 +
   1.275 +(defn sphere
   1.276 +  ([r & {:as options}]
   1.277 +     (let [options (merge base-shape options)]
   1.278 +       (make-shape (assoc options
   1.279 +		     :shape (Sphere. 32 32 (float r)))))) 
   1.280 +  ([] (sphere 0.5)))
   1.281 +
   1.282 +(defn add-element
   1.283 +  ([game element node]
   1.284 +  (.addAll
   1.285 +   (.getPhysicsSpace
   1.286 +    (.getState
   1.287 +     (.getStateManager game)
   1.288 +     BulletAppState))
   1.289 +    element)
   1.290 +  (.attachChild node element))
   1.291 +  ([game element]
   1.292 +     (add-element game element (.getRootNode game))))
   1.293 +
   1.294 +
   1.295 +(defn set-gravity*
   1.296 +  [game gravity]
   1.297 +  (traverse
   1.298 +   (fn [geom]
   1.299 +     (if-let
   1.300 +	 [control (.getControl geom RigidBodyControl)]
   1.301 +       (do
   1.302 +	 (.setGravity control gravity)
   1.303 +	 (.applyImpulse control Vector3f/ZERO Vector3f/ZERO)
   1.304 +	 )))
   1.305 +   (.getRootNode game)))
   1.306 +
   1.307 +#+end_src
   1.308 +
   1.309 +These are convienence functions for creating JME objects and
   1.310 +manipulating a world.
   1.311 +