Clojure Utilities for jMonkeyEngine3

aurellem

Written by:

Robert McIntyre

[TABLE-OF-CONTENTS]

These are a collection of functions to make programming jMonkeyEngine in clojure easier.

1 Imports

(ns cortex.import
  (:import java.io.File java.util.jar.JarFile))

(defn permissive-import
  [classname]
  (eval `(try (import '~classname)
              (catch java.lang.Exception e#
                (println "couldn't import " '~classname))))
  classname)

(defn jme-class? [classname]
  (and
   (.startsWith classname "com.jme3.")
   ;; Don't import the LWJGL stuff since it can throw exceptions
   ;;  upon being loaded.
   (not (re-matches #".*Lwjgl.*" classname))))

(defn jme-jars []
  (map 
   #(JarFile. (File. %))
   (filter (partial re-matches #".*jME3.*")
           (clojure.string/split
            (System/getProperty "java.class.path") #":"))))

(defn jme-class-names []
  (filter
   jme-class?
   (map
    (comp
     #(.replace % File/separator ".")
     #(clojure.string/replace % ".class" ""))
    (filter
     (partial re-matches #".*\.class$")
     (mapcat
      #(map
        str
        (enumeration-seq
         (.entries %)))
      (jme-jars))))))
         
(defn mega-import-jme3
  "Import ALL the jme classes. For REPL use."
  []
  (import com.aurellem.capture.IsoTimer)
  (dorun
   (map (comp permissive-import symbol) (jme-class-names))))

jMonkeyEngine3 has a plethora of classes which can be overwhelming to manage. This code uses reflection to import all of them. Once I'm happy with the general structure of a namespace I can deal with importing only the classes it actually needs.

The mega-import-jme3 is quite useful for debugging purposes since it allows completion for almost all of JME's classes from the REPL.

Out of curiosity, let's see just how many classes mega-import-jme3 imports:

(println (clojure.core/count (cortex.import/jme-class-names)) "classes")
938 classes

2 Utilities

The utilities here come in three main groups:

  • Changing settings in a running Application
  • Creating objects
  • Debug Actions
  • Visualizing objects

2.0.1 Changing Settings

(ns cortex.util
  "Utility functions for making jMonkeyEngine3 easier to program from
   clojure."
  {:author "Robert McIntyre"}
  (:use cortex.world)
  (:import com.jme3.math.Vector3f)
  (:import com.jme3.math.Quaternion)
  (:import com.jme3.asset.TextureKey)
  (:import com.jme3.bullet.control.RigidBodyControl)
  (:import com.jme3.bullet.collision.shapes.GImpactCollisionShape)
  (:import com.jme3.scene.shape.Box)
  (:import com.jme3.scene.Node)
  (:import com.jme3.scene.shape.Sphere)
  (:import com.jme3.light.AmbientLight)
  (:import com.jme3.light.DirectionalLight)
  (:import (com.jme3.math Triangle ColorRGBA))
  (:import com.jme3.bullet.BulletAppState)
  (:import com.jme3.material.Material)
  (:import com.jme3.scene.Geometry)
  (:import java.awt.image.BufferedImage)
  (:import javax.swing.JPanel)
  (:import javax.swing.JFrame)
  (:import ij.ImagePlus)
  (:import javax.swing.SwingUtilities)
  (:import com.jme3.scene.plugins.blender.BlenderModelLoader)
  (:import (java.util.logging Level Logger)))

(def println-repl
  "println called from the LWJGL thread will not go to the REPL, but
   instead to whatever terminal started the JVM process. This function
   will always output to the REPL"
  (bound-fn [& args] (apply println args)))

(defn position-camera
  "Change the position of the in-world camera."
  ([world #^Vector3f position #^Quaternion rotation]
     (doto (.getCamera world)
       (.setLocation position)
       (.setRotation rotation)))
  ([world [position rotation]]
     (position-camera world position rotation)))
     

(defn enable-debug 
  "Turn on debug wireframes for every object in this simulation."
  [world]
  (.enableDebug 
   (.getPhysicsSpace
    (.getState
     (.getStateManager world)
     BulletAppState))
   (asset-manager)))

(defn speed-up 
  "Increase the dismally slow speed of the world's camera."
  ([world] (speed-up world 1))
  ([world amount]
     (.setMoveSpeed (.getFlyByCamera world)
                    (float (* amount 60)))
     (.setRotationSpeed (.getFlyByCamera world)
                        (float (* amount 3)))
     world))

(defn no-logging 
  "Disable all of jMonkeyEngine's logging."
  []
  (.setLevel (Logger/getLogger "com.jme3") Level/OFF))

(defn set-accuracy
  "Change the accuracy at which the World's Physics is calculated."
  [world new-accuracy]
  (let [physics-manager
        (.getState
         (.getStateManager world) BulletAppState)]
    (.setAccuracy
     (.getPhysicsSpace physics-manager)
     (float new-accuracy))))


(defn set-gravity 
  "In order to change the gravity of a scene, it is not only necessary
   to set the gravity variable, but to \"tap\" every physics object in
   the scene to reactivate physics calculations."
  [world gravity]
  (traverse
   (fn [geom]
     (if-let
         ;; only set gravity for physical objects.
         [control (.getControl geom RigidBodyControl)]
       (do
         (.setGravity control gravity)
         ;; tappsies!
         (.applyImpulse control Vector3f/ZERO Vector3f/ZERO))))
   (.getRootNode world)))

(defn add-element
  "Add the Spatial to the world's environment"
  ([world element node]
  (.addAll
   (.getPhysicsSpace
    (.getState
     (.getStateManager world)
     BulletAppState))
    element)
  (.attachChild node element))
  ([world element]
     (add-element world element (.getRootNode world))))

(defn apply-map
  "Like apply, but works for maps and functions that expect an
   implicit map and nothing else as in (fn [& {}]).
   ------- Example -------
   (defn demo [& {:keys [www] :or {www \"oh yeah\"} :as env}] 
     (println www))
   (apply-map demo {:www \"hello!\"})
   -->\"hello\""
  [fn m]
  (apply fn (reduce #(into %1 %2) [] m)))

(defn map-vals 
  "Transform a map by applying a function to its values,
  keeping the keys the same."  
  [f m] (zipmap (keys m) (map f (vals m))))

(defn runonce
  "Decorator.  returns a function which will run only once. 
   Inspired by Halloway's version from Lancet."
  {:author "Robert McIntyre"}
  [function]
  (let [sentinel (Object.) 
        result (atom sentinel)]
    (fn [& args]
       (locking sentinel
         (if (= @result sentinel) 
           (reset! result (apply function args)) 
            @result)))))

2.0.2 Creating Basic Shapes

(in-ns 'cortex.util)

(defn load-bullet 
  "Running this function unpacks the native bullet libraries and makes
   them available."
  []
  (let [sim (world (Node.) {} no-op no-op)]
    (doto sim
      (.enqueue
       (fn []
         (.stop sim)))
      (.start))))


(defrecord shape-description
  [name
   color
   mass
   friction
   texture
   material
   position
   rotation
   shape
   physical?
   GImpact?
   ])

(def base-shape
  "Basic settings for shapes."
  (shape-description.
   "default-shape"
   false
   ;;ColorRGBA/Blue
   1.0 ;; mass
   1.0 ;; friction
   ;; texture
   "Textures/Terrain/BrickWall/BrickWall.jpg"
   ;; material
   "Common/MatDefs/Misc/Unshaded.j3md"
   Vector3f/ZERO
   Quaternion/IDENTITY
   (Box. Vector3f/ZERO 0.5 0.5 0.5)
   true
   false))

(defn make-shape
  [#^shape-description d]
  (let [asset-manager (asset-manager)
        mat (Material. asset-manager (:material d))
        geom (Geometry. (:name d) (:shape d))]
    (if (:texture d)
      (let [key (TextureKey. (:texture d))]
        (.setGenerateMips key true)
        (.setTexture mat "ColorMap" (.loadTexture asset-manager key))
        ))
    (if (:color d) (.setColor mat "Color" (:color d)))
    (.setMaterial geom mat)
    (if-let [rotation (:rotation d)] (.rotate geom rotation))
    (.setLocalTranslation geom (:position d))
    (if (:physical? d)
      (let [physics-control
            (if (:GImpact d)
              ;; Create an accurate mesh collision shape if desired. 
              (RigidBodyControl.
               (doto (GImpactCollisionShape. 
                      (.getMesh geom))
                 (.createJmeMesh)
                 ;;(.setMargin 0)
                 )
               (float (:mass d)))
              ;; otherwise use jme3's default
              (RigidBodyControl. (float (:mass d))))]
        (.addControl geom physics-control)
        ;;(.setSleepingThresholds physics-control (float 0) (float 0))
        (.setFriction physics-control (:friction d))))
    geom))
  
(defn box
  ([l w h & {:as options}]
     (let [options (merge base-shape options)]
       (make-shape (assoc options
                     :shape (Box. l w h)))))
  ([] (box 0.5 0.5 0.5)))

(defn sphere
  ([r & {:as options}]
     (let [options (merge base-shape options)]
       (make-shape (assoc options
                     :shape (Sphere. 32 32 (float r)))))) 
  ([] (sphere 0.5)))

(defn x-ray 
   "A useful material for debugging -- it can be seen no matter what
    object occludes it."
   [#^ColorRGBA color]
   (doto (Material. (asset-manager)
                    "Common/MatDefs/Misc/Unshaded.j3md")
     (.setColor "Color" color)
     (-> (.getAdditionalRenderState)
         (.setDepthTest false))))

(defn node-seq
  "Take a node and return a seq of all its children
   recursively. There will be no nodes left in the resulting
   structure"
  [#^Node node]
  (tree-seq #(isa? (class %) Node) #(.getChildren %) node))

(defn nodify
  "Take a sequence of things that can be attached to a node and return
  a node with all of them attached"
  ([name children]
     (let [node (Node. name)]
       (dorun (map #(.attachChild node %) children))
       node))
  ([children] (nodify "" children)))

(defn load-blender-model
  "Load a .blend file using an asset folder relative path."
  [^String model]
  (.loadModel
   (doto (asset-manager)
     (.registerLoader BlenderModelLoader 
                      (into-array String ["blend"]))) model))



(def brick-length 0.48)
(def brick-width 0.24)
(def brick-height 0.12)
(def gravity (Vector3f. 0 -9.81 0))

(import com.jme3.math.Vector2f)
(import com.jme3.renderer.queue.RenderQueue$ShadowMode)
(import com.jme3.texture.Texture$WrapMode)

(defn brick* [position]
  (println "get brick.")
  (doto (box brick-length brick-height brick-width
             :position position :name "brick"
             :material "Common/MatDefs/Misc/Unshaded.j3md"
             :texture "Textures/Terrain/BrickWall/BrickWall.jpg"
             :mass 34)
    (->
     (.getMesh)
     (.scaleTextureCoordinates (Vector2f. 1 0.5)))
    (.setShadowMode RenderQueue$ShadowMode/CastAndReceive)
    )
  )


(defn floor*
  "make a sturdy, unmovable physical floor"
  []
  (box 10 0.1 5 :name "floor" :mass 0 
       :color ColorRGBA/Gray :position (Vector3f. 0 0 0)))

(defn floor* []
  (doto (box 10 0.1 5 :name "floor" ;10 0.1 5 ; 240 0.1 240
             :material "Common/MatDefs/Misc/Unshaded.j3md"
             :texture "Textures/BronzeCopper030.jpg"
             :position (Vector3f. 0 0 0 )
             :mass 0)
    (->
     (.getMesh)
     (.scaleTextureCoordinates (Vector2f. 3 6)));64 64
    (->
     (.getMaterial)
     (.getTextureParam "ColorMap")
     (.getTextureValue)
     (.setWrap Texture$WrapMode/Repeat))
    (.setShadowMode RenderQueue$ShadowMode/Receive)
  ))


(defn brick-wall* []
  (let [node (Node. "brick-wall")]
    (dorun
     (map
      (comp  #(.attachChild node %) brick*)
       (for [y (range 10)
             x (range 4)
             z (range 1)]
            (Vector3f.
             (+ (* 2 x brick-length)
                (if (even? (+ y z)) 
                  (/ brick-length 4) (/ brick-length -4)))
             (+ (* brick-height (inc (* 2 y))))
             (* 2 z brick-width) ))))
    (.setShadowMode node RenderQueue$ShadowMode/CastAndReceive)
    node))

2.0.3 Debug Actions

(in-ns 'cortex.util)

(defn basic-light-setup
  "returns a sequence of lights appropriate for fully lighting a scene"
  []
  (conj
   (doall
    (map
     (fn [direction]
       (doto (DirectionalLight.)
         (.setDirection direction)
         (.setColor ColorRGBA/White)))
     [;; six faces of a cube
      Vector3f/UNIT_X
      Vector3f/UNIT_Y
      Vector3f/UNIT_Z
      (.mult Vector3f/UNIT_X (float -1))
      (.mult Vector3f/UNIT_Y (float -1))
      (.mult Vector3f/UNIT_Z (float -1))]))
   (doto (AmbientLight.)
     (.setColor ColorRGBA/White))))

(defn light-up-everything
  "Add lights to a world appropriate for quickly seeing everything
  in the scene.  Adds six DirectionalLights facing in orthogonal
  directions, and one AmbientLight to provide overall lighting
  coverage."
  [world]
  (dorun
   (map
    #(.addLight (.getRootNode world) %)
    (basic-light-setup))))

(defn fire-cannon-ball
  "Creates a function that fires a cannon-ball from the current game's
  camera. The cannon-ball will be attached to the node if provided, or
  to the game's RootNode if no node is provided."
  ([node]
     (fn [game value]
       (if (not value)
         (let [camera (.getCamera game)
               cannon-ball
               (sphere  0.4
                        ;;:texture nil
                        :material "Common/MatDefs/Misc/Unshaded.j3md"
                        :color ColorRGBA/Blue
                        :name "cannonball!"
                        :position
                        (.add (.getLocation camera)
                              (.mult (.getDirection camera) (float 1)))
                        :mass 25)] ;200 0.05
           (.setLinearVelocity
            (.getControl cannon-ball RigidBodyControl)
            (.mult (.getDirection camera) (float 50))) ;50
           (add-element game cannon-ball (if node node (.getRootNode
            game)))
           cannon-ball))))
  ([]
    (fire-cannon-ball false)))

(def standard-debug-controls 
  {"key-space" (fire-cannon-ball)})

   
(defn tap [obj direction force]
  (let [control (.getControl obj RigidBodyControl)]
    (.applyTorque
     control
     (.mult (.getPhysicsRotation control)
            (.mult (.normalize direction) (float force))))))


(defn with-movement
  [object
   [up down left right roll-up roll-down :as keyboard]
   forces
   [root-node
    keymap
    initialization
    world-loop]]
  (let [add-keypress
        (fn [state keymap key]
          (merge keymap
                  {key
                   (fn [_ pressed?]
                     (reset! state pressed?))}))
        move-up? (atom false)
        move-down? (atom false)
        move-left? (atom false)
        move-right? (atom false)
        roll-left? (atom false)
        roll-right? (atom false)
        
        directions [(Vector3f. 0 1 0)(Vector3f. 0 -1 0)
                    (Vector3f. 0 0 1)(Vector3f. 0 0 -1)
                    (Vector3f. -1 0 0)(Vector3f. 1 0 0)]
        atoms [move-left? move-right? move-up? move-down? 
                 roll-left? roll-right?]

        keymap* (reduce merge
                        (map #(add-keypress %1 keymap %2)
                             atoms
                             keyboard))
        
        splice-loop (fn []
                      (dorun
                       (map
                        (fn [sym direction force]
                          (if @sym
                            (tap object direction force)))
                        atoms directions forces)))

        world-loop* (fn [world tpf]
                       (world-loop world tpf)
                       (splice-loop))]
    [root-node
     keymap*
     initialization
     world-loop*]))

(import com.jme3.font.BitmapText)
(import com.jme3.scene.control.AbstractControl)
(import com.aurellem.capture.IsoTimer)

(defn display-dilated-time
  "Shows the time as it is flowing in the simulation on a HUD display.
   Useful for making videos."
  [world timer]
  (let [font (.loadFont (asset-manager) "Interface/Fonts/Default.fnt")
        text (BitmapText. font false)]
    (.setLocalTranslation text 300 (.getLineHeight text) 0)
    (.addControl
     text
     (proxy [AbstractControl] []
       (controlUpdate [tpf]
         (.setText text (format
                         "%.2f"
                         (float (.getTimeInSeconds timer)))))
       (controlRender [_ _])))
    (.attachChild (.getGuiNode world) text)))

2.0.4 Viewing Objects

(in-ns 'cortex.util)

(defprotocol Viewable
  (view [something]))

(extend-type com.jme3.scene.Geometry
  Viewable
  (view [geo]
        (view (doto (Node.)(.attachChild geo)))))
    
(extend-type com.jme3.scene.Node
  Viewable
  (view 
    [node]
    (.start
     (world
      node
      {}
      (fn [world]
        (enable-debug world)
        (set-gravity world Vector3f/ZERO)
        (light-up-everything world))
      no-op))))

(extend-type com.jme3.math.ColorRGBA
  Viewable
  (view
    [color]
    (view (doto (Node.)
            (.attachChild (box 1 1 1 :color color))))))

(extend-type ij.ImagePlus
  Viewable
  (view [image]
    (.show image)))

(extend-type java.awt.image.BufferedImage
  Viewable
  (view
    [image]
    (view (ImagePlus. "view-buffered-image" image))))


(defprotocol Textual
  (text [something]
    "Display a detailed textual analysis of the given object."))

(extend-type com.jme3.scene.Node
  Textual
  (text [node]
    (println "Total Vertexes: " (.getVertexCount node))
    (println "Total Triangles: " (.getTriangleCount node))
    (println "Controls :")
    (dorun (map #(text (.getControl node %)) (range (.getNumControls node))))
    (println "Has " (.getQuantity node) " Children:")
    (doall (map text (.getChildren node)))))

(extend-type com.jme3.animation.AnimControl
  Textual
  (text [control]
    (let [animations (.getAnimationNames control)]
      (println "Animation Control with " (count animations) " animation(s):")
      (dorun (map println animations)))))

(extend-type com.jme3.animation.SkeletonControl
  Textual
  (text [control]
    (println "Skeleton Control with the following skeleton:")
    (println (.getSkeleton control))))

(extend-type com.jme3.bullet.control.KinematicRagdollControl
  Textual
  (text [control]
    (println "Ragdoll Control")))
                 
(extend-type com.jme3.scene.Geometry
  Textual
  (text [control]
    (println "...geo...")))

(extend-type Triangle
  Textual
  (text [t]
    (println "Triangle: " \newline (.get1 t) \newline
             (.get2 t) \newline (.get3 t))))

Here I make the Viewable protocol and extend it to JME's types. Now JME3's hello-world can be written as easily as:

(cortex.util/view (cortex.util/box))

3 code generation

(ns cortex.import
  (:import java.io.File java.util.jar.JarFile))

(defn permissive-import
  [classname]
  (eval `(try (import '~classname)
              (catch java.lang.Exception e#
                (println "couldn't import " '~classname))))
  classname)

(defn jme-class? [classname]
  (and
   (.startsWith classname "com.jme3.")
   ;; Don't import the LWJGL stuff since it can throw exceptions
   ;;  upon being loaded.
   (not (re-matches #".*Lwjgl.*" classname))))

(defn jme-jars []
  (map 
   #(JarFile. (File. %))
   (filter (partial re-matches #".*jME3.*")
           (clojure.string/split
            (System/getProperty "java.class.path") #":"))))

(defn jme-class-names []
  (filter
   jme-class?
   (map
    (comp
     #(.replace % File/separator ".")
     #(clojure.string/replace % ".class" ""))
    (filter
     (partial re-matches #".*\.class$")
     (mapcat
      #(map
        str
        (enumeration-seq
         (.entries %)))
      (jme-jars))))))
         
(defn mega-import-jme3
  "Import ALL the jme classes. For REPL use."
  []
  (import com.aurellem.capture.IsoTimer)
  (dorun
   (map (comp permissive-import symbol) (jme-class-names))))
(ns cortex.util
  "Utility functions for making jMonkeyEngine3 easier to program from
   clojure."
  {:author "Robert McIntyre"}
  (:use cortex.world)
  (:import com.jme3.math.Vector3f)
  (:import com.jme3.math.Quaternion)
  (:import com.jme3.asset.TextureKey)
  (:import com.jme3.bullet.control.RigidBodyControl)
  (:import com.jme3.bullet.collision.shapes.GImpactCollisionShape)
  (:import com.jme3.scene.shape.Box)
  (:import com.jme3.scene.Node)
  (:import com.jme3.scene.shape.Sphere)
  (:import com.jme3.light.AmbientLight)
  (:import com.jme3.light.DirectionalLight)
  (:import (com.jme3.math Triangle ColorRGBA))
  (:import com.jme3.bullet.BulletAppState)
  (:import com.jme3.material.Material)
  (:import com.jme3.scene.Geometry)
  (:import java.awt.image.BufferedImage)
  (:import javax.swing.JPanel)
  (:import javax.swing.JFrame)
  (:import ij.ImagePlus)
  (:import javax.swing.SwingUtilities)
  (:import com.jme3.scene.plugins.blender.BlenderModelLoader)
  (:import (java.util.logging Level Logger)))

(def println-repl
  "println called from the LWJGL thread will not go to the REPL, but
   instead to whatever terminal started the JVM process. This function
   will always output to the REPL"
  (bound-fn [& args] (apply println args)))

(defn position-camera
  "Change the position of the in-world camera."
  ([world #^Vector3f position #^Quaternion rotation]
     (doto (.getCamera world)
       (.setLocation position)
       (.setRotation rotation)))
  ([world [position rotation]]
     (position-camera world position rotation)))
     

(defn enable-debug 
  "Turn on debug wireframes for every object in this simulation."
  [world]
  (.enableDebug 
   (.getPhysicsSpace
    (.getState
     (.getStateManager world)
     BulletAppState))
   (asset-manager)))

(defn speed-up 
  "Increase the dismally slow speed of the world's camera."
  ([world] (speed-up world 1))
  ([world amount]
     (.setMoveSpeed (.getFlyByCamera world)
                    (float (* amount 60)))
     (.setRotationSpeed (.getFlyByCamera world)
                        (float (* amount 3)))
     world))

(defn no-logging 
  "Disable all of jMonkeyEngine's logging."
  []
  (.setLevel (Logger/getLogger "com.jme3") Level/OFF))

(defn set-accuracy
  "Change the accuracy at which the World's Physics is calculated."
  [world new-accuracy]
  (let [physics-manager
        (.getState
         (.getStateManager world) BulletAppState)]
    (.setAccuracy
     (.getPhysicsSpace physics-manager)
     (float new-accuracy))))


(defn set-gravity 
  "In order to change the gravity of a scene, it is not only necessary
   to set the gravity variable, but to \"tap\" every physics object in
   the scene to reactivate physics calculations."
  [world gravity]
  (traverse
   (fn [geom]
     (if-let
         ;; only set gravity for physical objects.
         [control (.getControl geom RigidBodyControl)]
       (do
         (.setGravity control gravity)
         ;; tappsies!
         (.applyImpulse control Vector3f/ZERO Vector3f/ZERO))))
   (.getRootNode world)))

(defn add-element
  "Add the Spatial to the world's environment"
  ([world element node]
  (.addAll
   (.getPhysicsSpace
    (.getState
     (.getStateManager world)
     BulletAppState))
    element)
  (.attachChild node element))
  ([world element]
     (add-element world element (.getRootNode world))))

(defn apply-map
  "Like apply, but works for maps and functions that expect an
   implicit map and nothing else as in (fn [& {}]).
   ------- Example -------
   (defn demo [& {:keys [www] :or {www \"oh yeah\"} :as env}] 
     (println www))
   (apply-map demo {:www \"hello!\"})
   -->\"hello\""
  [fn m]
  (apply fn (reduce #(into %1 %2) [] m)))

(defn map-vals 
  "Transform a map by applying a function to its values,
  keeping the keys the same."  
  [f m] (zipmap (keys m) (map f (vals m))))

(defn runonce
  "Decorator.  returns a function which will run only once. 
   Inspired by Halloway's version from Lancet."
  {:author "Robert McIntyre"}
  [function]
  (let [sentinel (Object.) 
        result (atom sentinel)]
    (fn [& args]
       (locking sentinel
         (if (= @result sentinel) 
           (reset! result (apply function args)) 
            @result)))))


(in-ns 'cortex.util)

(defn load-bullet 
  "Running this function unpacks the native bullet libraries and makes
   them available."
  []
  (let [sim (world (Node.) {} no-op no-op)]
    (doto sim
      (.enqueue
       (fn []
         (.stop sim)))
      (.start))))


(defrecord shape-description
  [name
   color
   mass
   friction
   texture
   material
   position
   rotation
   shape
   physical?
   GImpact?
   ])

(def base-shape
  "Basic settings for shapes."
  (shape-description.
   "default-shape"
   false
   ;;ColorRGBA/Blue
   1.0 ;; mass
   1.0 ;; friction
   ;; texture
   "Textures/Terrain/BrickWall/BrickWall.jpg"
   ;; material
   "Common/MatDefs/Misc/Unshaded.j3md"
   Vector3f/ZERO
   Quaternion/IDENTITY
   (Box. Vector3f/ZERO 0.5 0.5 0.5)
   true
   false))

(defn make-shape
  [#^shape-description d]
  (let [asset-manager (asset-manager)
        mat (Material. asset-manager (:material d))
        geom (Geometry. (:name d) (:shape d))]
    (if (:texture d)
      (let [key (TextureKey. (:texture d))]
        (.setGenerateMips key true)
        (.setTexture mat "ColorMap" (.loadTexture asset-manager key))
        ))
    (if (:color d) (.setColor mat "Color" (:color d)))
    (.setMaterial geom mat)
    (if-let [rotation (:rotation d)] (.rotate geom rotation))
    (.setLocalTranslation geom (:position d))
    (if (:physical? d)
      (let [physics-control
            (if (:GImpact d)
              ;; Create an accurate mesh collision shape if desired. 
              (RigidBodyControl.
               (doto (GImpactCollisionShape. 
                      (.getMesh geom))
                 (.createJmeMesh)
                 ;;(.setMargin 0)
                 )
               (float (:mass d)))
              ;; otherwise use jme3's default
              (RigidBodyControl. (float (:mass d))))]
        (.addControl geom physics-control)
        ;;(.setSleepingThresholds physics-control (float 0) (float 0))
        (.setFriction physics-control (:friction d))))
    geom))
  
(defn box
  ([l w h & {:as options}]
     (let [options (merge base-shape options)]
       (make-shape (assoc options
                     :shape (Box. l w h)))))
  ([] (box 0.5 0.5 0.5)))

(defn sphere
  ([r & {:as options}]
     (let [options (merge base-shape options)]
       (make-shape (assoc options
                     :shape (Sphere. 32 32 (float r)))))) 
  ([] (sphere 0.5)))

(defn x-ray 
   "A useful material for debugging -- it can be seen no matter what
    object occludes it."
   [#^ColorRGBA color]
   (doto (Material. (asset-manager)
                    "Common/MatDefs/Misc/Unshaded.j3md")
     (.setColor "Color" color)
     (-> (.getAdditionalRenderState)
         (.setDepthTest false))))

(defn node-seq
  "Take a node and return a seq of all its children
   recursively. There will be no nodes left in the resulting
   structure"
  [#^Node node]
  (tree-seq #(isa? (class %) Node) #(.getChildren %) node))

(defn nodify
  "Take a sequence of things that can be attached to a node and return
  a node with all of them attached"
  ([name children]
     (let [node (Node. name)]
       (dorun (map #(.attachChild node %) children))
       node))
  ([children] (nodify "" children)))

(defn load-blender-model
  "Load a .blend file using an asset folder relative path."
  [^String model]
  (.loadModel
   (doto (asset-manager)
     (.registerLoader BlenderModelLoader 
                      (into-array String ["blend"]))) model))



(def brick-length 0.48)
(def brick-width 0.24)
(def brick-height 0.12)
(def gravity (Vector3f. 0 -9.81 0))

(import com.jme3.math.Vector2f)
(import com.jme3.renderer.queue.RenderQueue$ShadowMode)
(import com.jme3.texture.Texture$WrapMode)

(defn brick* [position]
  (println "get brick.")
  (doto (box brick-length brick-height brick-width
             :position position :name "brick"
             :material "Common/MatDefs/Misc/Unshaded.j3md"
             :texture "Textures/Terrain/BrickWall/BrickWall.jpg"
             :mass 34)
    (->
     (.getMesh)
     (.scaleTextureCoordinates (Vector2f. 1 0.5)))
    (.setShadowMode RenderQueue$ShadowMode/CastAndReceive)
    )
  )


(defn floor*
  "make a sturdy, unmovable physical floor"
  []
  (box 10 0.1 5 :name "floor" :mass 0 
       :color ColorRGBA/Gray :position (Vector3f. 0 0 0)))

(defn floor* []
  (doto (box 10 0.1 5 :name "floor" ;10 0.1 5 ; 240 0.1 240
             :material "Common/MatDefs/Misc/Unshaded.j3md"
             :texture "Textures/BronzeCopper030.jpg"
             :position (Vector3f. 0 0 0 )
             :mass 0)
    (->
     (.getMesh)
     (.scaleTextureCoordinates (Vector2f. 3 6)));64 64
    (->
     (.getMaterial)
     (.getTextureParam "ColorMap")
     (.getTextureValue)
     (.setWrap Texture$WrapMode/Repeat))
    (.setShadowMode RenderQueue$ShadowMode/Receive)
  ))


(defn brick-wall* []
  (let [node (Node. "brick-wall")]
    (dorun
     (map
      (comp  #(.attachChild node %) brick*)
       (for [y (range 10)
             x (range 4)
             z (range 1)]
            (Vector3f.
             (+ (* 2 x brick-length)
                (if (even? (+ y z)) 
                  (/ brick-length 4) (/ brick-length -4)))
             (+ (* brick-height (inc (* 2 y))))
             (* 2 z brick-width) ))))
    (.setShadowMode node RenderQueue$ShadowMode/CastAndReceive)
    node))


(in-ns 'cortex.util)

(defn basic-light-setup
  "returns a sequence of lights appropriate for fully lighting a scene"
  []
  (conj
   (doall
    (map
     (fn [direction]
       (doto (DirectionalLight.)
         (.setDirection direction)
         (.setColor ColorRGBA/White)))
     [;; six faces of a cube
      Vector3f/UNIT_X
      Vector3f/UNIT_Y
      Vector3f/UNIT_Z
      (.mult Vector3f/UNIT_X (float -1))
      (.mult Vector3f/UNIT_Y (float -1))
      (.mult Vector3f/UNIT_Z (float -1))]))
   (doto (AmbientLight.)
     (.setColor ColorRGBA/White))))

(defn light-up-everything
  "Add lights to a world appropriate for quickly seeing everything
  in the scene.  Adds six DirectionalLights facing in orthogonal
  directions, and one AmbientLight to provide overall lighting
  coverage."
  [world]
  (dorun
   (map
    #(.addLight (.getRootNode world) %)
    (basic-light-setup))))

(defn fire-cannon-ball
  "Creates a function that fires a cannon-ball from the current game's
  camera. The cannon-ball will be attached to the node if provided, or
  to the game's RootNode if no node is provided."
  ([node]
     (fn [game value]
       (if (not value)
         (let [camera (.getCamera game)
               cannon-ball
               (sphere  0.4
                        ;;:texture nil
                        :material "Common/MatDefs/Misc/Unshaded.j3md"
                        :color ColorRGBA/Blue
                        :name "cannonball!"
                        :position
                        (.add (.getLocation camera)
                              (.mult (.getDirection camera) (float 1)))
                        :mass 25)] ;200 0.05
           (.setLinearVelocity
            (.getControl cannon-ball RigidBodyControl)
            (.mult (.getDirection camera) (float 50))) ;50
           (add-element game cannon-ball (if node node (.getRootNode
            game)))
           cannon-ball))))
  ([]
    (fire-cannon-ball false)))

(def standard-debug-controls 
  {"key-space" (fire-cannon-ball)})

   
(defn tap [obj direction force]
  (let [control (.getControl obj RigidBodyControl)]
    (.applyTorque
     control
     (.mult (.getPhysicsRotation control)
            (.mult (.normalize direction) (float force))))))


(defn with-movement
  [object
   [up down left right roll-up roll-down :as keyboard]
   forces
   [root-node
    keymap
    initialization
    world-loop]]
  (let [add-keypress
        (fn [state keymap key]
          (merge keymap
                  {key
                   (fn [_ pressed?]
                     (reset! state pressed?))}))
        move-up? (atom false)
        move-down? (atom false)
        move-left? (atom false)
        move-right? (atom false)
        roll-left? (atom false)
        roll-right? (atom false)
        
        directions [(Vector3f. 0 1 0)(Vector3f. 0 -1 0)
                    (Vector3f. 0 0 1)(Vector3f. 0 0 -1)
                    (Vector3f. -1 0 0)(Vector3f. 1 0 0)]
        atoms [move-left? move-right? move-up? move-down? 
                 roll-left? roll-right?]

        keymap* (reduce merge
                        (map #(add-keypress %1 keymap %2)
                             atoms
                             keyboard))
        
        splice-loop (fn []
                      (dorun
                       (map
                        (fn [sym direction force]
                          (if @sym
                            (tap object direction force)))
                        atoms directions forces)))

        world-loop* (fn [world tpf]
                       (world-loop world tpf)
                       (splice-loop))]
    [root-node
     keymap*
     initialization
     world-loop*]))

(import com.jme3.font.BitmapText)
(import com.jme3.scene.control.AbstractControl)
(import com.aurellem.capture.IsoTimer)

(defn display-dilated-time
  "Shows the time as it is flowing in the simulation on a HUD display.
   Useful for making videos."
  [world timer]
  (let [font (.loadFont (asset-manager) "Interface/Fonts/Default.fnt")
        text (BitmapText. font false)]
    (.setLocalTranslation text 300 (.getLineHeight text) 0)
    (.addControl
     text
     (proxy [AbstractControl] []
       (controlUpdate [tpf]
         (.setText text (format
                         "%.2f"
                         (float (.getTimeInSeconds timer)))))
       (controlRender [_ _])))
    (.attachChild (.getGuiNode world) text)))
(in-ns 'cortex.util)

(defprotocol Viewable
  (view [something]))

(extend-type com.jme3.scene.Geometry
  Viewable
  (view [geo]
        (view (doto (Node.)(.attachChild geo)))))
    
(extend-type com.jme3.scene.Node
  Viewable
  (view 
    [node]
    (.start
     (world
      node
      {}
      (fn [world]
        (enable-debug world)
        (set-gravity world Vector3f/ZERO)
        (light-up-everything world))
      no-op))))

(extend-type com.jme3.math.ColorRGBA
  Viewable
  (view
    [color]
    (view (doto (Node.)
            (.attachChild (box 1 1 1 :color color))))))

(extend-type ij.ImagePlus
  Viewable
  (view [image]
    (.show image)))

(extend-type java.awt.image.BufferedImage
  Viewable
  (view
    [image]
    (view (ImagePlus. "view-buffered-image" image))))


(defprotocol Textual
  (text [something]
    "Display a detailed textual analysis of the given object."))

(extend-type com.jme3.scene.Node
  Textual
  (text [node]
    (println "Total Vertexes: " (.getVertexCount node))
    (println "Total Triangles: " (.getTriangleCount node))
    (println "Controls :")
    (dorun (map #(text (.getControl node %)) (range (.getNumControls node))))
    (println "Has " (.getQuantity node) " Children:")
    (doall (map text (.getChildren node)))))

(extend-type com.jme3.animation.AnimControl
  Textual
  (text [control]
    (let [animations (.getAnimationNames control)]
      (println "Animation Control with " (count animations) " animation(s):")
      (dorun (map println animations)))))

(extend-type com.jme3.animation.SkeletonControl
  Textual
  (text [control]
    (println "Skeleton Control with the following skeleton:")
    (println (.getSkeleton control))))

(extend-type com.jme3.bullet.control.KinematicRagdollControl
  Textual
  (text [control]
    (println "Ragdoll Control")))
                 
(extend-type com.jme3.scene.Geometry
  Textual
  (text [control]
    (println "...geo...")))

(extend-type Triangle
  Textual
  (text [t]
    (println "Triangle: " \newline (.get1 t) \newline
             (.get2 t) \newline (.get3 t))))

Author: Robert McIntyre

Created: 2015-04-19 Sun 07:04

Emacs 24.4.1 (Org mode 8.3beta)

Validate