Embedding Clojure

goup.clj

(ns goup-engine.core
  (:import (com.jme3.app SimpleApplication)
           (com.jme3.material Material)
           (com.jme3.math ColorRGBA)
           (com.jme3.math Vector3f FastMath Quaternion)
           (com.jme3.renderer RenderManager)
           (com.jme3.scene Geometry Node)
           (com.jme3.scene.shape Box Quad)
           (com.jme3.input KeyInput)
           (com.jme3.input.controls KeyTrigger ActionListener)
           (com.jme3.bullet BulletAppState)
           (com.jme3.bullet.control RigidBodyControl CharacterControl)
           (com.jme3.bullet.collision.shapes
            MeshCollisionShape CapsuleCollisionShape CollisionShape) ))

;; Functions to access the private members of the game class. This
;; will only work if the bootstrap.clj script has run.
(def root-node (get goupgame/*context* "rootNode"))
(def asset-manager (get goupgame/*context* "assetManager"))
(def state-manager (get goupgame/*context* "stateManager"))
(def view-port (get goupgame/*context* "viewPort"))
(def fly-cam (get goupgame/*context* "flyCam"))
(def input-manager (get goupgame/*context* "inputManager"))
(def this (get goupgame/*context* "this"))

(defonce physics-state
  (let [state (BulletAppState.)]
    (.attach state-manager state)
        state))

;; Entities
;; Helpers for working with the entities map.
;; TODO: return all entities that have all the components in the
;; components set.
(defn get-with-components [entities components]
  (into {}
        (filter
         (fn [[id comp-map]]
           (every? #(contains? (set (keys comp-map)) %) components))
         entities)))

(defn gen-id
  "Generates a new id for an entity"
  []
  (keyword (.toString (java.util.UUID/randomUUID))))
  

;; Systems
(defprotocol ISystem
  (get-name [this] "Name of system to be used as id.")
  (get-components [this] "Returns a set of the components this system works on.")
  (server-update [this globals entities messages tps]
    "Update is called once a frame with a map of entities that have all the
     components returned by components or a message to that set of components.
     It must return a collection of updated entities. Server update is only
     called on the server. It is where most of your game logic will run.")
  (client-update [this globals entities messages tps]
    "Update is called once a frame with a map of entities that have all the
     components returned by components or a message to that set of components.
     It must return a collection of updated entities. Client update is only
     called on the individual clients. It is mostly used for responding to user
     input and sending messages to other entities."))

;; Game
(defprotocol IGame
  (add-system!
    [this ^ISystem system]
    "Adds a system to the game, returns the current systems.")
  (remove-system!
    [this ^String system]
    "Removes a system from the game, returns the current systems.")
  (start [this] "foo")
  (stop [this] "foo")
  (send-message [this msg] "f00"))

(defn build-message-map
  "Takes the messages and makes a map by id."
  [messages]
  (apply merge-with concat
         (map #(hash-map (:entity-id %) [%]) messages)))

;; Context is a map of all the java properties.

;; Entities is an atom that is a map of entities. The keys are the
;; entity id and the value is a map of components.
;; eg. {:1 {:player {} :health {:val 1}}}

;; Messages is a ref that is a sequence of messages. A message is a
;; command that goes to the entity on all clients and the server.
;; {:entity-id :12345 :message-id :Create-Object :args [:foo "bar" 123]}

;; Systems is a sequence of System objects that are active.

;; Server? is a boolean representing if this instance is a server or a
;; client. This determines if the server-update or client-update
;; function is called.

;; TODO: SOOOO many checks of stuff. And tests....
(defrecord Game [entities messages systems server?]
  IGame
  (add-system! [this system]
    (keys
     (swap! systems assoc (get-name system) system)))
  (remove-system! [this system-name]
    (keys
     (swap! systems dissoc system-name)))
  (start [this]
    (let [globals {}
          f (fn [tpf]
              (let [current-messages (dosync
                                      (let [current @messages]
                                        (ref-set messages [])
                                        current))]
                (doseq [[name system] @systems]
                  (let [ents (get-with-components @entities (get-components system))
                        changes (if server?
                                  (server-update system globals ents current-messages tpf)
                                  (client-update system globals ents current-messages tpf))]
                    (swap! entities merge changes)))))]
      (goupgame/add-update-fn :game f)))
  (stop [this]
    (goupgame/remove-update-fn :game))
  ;; No real idea if this is the best way to send messages. Probably
  ;; not, going to need a higher level network manager thing that
  ;; knows about the connected clients and can broadcast stuff.
  (send-message [this msg] (dosync
                            (alter messages conj msg))))

(defn make-game [] (Game. (atom {}) (ref []) (atom {}) true))

;; Specific Systems
;; ================

(defrecord TestSystem []
  ISystem
  (get-name [_] "Test System")
  (get-components [this] #{:foo})
  (server-update [_ _ _ msgs _]
    (when-let [m (first msgs)]
      (.print System/out (str m))))
  (client-update [_ _ _ _ _] nil))

;; Graphics System
;; ===============

;; Node helpers
(defn get-child
  "Returns the child of node with the name name."
  [node name] (.getChild node name))
(defn get-parent
  "Returns the parent of node."
  [node] (.getParent node))
(defn attach
  "Attach child as a child of node"
  [node child] (.attachChild node child))
(defn detach
  "Detaches child from node"
  [node child]
  (.detachChild node child))

;; Explicitly dealing with the root node.
(defn add-to-scene
  "Adds a node to the rootnode so it shows up in the scene."
  [node]
  (attach root-node node))

(defn remove-from-scene
  "Removes a node from the scene."
  [node]
  (detach root-node node))

(defn clear-scene
  []
  (.detachAllChildren root-node))

;; Creating Shapes
(defn create-box
  [x y z]
  (Box. Vector3f/ZERO x y z))

(defn create-quad
  [x y]
  (Quad. x y))

(defn create-shape
  "Creates a shape. Size depends on shape."
  [shape size]
  (let [[a b c] size]
    (condp = shape
      :box (create-box a b c)
      :quad (create-quad a b))))  

;; Materials
(defn create-base-unshaded-mat []
  (Material. asset-manager "Common/MatDefs/Misc/Unshaded.j3md"))

(defn get-color-class
  [color-code]
  (condp = color-code
    :black ColorRGBA/Black
    :blue ColorRGBA/Blue
    :brown ColorRGBA/Brown
    :cyan ColorRGBA/Cyan
    :dark-gray ColorRGBA/DarkGray
    :gray ColorRGBA/Gray
    :green ColorRGBA/Green
    :light-gray ColorRGBA/LightGray
    :magenta ColorRGBA/Magenta
    :orange ColorRGBA/Orange
    :pink ColorRGBA/Pink
    :red ColorRGBA/Red
    :white ColorRGBA/White
    :yellow ColorRGBA/Yellow))

;; Manipulating Materials
(defn set-color!
  [material color]
  (let [color-class (get-color-class color)]
    (.setColor material "Color" color-class)
    material))

(defn create-colored-unshaded-mat [color]
  (let [mat (create-base-unshaded-mat)]
    (set-color! mat color)
    mat))

;; Geometries
(defn create-geometry
  [name shape material]
  (let [geometry (Geometry. name shape)]
    (.setMaterial geometry material)
    geometry))

(defn set-position!
  [geometry x y z]
  (.setLocalTranslation geometry x y z))

(defn create-goup [spec id]
  (let [{:keys [color position rotate shape size kinematic?]} spec
        obj (create-shape shape size)
        mat (create-colored-unshaded-mat color)
        geom (create-geometry (str id) obj mat)]
    ;; Set id on geometry
    (.setUserData geom "id" (str id))
    ;; Move
    (apply set-position! geom position)
    ;; Rotate is a fn of the geometry for now.
    (when rotate
      (rotate geom))
    ;; Add Physics
    (.addControl geom (RigidBodyControl. (if kinematic? 0.0 1.0)))
    (.add (.getPhysicsSpace physics-state) geom)
    ;; Add to Scene
    (add-to-scene geom)
    {:color color
     :position position
     :shape shape
     :size size
     :kinematic? kinematic?
     :shape-obj shape}))

(defrecord GraphicsSystem [objs]
  ISystem
  (get-name [_] "Graphics")
  (get-components [_] #{:visable :location})
  (server-update [this globals entities messages tps]
    ;; Just handle creation for now, creates physics too.
    (apply merge {}
           (for [{:keys [entity-id message-id args]} messages
                 :when (= message-id :create-goup)]
             (let [id (gen-id)
                   goup (create-goup (first args) id)]
               (swap! objs assoc id (:shape-obj goup))
               {id {:goup {}
                    :color (:color goup)
                    :position (:position goup)
                    :shape (:shape goup)
                    :size (:size goup)
                    :kinematic? (:kinematic? goup)}}))))
  (client-update [_ _ _ _ _] nil))

(defn graphics-system [] (GraphicsSystem. (atom {})))

(defn make-goup-via-msg [game spec]
  (send-message game {:entity-id nil
                      :message-id :create-goup
                      :args [spec]}))

(defn make-goups [game]
  (make-goup-via-msg game
           {:name "terrain" :color :gray :position [0 0 0]
            :rotate #(.lookAt % (Vector3f. 0 10 0) Vector3f/UNIT_Y)
            :shape :quad :size [50 50] :kinematic? true})
  (make-goup-via-msg game
          {:name "cyan box" :color :cyan :position [3 5 -3]
           :shape :box :size [1 1 1] :kinematic? false}))

;; Make 
  

;; Testing stuff out
(defn cyan-box []
  (doto
      (create-geometry "cyan box"
                       (create-box 1 1 1)
                       (create-colored-unshaded-mat :cyan))
    (.setUserData "id" (.toString (java.util.UUID/randomUUID)))
    (.setLocalTranslation 3 5 -3)))

;; Not working...
(defn flat-ground []
  (let [g (create-geometry "terrain"
                           (create-quad 50 50)
                           (create-colored-unshaded-mat :gray))]
    (.setUserData g "id" (.toString (java.util.UUID/randomUUID)))
    (.lookAt g (Vector3f. 0 10 0) Vector3f/UNIT_Y)
    g))

(defn spin-box! [box]
  (let [f (fn [tps]
            (print "foo")
            (.rotate box 0 (* tps 2) 0))
        id (.getUserData box "id")]
    (goupgame/add-update-fn (keyword id) f)))

(defn stop-spin-box! [box]
  (let [id (.getUserData box "id")]
    (goupgame/remove-update-fn (keyword id))))

(defn debug-physics []
  (.enableDebug (.getPhysicsSpace physics-state) asset-manager))

;; Creating things in the scene has quite a few steps. This should be
;; broken out to having a spec and then getting an object back that is
;; built from it.

;; Map used to describe a goup you want to create. All of this only
;; works in the context of an already loaded scene remember.
;; Size is specific to whatever the shape is.

;; TODO: Deal with destroying goup too.
;; TODO: Return different data, have a function to get the current
;; state of the goup. This is a value that will change but should
;; be something you can get concistantly in an update loop and work with.

(defn test-scene []
  {:floor (create-goup
           {:name "terrain" :color :gray :position [0 0 0]
            :rotate #(.lookAt % (Vector3f. 0 10 0) Vector3f/UNIT_Y)
            :shape :quad :size [50 50] :kinematic? true})
   :cyan (create-goup
          {:name "cyan box" :color :cyan :position [3 5 -3]
           :shape :box :size [1 1 1] :kinematic? false})
   :green (create-goup
           {:name "green box" :color :green :position [8 12 -10]
            :shape :box :size [1 2 3] :kinematic? false})
   :red (create-goup
         {:name "red box" :color :red :position [10 5 -6]
          :shape :box :size [1 2 1] :kinematic? false})
   :yellow (create-goup
            {:name "barrow" :color :yellow :position [18 20 -16]
             :shape :box :size [1 2 3] :kinematic? false})
   })

;; Going to get a player character controller going to walk around and stuff.
(defn background-setup []
  (.setBackgroundColor view-port (ColorRGBA. 0.7 0.8 1.0 1.0))
  (.setMoveSpeed fly-cam 5))

(defn create-player []
  (let [shape (CapsuleCollisionShape. 1.0 6.0 1.0)
        controller (CharacterControl. shape 0.05)]
    (.setJumpSpeed controller 20)
    (.setFallSpeed controller 30)
    (.setGravity controller 30)
    ;; It's a physics object, not a graphics one so we use physics
    ;; location.
    (.setPhysicsLocation controller (Vector3f. 30 5 -30))
    (.add (.getPhysicsSpace physics-state) controller)
    controller))

(defn setup-keys
  []
  (.addMapping input-manager "Left" (KeyTrigger. KeyInput/KEY_A))
  (.addMapping input-manager "Right" (KeyTrigger. KeyInput/KEY_D))
  (.addMapping input-manager "Up" (KeyTrigger. KeyInput/KEY_W))
  (.addMapping input-manager "Down" (KeyTrigger. KeyInput/KEY_S))
  (.addMapping input-manager "Jump" (KeyTrigger. KeyInput/KEY_SPACE))
  (.addListener input-manager this "Left")
  (.addListener input-manager this "Right")
  (.addListener input-manager this "Up")
  (.addListener input-manager this "Down")
  (.addListener input-manager this "Jump"))

;; I need a good way to deal with user input, collecting user imput,
;; stuff like that.

;; One option, have the ability to send messages to an entity. I
;; already see that there will need to be a serverside update function
;; and a clientside update function on entities. Messages could go to
;; all clients and the server so that could be one way to communicate
;; accross boundaries. This would mean the client code for the player
;; would only run on the entity with the component :main-payer and it
;; would be set up in a way that when a player joins the game only the
;; one that is local is the main player.

;; Selecting a block to pick up.
;; System [:player :main-player]
;; Reads input from the global :input. (Is that the right way to do
;; it?)
;;

;; Messages get sent to entities, this is how new shit happens yo!
;; like, (send-message {:type :create-goup :components :goup 
(defrecord Message [components type data])


;; Systems are the main way that the world operates....
;; They run every update, they get called with any entities that have
;; the components they care about, or have messages on them about
;; those components.


;; So changing an entity's components on the server does not change
;; things on the client. You need to use the sync system on that
;; component to change it on the client or respond to a message in
;; both update functions.

;; Messages are only around for 1 render.
;; Need to set up shit like component creator and loading entitites
;; over the network and all that crap. Hopefully just have to write it
;; once and then can have a better api. Holy shit if I could store the
;; physics and scene stuff just in a render system would be life be
;; easeir!
;; Maybe a render-physics-system since it has to deal with 2 things....

(defn register-system!
  "Registers system as active TODO: Once multiplayer is here I need
  a way to send any new systems to the clients and enable them
  there too. Maybe a system sending system (OMG!)"
  [system]
  (;dostuff
   ))

(defn do-everything []
  (let [g (make-game)
        s (graphics-system)]
    (start g)
    (add-system! g s)
    (make-goups g)))

goup.java

package goupgame;

import clojure.lang.Atom;
import clojure.lang.Compiler;
import clojure.lang.IPersistentMap;
import clojure.lang.PersistentHashMap;
import clojure.lang.RT;
import clojure.lang.Var;
import com.jme3.app.SimpleApplication;
import com.jme3.input.controls.ActionListener;
import com.jme3.renderer.RenderManager;
import java.io.BufferedReader;
import java.io.InputStream;
import java.io.InputStreamReader;

public class Main extends SimpleApplication {
    
    public IPersistentMap contextMap;
    public Var callQueued;
    public Var callUpdate;
    
    public static void main(String[] args) {
        Main app = new Main();
        app.start();
    }

    @Override
    public void simpleInitApp() {
        // Load context objects into map to be passed to clojure.
        // These include refs of the overload functions so we
        // can dynamically change them and private stuff in this class
        // so clojure can see it.
        // May use some core.async channels for this instead of atoms.
        
        // update, for things that run every update.
        // call-now, for things you just want to run but on the correct
        // thread so it doesn't screw up the graphics. Everything that
        // comes through nrepl will run like this so might not need it
        // in the map once that is set up.
        
        contextMap = PersistentHashMap.create("assetManager", assetManager,
                                           "rootNode", rootNode,
                                           "stateManager", stateManager,
                                           "inputManager", inputManager,
                                           "viewPort", viewPort,
                                           "flyCam", flyCam,
                                           "this", this);
        
        InputStream inp = getClass().getResourceAsStream("/bootstrap.clj");
        
        // Set up nrepl.
        try {
            RT.load("clojure/core");
            Compiler.load(new BufferedReader(new InputStreamReader(inp)));
            Var constantly = RT.var("clojure.core", "constantly");
            Var alter = RT.var("clojure.core", "alter-var-root");
            alter.invoke(RT.var("goupgame", "*context*"), constantly.invoke(contextMap));
            callQueued = RT.var("goupgame", "call-queued-fns");
            callUpdate = RT.var("goupgame", "call-update-fns");
            
        } catch (Exception e) {
            e.printStackTrace();
        }
    }

    @Override
    public void simpleUpdate(float tpf) {
       callQueued.invoke();
       callUpdate.invoke(tpf);
    }

    @Override
    public void simpleRender(RenderManager rm) {
        //TODO: add render code
    }
}