rlm@23: #+title: A world for the creatures to live
rlm@23: #+author: Robert McIntyre
rlm@23: #+email: rlm@mit.edu
rlm@23: #+description: Simulating senses for AI research using JMonkeyEngine3
rlm@23: #+SETUPFILE: ../../aurellem/org/setup.org
rlm@23: #+INCLUDE: ../../aurellem/org/level-0.org
rlm@23: #+babel: :mkdirp yes :noweb yes :exports both
rlm@23: 
rlm@23: 
rlm@23: 
rlm@23: *** World
rlm@23: 
rlm@23: It is comvienent to wrap the JME elements that deal with creating a
rlm@23: world, creation of basic objects, and Keyboard input with a nicer
rlm@23: interface (at least for my purposes).
rlm@23: 
rlm@23: #+srcname: world-inputs
rlm@23: #+begin_src clojure :results silent
rlm@23: (ns cortex.world)
rlm@23: (require 'cortex.import)
rlm@23: (use 'clojure.contrib.def)
rlm@23: (rlm.rlm-commands/help)
rlm@23: (cortex.import/mega-import-jme3)
rlm@23: 
rlm@23: (defvar *app-settings*
rlm@23:   (doto (AppSettings. true)
rlm@23:     (.setFullscreen false)
rlm@23:     (.setTitle "Aurellem.")
rlm@23:     ;; disable 32 bit stuff for now
rlm@23:     ;;(.setAudioRenderer "Send")
rlm@23:     )
rlm@23:   "These settings control how the game is displayed on the screen for
rlm@23:    debugging purposes.  Use binding forms to change this if desired.
rlm@23:    Full-screen mode does not work on some computers.")
rlm@23: 
rlm@23: (defn asset-manager
rlm@23:   "returns a new, configured assetManager" []
rlm@23:   (JmeSystem/newAssetManager
rlm@23:    (.getResource
rlm@23:     (.getContextClassLoader (Thread/currentThread))
rlm@23:     "com/jme3/asset/Desktop.cfg")))
rlm@23: 
rlm@23: (defmacro no-exceptions
rlm@23:   "Sweet relief like I never knew."
rlm@23:   [& forms]
rlm@23:   `(try ~@forms (catch Exception e# (.printStackTrace e#))))
rlm@23: 
rlm@23: (defn thread-exception-removal []
rlm@23:   (println "removing exceptions from " (Thread/currentThread))
rlm@23:   (.setUncaughtExceptionHandler
rlm@23:    (Thread/currentThread)
rlm@23:    (proxy [Thread$UncaughtExceptionHandler] []
rlm@23:      (uncaughtException
rlm@23:       [thread thrown]
rlm@23:       (println "uncaught-exception thrown in " thread)
rlm@23:       (println (.getMessage thrown))))))
rlm@23: 
rlm@23: (def println-repl (bound-fn [& args] (apply println args)))
rlm@23: 
rlm@23: (use '[pokemon [lpsolve :only [constant-map]]])
rlm@23: 
rlm@23: (defn no-op [& _])
rlm@23: 
rlm@23: (defn all-keys
rlm@23:   "Construct a map of strings representing all the manual inputs from
rlm@23:    either the keyboard or mouse." 
rlm@23:   []
rlm@23:   (let [inputs (constant-map KeyInput)]
rlm@23:     (assoc
rlm@23: 	(zipmap (map (fn [field]
rlm@23: 		       (.toLowerCase (re-gsub #"_" "-" field))) (vals inputs))
rlm@23: 		(map (fn [val] (KeyTrigger. val)) (keys inputs)))
rlm@23:       ;;explicitly add mouse controls
rlm@23:       "mouse-left" (MouseButtonTrigger. 0)
rlm@23:       "mouse-middle" (MouseButtonTrigger. 2)
rlm@23:       "mouse-right" (MouseButtonTrigger. 1))))
rlm@23: 
rlm@23: (defn initialize-inputs
rlm@23:   "more java-interop cruft to establish keybindings for a particular virtual world"
rlm@23:   [game  input-manager key-map]
rlm@23:   (doall (map (fn [[name trigger]]
rlm@23: 		(.addMapping ^InputManager input-manager
rlm@23: 			     name (into-array (class trigger) [trigger]))) key-map))
rlm@23:   (doall (map (fn [name] 
rlm@23: 		(.addListener ^InputManager input-manager game
rlm@23: 			      (into-array String  [name]))) (keys key-map))))
rlm@23: 
rlm@23: #+end_src
rlm@23: 
rlm@23: These functions are all for debug controlling of the world through
rlm@23: keyboard and mouse. 
rlm@23: 
rlm@23: We reuse  =constant-map= from =pokemon.lpsolve= to get the numerical
rlm@23: values for all the keys defined in the =KeyInput= class. The
rlm@23: documentation for =constant-map= is:
rlm@23: 
rlm@23: #+begin_src clojure :results output
rlm@23: (doc pokemon.lpsolve/constant-map)
rlm@23: #+end_src
rlm@23: 
rlm@23: #+results:
rlm@23: : -------------------------
rlm@23: : pokemon.lpsolve/constant-map
rlm@23: : ([class])
rlm@23: :   Takes a class and creates a map of the static constant integer
rlm@23: :   fields with their names.  This helps with C wrappers where they have
rlm@23: :   just defined a bunch of integer constants instead of enums
rlm@23: 
rlm@23: 
rlm@23: Then, =all-keys= converts the constant names like =KEY_J= to the more
rlm@23: clojure-like =key-j=, and returns a map from these keys to
rlm@23: jMonkeyEngine KeyTrigger objects, the use of which will soon become
rlm@23: apparent. =all-keys= also adds the three mouse button controls to the
rlm@23: map.
rlm@23: 
rlm@23: #+srcname: world
rlm@23: #+begin_src clojure :results silent
rlm@23: (in-ns 'cortex.world)
rlm@23: 
rlm@23: (defn traverse
rlm@23:   "apply f to every non-node, deeply"
rlm@23:   [f node]
rlm@23:   (if (isa? (class node) Node)
rlm@23:     (dorun (map (partial traverse f) (.getChildren node)))
rlm@23:     (f node)))
rlm@23: 
rlm@23: (def gravity (Vector3f. 0 -9.81 0))
rlm@23: 
rlm@23: (defn world
rlm@23:   [root-node key-map setup-fn update-fn]
rlm@23:   (let [physics-manager (BulletAppState.)
rlm@23: 	shadow-renderer (BasicShadowRenderer. (asset-manager) (int 256))
rlm@23: 	;;maybe use a better shadow renderer someday!
rlm@23: 	;;shadow-renderer (PssmShadowRenderer. (asset-manager) 256 1)
rlm@23: 	]   	
rlm@23:   (doto
rlm@23:       (proxy [SimpleApplication ActionListener] []
rlm@23: 	(simpleInitApp
rlm@23: 	 []
rlm@23: 	 (no-exceptions
rlm@23: 	  (.setTimer this (IsoTimer. 60))
rlm@23: 	  ;; Create key-map.
rlm@23: 	  (.setFrustumFar (.getCamera this) 300)
rlm@23: 	  (initialize-inputs this (.getInputManager this) (all-keys))
rlm@23: 	  ;; Don't take control of the mouse
rlm@23: 	  (org.lwjgl.input.Mouse/setGrabbed false)
rlm@23: 	  ;; add all objects to the world
rlm@23: 	  (.attachChild (.getRootNode this) root-node)
rlm@23: 	  ;; enable physics
rlm@23: 	  ;; add a physics manager
rlm@23: 	  (.attach (.getStateManager this) physics-manager)
rlm@23: 	  (.setGravity (.getPhysicsSpace physics-manager) gravity)
rlm@23: 
rlm@23: 
rlm@23: 	  ;; go through every object and add it to the physics manager
rlm@23: 	  ;; if relavant.
rlm@23: 	   (traverse (fn [geom]
rlm@23: 		       (dorun
rlm@23: 			(for [n (range (.getNumControls geom))]
rlm@23: 			  (do
rlm@23: 			    (println-repl "adding control " (.getControl geom n))
rlm@23: 			    (.add (.getPhysicsSpace physics-manager)
rlm@23: 				  (.getControl geom n))))))
rlm@23: 		     (.getRootNode this))
rlm@23: 	  ;;(.addAll (.getPhysicsSpace physics-manager) (.getRootNode this))
rlm@23: 
rlm@23: 	  (setup-fn this)
rlm@23: 	  (.setDirection shadow-renderer
rlm@23: 			 (.normalizeLocal (Vector3f. -1 -1 -1)))
rlm@23: 	  (.addProcessor (.getViewPort this) shadow-renderer)
rlm@23: 	  (.setShadowMode (.getRootNode this) RenderQueue$ShadowMode/Off)
rlm@23: 	  ))
rlm@23: 	(simpleUpdate
rlm@23: 	 [tpf]
rlm@23: 	 (no-exceptions
rlm@23: 	  (update-fn this tpf))) 
rlm@23: 	(onAction
rlm@23: 	 [binding value tpf]
rlm@23: 	 ;; whenever a key is pressed, call the function returned from
rlm@23: 	 ;; key-map.
rlm@23: 	 (no-exceptions
rlm@23: 	  (if-let [react (key-map binding)]
rlm@23: 	    (react this value)))))
rlm@23:     ;; don't show a menu to change options.
rlm@23:     
rlm@23:     (.setShowSettings false)
rlm@23:     (.setPauseOnLostFocus false)
rlm@23:     (.setSettings *app-settings*))))
rlm@23: 
rlm@23: (defn apply-map
rlm@23:   "Like apply, but works for maps and functions that expect an implicit map
rlm@23:    and nothing else as in (fn [& {}]).
rlm@23: ------- Example -------
rlm@23:  (defn jjj [& {:keys [www] :or {www \"oh yeah\"} :as env}] (println www))
rlm@23:  (apply-map jjj {:www \"whatever\"})
rlm@23:   -->\"whatever\""
rlm@23:   [fn m]
rlm@23:   (apply fn (reduce #(into %1 %2) [] m)))
rlm@23: 
rlm@23: #+end_src 
rlm@23: 
rlm@23: 
rlm@23: =world= is the most important function here.  
rlm@23: ***  TODO more documentation
rlm@23: 
rlm@23: #+srcname: world-shapes
rlm@23: #+begin_src clojure :results silent
rlm@23: (in-ns 'cortex.world)
rlm@23: (defrecord shape-description
rlm@23:   [name
rlm@23:    color
rlm@23:    mass
rlm@23:    friction
rlm@23:    texture
rlm@23:    material
rlm@23:    position
rlm@23:    rotation
rlm@23:    shape
rlm@23:    physical?])
rlm@23: 
rlm@23: (def base-shape
rlm@23:      (shape-description.
rlm@23:       "default-shape"
rlm@23:       false
rlm@23:       ;;ColorRGBA/Blue
rlm@23:       1.0 ;; mass
rlm@23:       1.0 ;; friction
rlm@23:       ;; texture
rlm@23:       "Textures/Terrain/BrickWall/BrickWall.jpg"
rlm@23:       ;; material
rlm@23:       "Common/MatDefs/Misc/Unshaded.j3md"
rlm@23:       Vector3f/ZERO
rlm@23:       Quaternion/IDENTITY
rlm@23:       (Box. Vector3f/ZERO 0.5 0.5 0.5)
rlm@23:       true))
rlm@23: 
rlm@23: (defn make-shape
rlm@23:   [#^shape-description d]
rlm@23:   (let [asset-manager (if (:asset-manager d) (:asset-manager d) (asset-manager))
rlm@23:         mat (Material. asset-manager (:material d))
rlm@23: 	geom (Geometry. (:name d) (:shape d))]
rlm@23:     (if (:texture d)
rlm@23:       (let [key (TextureKey. (:texture d))]
rlm@23: 	(.setGenerateMips key true)
rlm@23: 	(.setTexture mat "ColorMap" (.loadTexture asset-manager key))))
rlm@23:     (if (:color d) (.setColor mat "Color" (:color d)))
rlm@23:     (.setMaterial geom mat)
rlm@23:     (if-let [rotation (:rotation d)] (.rotate geom rotation))
rlm@23:     (.setLocalTranslation geom (:position d))
rlm@23:     (if (:physical? d)
rlm@23:       (let [impact-shape (doto (GImpactCollisionShape. 
rlm@23:                                 (.getMesh geom)) (.setMargin 0))
rlm@23: 	    physics-control (RigidBodyControl.
rlm@23: 			     ;;impact-shape ;; comment to disable 
rlm@23: 			     (float (:mass d)))]
rlm@23: 	(.createJmeMesh impact-shape)
rlm@23: 	(.addControl geom physics-control)
rlm@23: 	;;(.setSleepingThresholds physics-control (float 0) (float 0))
rlm@23: 	(.setFriction physics-control (:friction d))))
rlm@23:     ;;the default is to keep this node in the physics engine forever.
rlm@23:     ;;these commands must come after the control is added to the geometry.
rlm@23:     ;;
rlm@23:     geom))
rlm@23:   
rlm@23: (defn box
rlm@23:   ([l w h & {:as options}]
rlm@23:      (let [options (merge base-shape options)]
rlm@23:        (make-shape (assoc options
rlm@23: 		     :shape (Box. l w h)))))
rlm@23:   ([] (box 0.5 0.5 0.5)))
rlm@23: 
rlm@23: (defn sphere
rlm@23:   ([r & {:as options}]
rlm@23:      (let [options (merge base-shape options)]
rlm@23:        (make-shape (assoc options
rlm@23: 		     :shape (Sphere. 32 32 (float r)))))) 
rlm@23:   ([] (sphere 0.5)))
rlm@23: 
rlm@23: (defn add-element
rlm@23:   ([game element node]
rlm@23:   (.addAll
rlm@23:    (.getPhysicsSpace
rlm@23:     (.getState
rlm@23:      (.getStateManager game)
rlm@23:      BulletAppState))
rlm@23:     element)
rlm@23:   (.attachChild node element))
rlm@23:   ([game element]
rlm@23:      (add-element game element (.getRootNode game))))
rlm@23: 
rlm@23: 
rlm@23: (defn set-gravity*
rlm@23:   [game gravity]
rlm@23:   (traverse
rlm@23:    (fn [geom]
rlm@23:      (if-let
rlm@23: 	 [control (.getControl geom RigidBodyControl)]
rlm@23:        (do
rlm@23: 	 (.setGravity control gravity)
rlm@23: 	 (.applyImpulse control Vector3f/ZERO Vector3f/ZERO)
rlm@23: 	 )))
rlm@23:    (.getRootNode game)))
rlm@23: 
rlm@23: #+end_src
rlm@23: 
rlm@23: These are convienence functions for creating JME objects and
rlm@23: manipulating a world.
rlm@23: