From da9b61c47e290e43f76bc431953527481b325ab3 Mon Sep 17 00:00:00 2001
From: oakes <zsoakes@gmail.com>
Date: Sat, 18 Jan 2014 00:23:08 -0500
Subject: [PATCH] Auto-destroy bodies

---
 src/play_clj/core_graphics.clj | 18 +++++++++++---
 src/play_clj/g2d_physics.clj   | 45 ++++++++++++++++++++++++++++++----
 2 files changed, 54 insertions(+), 9 deletions(-)

diff --git a/src/play_clj/core_graphics.clj b/src/play_clj/core_graphics.clj
index 96fc543..cded9e6 100644
--- a/src/play_clj/core_graphics.clj
+++ b/src/play_clj/core_graphics.clj
@@ -12,14 +12,24 @@
   (remove-input! renderer)
   (add-input! renderer))
 
+(defn ^:private update-box-2d!
+  [{:keys [^World world]} entities]
+  (when-not (.isLocked world)
+    (let [bodies (u/gdx-array [])]
+      (.getBodies world bodies)
+      (doseq [body bodies]
+        (when-not (some #(= body (:body %)) entities)
+          (.destroyBody world body))))))
+
 (defn ^:private update-screen!
   ([{:keys [world g2dp-listener]}]
     (when (isa? (type world) World)
       (.setContactListener ^World world g2dp-listener)))
-  ([{:keys [renderer] :as screen} entities]
-    (cond
-      (isa? (type renderer) Stage)
-      (update-stage! screen entities))))
+  ([{:keys [renderer world] :as screen} entities]
+    (when (isa? (type renderer) Stage)
+      (update-stage! screen entities))
+    (when (isa? (type world) World)
+      (update-box-2d! screen entities))))
 
 ; tiled maps
 
diff --git a/src/play_clj/g2d_physics.clj b/src/play_clj/g2d_physics.clj
index 49be215..d873594 100644
--- a/src/play_clj/g2d_physics.clj
+++ b/src/play_clj/g2d_physics.clj
@@ -2,7 +2,8 @@
   (:require [play-clj.math :as m]
             [play-clj.utils :as u])
   (:import [com.badlogic.gdx.physics.box2d Body BodyDef ChainShape CircleShape
-            ContactListener EdgeShape FixtureDef PolygonShape Transform World]))
+            Contact ContactListener EdgeShape Fixture FixtureDef PolygonShape
+            Transform World]))
 
 ; world
 
@@ -68,19 +69,23 @@
 
 (defn body-transform!
   [entity x y angle]
-  (body! entity :set-transform x y angle))
+  (body! entity :set-transform x y angle)
+  entity)
 
 (defn body-x!
   [entity x]
-  (body-transform! entity x (body-y entity) (body-angle entity)))
+  (body-transform! entity x (body-y entity) (body-angle entity))
+  entity)
 
 (defn body-y!
   [entity y]
-  (body-transform! entity (body-x entity) y (body-angle entity)))
+  (body-transform! entity (body-x entity) y (body-angle entity))
+  entity)
 
 (defn body-angle!
   [entity angle]
-  (body-transform! entity (body-x entity) (body-y entity) angle))
+  (body-transform! entity (body-x entity) (body-y entity) angle)
+  entity)
 
 ; fixtures
 
@@ -149,6 +154,36 @@
   [object k & options]
   `(u/call! ^PolygonShape ~object ~k ~@options))
 
+; misc functions
+
+(defmacro contact!
+  [object k & options]
+  `(u/call! ^Contact ~object ~k ~@options))
+
+(defmacro fixture!
+  [object k & options]
+  `(u/call! ^Fixture ~object ~k ~@options))
+
+(defn find-body
+  [body entities]
+  (some #(if (= body (:body %)) %) entities))
+
+(defn first-contact
+  ([screen]
+    (let [^Contact contact (or (:contact screen) screen)]
+      (assert contact)
+      (-> contact .getFixtureA .getBody)))
+  ([screen entities]
+    (find-body (first-contact screen) entities)))
+
+(defn second-contact
+  ([screen]
+    (let [^Contact contact (or (:contact screen) screen)]
+      (assert contact)
+      (-> contact .getFixtureB .getBody)))
+  ([screen entities]
+    (find-body (second-contact screen) entities)))
+
 ; listeners
 
 (defn contact-listener