Add contact listener for 3D physics

doclet/resources/classes.edn

@@ -42,7 +42,6 @@
  "ColorAttribute" {"attribute :color" :constructors
                    "attribute-type :color" :static-fields
                    "attribute! :color" :static-methods}
- "Contact" {"contact!" :methods}
  "ConvexHull" {"convex-hull" :methods
                "convex-hull!" :methods}
  "ChainShape" {"chain-shape" :methods

project.clj

@@ -7,4 +7,6 @@
                  [com.badlogicgames.gdx/gdx-bullet "1.0-SNAPSHOT"]
                  [org.clojure/clojure "1.6.0"]]
   :repositories [["sonatype"
-                  "https://oss.sonatype.org/content/repositories/snapshots/"]])
+                  "https://oss.sonatype.org/content/repositories/snapshots/"]]
+  :source-paths ["src"]
+  :java-source-paths ["src-java"])

src-java/play_clj/g3d_physics/ContactListener.java

@@ -0,0 +1,20 @@
+package play_clj.g3d_physics;
+
+import clojure.lang.IFn;
+
+public class ContactListener extends com.badlogic.gdx.physics.bullet.collision.ContactListener {
+	IFn started, ended;
+	
+	public ContactListener(IFn started, IFn ended) {
+		this.started = started;
+		this.ended = ended;
+	}
+	
+	public void onContactStarted(btCollisionObject a, btCollisionObject b) {
+		started.invoke(a, b);
+	}
+
+	public void onContactEnded(btCollisionObject a, btCollisionObject b) {
+		ended.invoke(a, b);
+	}
+}

src/play_clj/core.clj

@@ -77,9 +77,9 @@
                     :on-timer on-timer
                     :ui-listeners (ui-listeners options execute-fn!))
              (execute-fn! on-show)
-             (swap! screen assoc
+             (when-not (:contact-listener @screen)
-                    :physics-listeners
+               (->> (contact-listener @screen options execute-fn!)
-                    (physics-listeners @screen options execute-fn!)))
+                    (swap! screen assoc :contact-listener))))
      :render (fn [d]
                (swap! screen #(assoc % :total-time (+ (:total-time %) d)))
                (execute-fn! on-render :delta-time d))

src/play_clj/core_listeners.clj

@@ -160,11 +160,11 @@
    (drag-listener options execute-fn!)
    (focus-listener options execute-fn!)])
 
-(defmulti physics-listeners
+(defmulti contact-listener
   (fn [screen options execute-fn!] (-> screen :world class))
   :default nil)
 
-(defmethod physics-listeners nil [_ _ _])
+(defmethod contact-listener nil [_ _ _])
 
 ; update functions
 

src/play_clj/core_physics.clj

@@ -36,3 +36,13 @@ should be x, y, and angle, whereas for 3D physics they should be x, y, and z."
 (defmulti body-angle!
   "Changes the `angle` of the body in `entity`. Only works with 2D physics."
   (fn [entity angle] (-> entity (u/get-obj :body) class)))
+
+(defmulti first-entity
+  "Returns the first entity in a contact. May only be used in contact functions,
+such as :on-begin-contact."
+  (fn [screen entities] (-> screen (u/get-obj :world) class)))
+
+(defmulti second-entity
+  "Returns the second entity in a contact. May only be used in contact functions,
+such as :on-begin-contact."
+  (fn [screen entities] (-> screen (u/get-obj :world) class)))

src/play_clj/g2d_physics.clj

@@ -52,6 +52,11 @@
   `(let [^Body object# (u/get-obj ~entity :body)]
      (u/call! object# ~k ~@options)))
 
+(defmethod c/add-body!
+  World
+  [screen b-def]
+  (box-2d! screen :create-body b-def))
+
 (defn ^:private body-x
   [entity]
   (. (body! entity :get-position) x))
@@ -84,6 +89,22 @@
   [entity angle]
   (c/body-position! entity (body-x entity) (body-y entity) angle))
 
+(defn ^:private find-body
+  [body entities]
+  (some #(if (= body (u/get-obj % :body)) %) entities))
+
+(defmethod c/first-entity
+  World
+  [screen entities]
+  (let [^Contact contact (u/get-obj screen :contact)]
+    (-> contact .getFixtureA .getBody (find-body entities))))
+
+(defmethod c/second-entity
+  World
+  [screen entities]
+  (let [^Contact contact (u/get-obj screen :contact)]
+    (-> contact .getFixtureB .getBody (find-body entities))))
+
 ; joints
 
 (defn ^:private joint-init
@@ -103,6 +124,11 @@
   [object k & options]
   `(u/call! ^Joint ~object ~k ~@options))
 
+(defmethod c/add-joint!
+  World
+  [screen j-def]
+  (box-2d! screen :create-joint j-def))
+
 ; fixtures
 
 (defmacro fixture-def
@@ -181,59 +207,25 @@
 
 ; misc
 
-(defmacro contact!
+(defmethod c/contact-listener
-  "Calls a single method on a [Contact](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/Contact.html)."
-  [screen k & options]
-  `(u/call! ^Contact (u/get-obj ~screen :contact) ~k ~@options))
-
-(defn find-body
-  "Returns the first entity in `entities` whose body matches `body`."
-  [body entities]
-  (some #(if (= body (:body %)) %) entities))
-
-(defn first-body
-  "Returns the first body in a contact."
-  [screen]
-  (let [^Contact contact (u/get-obj screen :contact)]
-    (assert contact)
-    (-> contact .getFixtureA .getBody)))
-
-(defn second-body
-  "Returns the second body in a contact."
-  [screen]
-  (let [^Contact contact (u/get-obj screen :contact)]
-    (assert contact)
-    (-> contact .getFixtureB .getBody)))
-
-(defmethod c/add-body!
-  World
-  [screen b-def]
-  (box-2d! screen :create-body b-def))
-
-(defmethod c/add-joint!
-  World
-  [screen j-def]
-  (box-2d! screen :create-joint j-def))
-
-(defmethod c/physics-listeners
   World
   [screen
    {:keys [on-begin-contact on-end-contact on-post-solve on-pre-solve]}
    execute-fn!]
-  {:contact (reify ContactListener
+  (reify ContactListener
-              (beginContact [this c]
+    (beginContact [this c]
-                (execute-fn! on-begin-contact :contact c))
+      (execute-fn! on-begin-contact :contact c))
-              (endContact [this c]
+    (endContact [this c]
-                (execute-fn! on-end-contact :contact c))
+      (execute-fn! on-end-contact :contact c))
-              (postSolve [this c i]
+    (postSolve [this c i]
-                (execute-fn! on-post-solve :contact c :impulse i))
+      (execute-fn! on-post-solve :contact c :impulse i))
-              (preSolve [this c m]
+    (preSolve [this c m]
-                (execute-fn! on-pre-solve :contact c :old-manifold m)))})
+      (execute-fn! on-pre-solve :contact c :old-manifold m))))
 
 (defmethod c/update-physics!
   World
-  [{:keys [^World world physics-listeners]} & [entities]]
+  [{:keys [^World world contact-listener]} & [entities]]
-  (.setContactListener world (:contact physics-listeners))
+  (.setContactListener world contact-listener)
   (when (and entities (not (.isLocked world)))
     (let [arr (u/gdx-array [])]
       ; remove bodies that no longer exist

src/play_clj/g3d_physics.clj

@@ -14,7 +14,8 @@
            [com.badlogic.gdx.physics.bullet.linearmath btMotionState]
            [com.badlogic.gdx.physics.bullet.softbody btSoftBody
             btSoftBodyRigidBodyCollisionConfiguration btSoftBodyWorldInfo
-            btSoftRigidDynamicsWorld]))
+            btSoftRigidDynamicsWorld]
+           [play_clj.g3d_physics ContactListener]))
 
 (def ^:private init (delay (Bullet/init)))
 
@@ -123,6 +124,16 @@
   []
   (btSoftBodyWorldInfo.))
 
+(defmethod c/add-body!
+  World3D
+  [screen body]
+  (cond
+    (isa? (type (:object body)) btRigidBody)
+    (bullet-3d! screen :add-rigid-body (:object body))
+    (isa? (type (:object body)) btSoftBody)
+    (bullet-3d! screen :add-soft-body (:object body)))
+  body)
+
 (defn ^:private body-x
   [entity]
   (let [^btCollisionObject object (:object (u/get-obj entity :body))]
@@ -161,6 +172,22 @@
   [entity z]
   (c/body-position! entity (body-x entity) (body-y entity) z))
 
+(defn ^:private find-body
+  [body entities]
+  (some #(if (= body (:object (u/get-obj % :body))) %) entities))
+
+(defmethod c/first-entity
+  World3D
+  [screen entities]
+  (-> (u/get-obj screen :first-body)
+      (find-body entities)))
+
+(defmethod c/second-entity
+  World3D
+  [screen entities]
+  (-> (u/get-obj screen :second-body)
+      (find-body entities)))
+
 ; shapes
 
 (defn box-shape*
@@ -235,15 +262,16 @@
 
 ; misc
 
-(defmethod c/add-body!
+(defmethod c/contact-listener
   World3D
-  [screen body]
+  [screen
-  (cond
+   {:keys [on-begin-contact on-end-contact]}
-    (isa? (type (:object body)) btRigidBody)
+   execute-fn!]
-    (bullet-3d! screen :add-rigid-body (:object body))
+  (ContactListener.
-    (isa? (type (:object body)) btSoftBody)
+    (fn [a b]
-    (bullet-3d! screen :add-soft-body (:object body)))
+      (execute-fn! on-begin-contact :first-body a :second-body b))
-  body)
+    (fn [a b]
+      (execute-fn! on-end-contact :first-body a :second-body b))))
 
 (defn ^:private get-bodies
   [screen]