#+title: Clojure Utilities for jMonkeyEngine3

 #+author: Robert McIntyre

 #+email: rlm@mit.edu

 #+description: 

 #+keywords: JME3, clojure, import, utilities

 #+SETUPFILE: ../../aurellem/org/setup.org

 #+INCLUDE: ../../aurellem/org/level-0.org

 

 [TABLE-OF-CONTENTS]

 

 These are a collection of functions to make programming jMonkeyEngine

 in clojure easier.

 

 * Imports

 

 #+name: import

 #+begin_src clojure :results silent

 (ns cortex.import

   (:require swank.util.class-browse))

 

 (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-classes

   "returns a list of all jme3 classes"

   []

   (filter

    jme-class?

    (map :name

         swank.util.class-browse/available-classes)))

   

 (defn mega-import-jme3

   "Import ALL the jme classes. For REPL use."

   []

   (doall

    (map (comp permissive-import symbol) (jme-classes))))

 #+end_src  

 

 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 usefull for debugging purposes since

 it allows completion for almost all of JME's classes from the REPL.

 

 Out of curiousity, let's see just how many classes =mega-import-jme3=

 imports:

 

 #+begin_src clojure :exports both :results output

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

 #+end_src

 

 #+results:

 : 955 classes

 

 

 * Utilities

 

 The utilities here come in three main groups:

  - Changing settings in a running =Application=

  - Creating objects

  - Debug Actions

  - Visualizing objects

 

 *** Changing Settings

 

 #+name: util

 #+begin_src clojure 

 (ns cortex.util

   "Utility functions for making jMonkeyEngine3 easier to program from

    clojure."

   {:author "Robert McIntyre"}

   (:use cortex.world)

   (:use clojure.contrib.def)

   (: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 javax.swing.SwingUtilities)

   (:import com.jme3.scene.plugins.blender.BlenderModelLoader)

   (:import (java.util.logging Level Logger)))

 

 (defvar println-repl

   (bound-fn [& args] (apply println args))

   "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")

 

 (defn position-camera

   "Change the position of the in-world camera."

   ([world position direction up]

      (doto (.getCamera world)

        (.setLocation )

        (.lookAt direction up)))

   ([world position direction]

      (position-camera

       world position direction Vector3f/UNIT_Y)))

 

 (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]

   (.setMoveSpeed (.getFlyByCamera world)

                  (float 60))

   (.setRotationSpeed (.getFlyByCamera world)

                      (float 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)))))

 

 

 #+end_src

 

 #+results: util

 : #'cortex.util/apply-map

     

 

 *** Creating Basic Shapes

 

 #+name: shapes

 #+begin_src clojure :results silent

 (in-ns 'cortex.util)

 

 (defn load-bullet 

   "Runnig 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?

    ])

 

 (defvar base-shape

      (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)

      "Basic settings for shapes.")

 

 (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 usefull material for debuging -- it can be seen no matter what

     object occuldes 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))

 

 

 #+end_src

 

 

 *** Debug Actions

 #+name: debug-actions

 #+begin_src clojure :results silent

 (in-ns 'cortex.util)

 

 (defn basic-light-setup

   "returns a sequence of lights appropiate 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 appropiate 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.7 

                         :material "Common/MatDefs/Misc/Unshaded.j3md"

                         :texture "Textures/PokeCopper.jpg"

                         :position

                         (.add (.getLocation camera)

                               (.mult (.getDirection camera) (float 1)))

                         :mass 3)] ;200 0.05

            (.setLinearVelocity

             (.getControl cannon-ball RigidBodyControl)

             (.mult (.getDirection camera) (float 50))) ;50

            (add-element game cannon-ball (if node node (.getRootNode game)))))))

   ([]

     (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

     intilization

     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*

      intilization

      world-loop*]))

 

 (import com.jme3.font.BitmapText)

 (import com.jme3.scene.control.AbstractControl)

 (import com.aurellem.capture.IsoTimer)

 

 (defn display-dialated-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 (/ (.getTime timer) 1000)))))

        (controlRender [_ _])))

     (.attachChild (.getGuiNode world) text)))

 #+end_src

 

 

 *** Viewing Objects

 

 #+name: world-view

 #+begin_src clojure :results silent

 (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))))))

 

 (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))))

 

 #+end_src

 

 Here I make the =Viewable= protocol and extend it to JME's types.  Now

 JME3's =hello-world= can be written as easily as:

 

 #+begin_src clojure :results silent

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

 #+end_src

 

 

 * COMMENT code generation

 #+begin_src clojure :tangle ../src/cortex/import.clj

 <<import>>

 #+end_src

 

 

 #+begin_src clojure :tangle ../src/cortex/util.clj :noweb yes

 <<util>>

 <<shapes>>

 <<debug-actions>>

 <<world-view>>

 #+end_src