play-clj/src/play_clj/g2d_physics.clj

(ns play-clj.g2d-physics
  (:require [play-clj.core :as c]
            [play-clj.math :as m]
            [play-clj.utils :as u])
  (:import [com.badlogic.gdx.math MathUtils Vector2]
           [com.badlogic.gdx.physics.box2d Body BodyDef ChainShape CircleShape
            Contact ContactListener EdgeShape Fixture FixtureDef Joint JointDef
            PolygonShape Transform]))

; world

(defn box-2d*
  ([]
    (box-2d* 0 0 true))
  ([gravity-x gravity-y]
    (box-2d* gravity-x gravity-y true))
  ([gravity-x gravity-y sleep?]
    ; use reflection to instantiate in order to avoid the static initializer
    (some-> (try (Class/forName "com.badlogic.gdx.physics.box2d.World")
              (catch Exception _))
            .getDeclaredConstructors
            first
            (.newInstance
              (object-array [(m/vector-2 gravity-x gravity-y) sleep?])))))

(defmacro box-2d
  "Returns a [World](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/World.html).

    (box-2d 0 0)"
  [gravity-x gravity-y & options]
  `(let [object# (box-2d* ~gravity-x ~gravity-y)]
     (u/calls! object# ~@options)))

(defmacro box-2d!
  "Calls a single method on a `box-2d`."
  [screen k & options]
  `(let [object# (u/get-obj ~screen :world)]
     (u/call! object# ~k ~@options)))

; bodies

(defn ^:private body-type
  [k]
  (u/gdx-class :physics :box2d :BodyDef
               (str "BodyType/" (u/key->pascal k) "Body")))

(defmacro body-def
  "Returns a [BodyDef](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/BodyDef.html).

    (body-def :dynamic)"
  [k & options]
  `(let [^BodyDef object# (BodyDef.)]
     (u/fields! object# :type ~(body-type k) ~@options)))

(defmacro body!
  "Calls a single method on a body."
  [entity k & options]
  `(let [^Body object# (u/get-obj ~entity :body)]
     (u/call! object# ~k ~@options)))

(defn add-body!
  "Creates a body from `b-def`, adds it to the `screen` and returns it.

    (add-body! screen (body-def :dynamic))"
  [screen b-def]
  (box-2d! screen :create-body b-def))

(defn ^:private body-x
  [entity]
  (. (body! entity :get-position) x))

(defn ^:private body-y
  [entity]
  (. (body! entity :get-position) y))

(defn ^:private body-angle
  [entity]
  (* (body! entity :get-angle) MathUtils/radiansToDegrees))

(defn ^:private body-origin-x
  [entity]
  (. ^Vector2 (body! entity :get-local-center) x))

(defn ^:private body-origin-y
  [entity]
  (. ^Vector2 (body! entity :get-local-center) y))

(defn body-position!
  "Changes the position of the body in `entity`. The angle is in degrees."
  [entity x y angle]
  (body! entity :set-transform x y (* angle MathUtils/degreesToRadians)))

(defn body-x!
  "Changes the `x` of the body in `entity`."
  [entity x]
  (body-position! entity x (body-y entity) (body-angle entity)))

(defn body-y!
  "Changes the `y` of the body in `entity`."
  [entity y]
  (body-position! entity (body-x entity) y (body-angle entity)))

(defn body-angle!
  "Changes the `angle` (degrees) of the body in `entity`."
  [entity angle]
  (body-position! entity (body-x entity) (body-y entity) angle))

(defn ^:private find-body
  [body entities]
  (some #(if (= body (u/get-obj % :body)) %) entities))

(defn first-entity
  "Returns the first entity in a contact. May only be used in contact functions
such as :on-begin-contact."
  [screen entities]
  (let [^Contact contact (u/get-obj screen :contact)]
    (-> contact .getFixtureA .getBody (find-body entities))))

(defn second-entity
  "Returns the second entity in a contact. May only be used in contact functions
such as :on-begin-contact."
  [screen entities]
  (let [^Contact contact (u/get-obj screen :contact)]
    (-> contact .getFixtureB .getBody (find-body entities))))

; joints

(defn ^:private joint-init
  [k]
  (u/gdx :physics :box2d :joints (str (u/key->pascal k) "JointDef.")))

(defmacro joint-def
  "Returns a subclass of [JointDef](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/JointDef.html).

    (joint-def :rope)"
  [k & options]
  `(let [object# (~(joint-init k))]
     (u/fields! object# ~@options)))

(defmacro joint!
  "Calls a single method on a joint."
  [object k & options]
  `(u/call! ^Joint ~object ~k ~@options))

(defn add-joint!
  "Adds the `joint` to the `screen` for physics simulations and returns it."
  [screen j-def]
  (box-2d! screen :create-joint j-def))

; fixtures

(defmacro fixture-def
  "Returns a [FixtureDef](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/FixtureDef.html)."
  [& options]
  `(let [^FixtureDef object# (FixtureDef.)]
     (u/fields! object# ~@options)
     object#))

(defmacro fixture!
  "Calls a single method on a fixture."
  [object k & options]
  `(u/call! ^Fixture ~object ~k ~@options))

; shapes

(defn chain-shape*
  []
  (ChainShape.))

(defmacro chain-shape
  "Returns a [ChainShape](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/ChainShape.html)."
  [& options]
  `(u/calls! ^ChainShape (chain-shape*) ~@options))

(defmacro chain-shape!
  "Calls a single method on a `chain-shape`."
  [object k & options]
  `(u/call! ^ChainShape ~object ~k ~@options))

(defn circle-shape*
  []
  (CircleShape.))

(defmacro circle-shape
  "Returns a [CircleShape](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/CircleShape.html)."
  [& options]
  `(u/calls! ^CircleShape (circle-shape*) ~@options))

(defmacro circle-shape!
  "Calls a single method on a `circle-shape`."
  [object k & options]
  `(u/call! ^CircleShape ~object ~k ~@options))

(defn edge-shape*
  []
  (EdgeShape.))

(defmacro edge-shape
  "Returns an [EdgeShape](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/EdgeShape.html)."
  [& options]
  `(u/calls! ^EdgeShape (edge-shape*) ~@options))

(defmacro edge-shape!
  "Calls a single method on an `edge-shape`."
  [object k & options]
  `(u/call! ^EdgeShape ~object ~k ~@options))

(defn polygon-shape*
  []
  (PolygonShape.))

(defmacro polygon-shape
  "Returns a [PolygonShape](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/PolygonShape.html)."
  [& options]
  `(u/calls! ^PolygonShape (polygon-shape*) ~@options))

(defmacro polygon-shape!
  "Calls a single method on a `polygon-shape`."
  [object k & options]
  `(u/call! ^PolygonShape ~object ~k ~@options))

; misc

(defmethod c/contact-listener
  "com.badlogic.gdx.physics.box2d.World"
  [screen
   {:keys [on-begin-contact on-end-contact on-post-solve on-pre-solve]}
   execute-fn!]
  (reify ContactListener
    (beginContact [this c]
      (execute-fn! on-begin-contact :contact c))
    (endContact [this c]
      (execute-fn! on-end-contact :contact c))
    (postSolve [this c i]
      (execute-fn! on-post-solve :contact c :impulse i))
    (preSolve [this c m]
      (execute-fn! on-pre-solve :contact c :old-manifold m))))

(defmethod c/update-physics!
  "com.badlogic.gdx.physics.box2d.World"
  [{:keys [world contact-listener]} & [entities]]
  (.setContactListener world contact-listener)
  (when (and entities (not (.isLocked world)))
    (let [arr (u/gdx-array [])]
      ; remove bodies that no longer exist
      (.getBodies world arr)
      (doseq [body arr]
        (when-not (some #(= body (:body %)) entities)
          (.destroyBody world body)))
      ; remove joints whose bodies no longer exist
      (.getJoints world arr)
      (doseq [^Joint joint arr]
        (when (and (not (some #(= (.getBodyA joint) (:body %)) entities))
                   (not (some #(= (.getBodyB joint) (:body %)) entities)))
          (.destroyJoint world joint))))))

(defn step!
  "Runs the physics simulations for a single frame and optionally returns the
`entities` with their positions updated."
  ([{:keys [world time-step velocity-iterations position-iterations]
     :or {time-step (/ 1 60) velocity-iterations 10 position-iterations 10}
     :as screen}]
    (.step world time-step velocity-iterations position-iterations))
  ([screen entities]
    (step! screen)
    (map (fn [e]
           (if (:body e)
             (assoc e
                    :x (body-x e)
                    :y (body-y e)
                    :angle (body-angle e)
                    :origin-x (body-origin-x e)
                    :origin-y (body-origin-y e))
             e))
         entities)))