notid/play-clj
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

Add g3d-physics

Browse Source
This commit is contained in:
oakes
2014-04-16 13:10:47 -04:00
parent b523b237db
commit 3298382982
9 changed files with 441 additions and 92 deletions
Download Patch File Download Diff File Expand all files Collapse all files

11
doclet/resources/classes.edn
View File

@@ -23,9 +23,10 @@
"BlendingAttribute" {"attribute :blending" :constructors
"attribute-type :blending" :static-fields
"attribute! :blending" :static-methods}
"Body" {"create-body!" :methods
"body!" :methods}
"Body" {"body!" :methods}
"BodyDef" {"body-def" :fields}
"BoundingBox" {"bounding-box" :methods
"bounding-box!" :methods}
"Bresenham2" {"bresenham-2" :methods
"bresenham-2!" :methods}
"BSpline" {"b-spline" :methods
@@ -183,6 +184,8 @@
"PulleyJointDef" {"joint-def :pulley" :fields}
"Quaternion" {"quaternion" :methods
"quaternion!" :methods}
"Ray" {"ray" :methods
"ray!" :methods}
"Rectangle" {"rectangle" :methods
"rectangle!" :methods}
"RectangleMapObject" {"map-object :rectangle" :methods}
@@ -192,6 +195,8 @@
"ScrollPane" {"scroll-pane" :methods
"scroll-pane!" :methods}
"ScrollPane.ScrollPaneStyle" {"style :scroll-pane" :constructors}
"Segment" {"segment" :methods
"segment!" :methods}
"SelectBox" {"select-box" :methods
"select-box!" :methods}
"SelectBox.SelectBoxStyle" {"style :select-box" :constructors}
@@ -208,6 +213,8 @@
"sound!" :methods}
"SoundLoader" {"loader :sound" :constructors
"loader! :sound" :methods}
"Sphere" {"sphere" :methods
"sphere!" :methods}
"SplitPane.SplitPaneStyle" {"style :split-pane" :constructors}
"SpriteDrawable" {"drawable :sprite" :constructors}
"Stack" {"stack" :methods

1
project.clj
View File

@@ -4,6 +4,7 @@
:license {:name "Public Domain"
:url "http://unlicense.org/UNLICENSE"}
:dependencies [[com.badlogicgames.gdx/gdx "1.0-SNAPSHOT"]
[com.badlogicgames.gdx/gdx-bullet "1.0-SNAPSHOT"]
[org.clojure/clojure "1.5.1"]]
:repositories [["sonatype"
"https://oss.sonatype.org/content/repositories/snapshots/"]])

13
src/play_clj/core.clj
View File

@@ -8,7 +8,8 @@
[com.badlogic.gdx.assets AssetManager]
[com.badlogic.gdx.assets.loaders AsynchronousAssetLoader]
[com.badlogic.gdx.graphics Camera Color GL20 OrthographicCamera
PerspectiveCamera Pixmap Pixmap$Format PixmapIO Texture VertexAttributes$Usage]
PerspectiveCamera Pixmap Pixmap$Format PixmapIO Texture
VertexAttributes$Usage]
[com.badlogic.gdx.graphics.g2d SpriteBatch]
[com.badlogic.gdx.graphics.g3d ModelBatch]
[com.badlogic.gdx.graphics.glutils ShapeRenderer]
@@ -24,7 +25,6 @@
IsometricStaggeredTiledMapRenderer
IsometricTiledMapRenderer
OrthogonalTiledMapRenderer]
[com.badlogic.gdx.physics.box2d ContactListener Joint World]
[com.badlogic.gdx.scenes.scene2d Actor Stage]
[com.badlogic.gdx.scenes.scene2d.utils ActorGestureListener Align
ChangeListener ClickListener DragListener FocusListener]
@@ -35,6 +35,7 @@
(load "core_cameras")
(load "core_graphics")
(load "core_listeners")
(load "core_physics")
(load "core_utils")
(defn ^:private reset-changed!
@@ -74,9 +75,11 @@
:update-fn! #(apply swap! screen %1 %2)
:execute-fn! execute-fn!
:on-timer on-timer
:ui-listeners (ui-listeners options execute-fn!)
:g2dp-listener (contact-listener options execute-fn!))
(execute-fn! on-show))
:ui-listeners (ui-listeners options execute-fn!))
(execute-fn! on-show)
(swap! screen assoc
:physics-listeners
(physics-listeners @screen options execute-fn!)))
:render (fn [d]
(swap! screen #(assoc % :total-time (+ (:total-time %) d)))
(execute-fn! on-render :delta-time d))

45
src/play_clj/core_listeners.clj
View File

@@ -160,20 +160,11 @@
(drag-listener options execute-fn!)
(focus-listener options execute-fn!)])
; g2d-physics
(defmulti physics-listeners
(fn [screen options execute-fn!] (-> screen :world class))
:default nil)
(defn ^:private contact-listener
[{: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 physics-listeners nil [_ _ _])
; update functions
@@ -195,32 +186,18 @@
(remove-input! renderer)
(add-input! renderer)))
(defn ^:private update-box-2d!
([{:keys [^World world g2dp-listener]}]
(.setContactListener world g2dp-listener))
([{:keys [^World world]} entities]
(when-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)))))))
(defmulti update-physics!
(fn [screen & [entities]] (-> screen :world class))
:default nil)
(defmethod update-physics! nil [_ & _])
(defn ^:private update-screen!
([{:keys [renderer world] :as screen}]
(when (isa? (type renderer) Stage)
(update-stage! screen))
(when (isa? (type world) World)
(update-box-2d! screen)))
(update-physics! screen))
([{: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))))
(update-physics! screen entities)))

30
src/play_clj/core_physics.clj Normal file
View File

@@ -0,0 +1,30 @@
(in-ns 'play-clj.core)
(defmulti step!
"Runs the physics simulations for a single frame and optionally returns the
`entities` with their positions updated."
(fn [screen & [entities]] (-> screen (u/get-obj :world) class)))
(defmulti add-body!
"Adds the `body` to the `screen` for physics simulations and returns it."
(fn [screen body] (-> screen (u/get-obj :world) class)))
(defmulti body-position!
"Changes the position of the body in `entity`."
(fn [entity a1 a2 a3] (-> entity (u/get-obj :body) class)))
(defmulti body-x!
"Changes the `x` of the body in `entity`."
(fn [entity x] (-> entity (u/get-obj :body) class)))
(defmulti body-y!
"Changes the `y` of the body in `entity`."
(fn [entity y] (-> entity (u/get-obj :body) class)))
(defmulti body-z!
"Changes the `z` of the body in `entity`."
(fn [entity z] (-> entity (u/get-obj :body) class)))
(defmulti body-angle!
"Changes the `angle` of the body in `entity`."
(fn [entity angle] (-> entity (u/get-obj :body) class)))

7
src/play_clj/entities.clj
View File

@@ -54,9 +54,14 @@
(.draw object ^SpriteBatch batch 1)))
(defrecord ModelEntity [object] Entity
(draw-entity! [{:keys [^ModelInstance object]}
(draw-entity! [{:keys [^ModelInstance object x y z]}
{:keys [^ModelBatch renderer ^Environment attributes]}
_]
(let [^Matrix4 m (. object transform)
x (float (or x 0))
y (float (or y 0))
z (float (or z 0))]
(.setTranslation m x y z))
(.render renderer object attributes)))
(defrecord ShapeEntity [object] Entity

119
src/play_clj/g2d_physics.clj
View File

@@ -1,9 +1,10 @@
(ns play-clj.g2d-physics
(:require [play-clj.math :as m]
(:require [play-clj.core :as c]
[play-clj.math :as m]
[play-clj.utils :as u])
(:import [com.badlogic.gdx.physics.box2d Body BodyDef ChainShape CircleShape
Contact EdgeShape Fixture FixtureDef JointDef PolygonShape Transform
World]))
Contact ContactListener EdgeShape Fixture FixtureDef Joint JointDef
PolygonShape Transform World]))
; world
@@ -51,51 +52,37 @@
`(let [^Body object# (u/get-obj ~entity :body)]
(u/call! object# ~k ~@options)))
(defn create-body!*
[screen b-def]
(box-2d! screen :create-body b-def))
(defmacro create-body!
"Returns a [Body](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/physics/box2d/Body.html)."
[screen b-def & options]
`(let [^Body object# (create-body!* ~screen ~b-def)]
(u/calls! object# ~@options)))
(defn body-x
"Returns the x position of the body in `entity`."
(defn ^:private body-x
[entity]
(. (body! entity :get-position) x))
(defn body-y
"Returns the y position of the body in `entity`."
(defn ^:private body-y
[entity]
(. (body! entity :get-position) y))
(defn body-angle
"Returns the angle of the body in `entity`."
(defn ^:private body-angle
[entity]
(.getRotation ^Transform (body! entity :get-transform)))
(defn body-transform!
"Changes the `x`, `y`, and `angle` of the body in `entity`."
(defmethod c/body-position!
Body
[entity x y angle]
(body! entity :set-transform x y angle)
entity)
(body! entity :set-transform x y angle))
(defn body-x!
"Changes the `x` of the body in `entity`."
(defmethod c/body-x!
Body
[entity x]
(body-transform! entity x (body-y entity) (body-angle entity)))
(c/body-position! entity x (body-y entity) (body-angle entity)))
(defn body-y!
"Changes the `y` of the body in `entity`."
(defmethod c/body-y!
Body
[entity y]
(body-transform! entity (body-x entity) y (body-angle entity)))
(c/body-position! entity (body-x entity) y (body-angle entity)))
(defn body-angle!
"Changes the `angle` of the body in `entity`."
(defmethod c/body-angle!
Body
[entity angle]
(body-transform! entity (body-x entity) (body-y entity) angle))
(c/body-position! entity (body-x entity) (body-y entity) angle))
; joints
@@ -228,22 +215,56 @@
(assert contact)
(-> contact .getFixtureB .getBody)))
(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]
(defmethod c/add-body!
World
[screen b-def]
(box-2d! screen :create-body b-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
(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!
World
[{:keys [^World world physics-listeners]} & [entities]]
(.setContactListener world (:contact physics-listeners))
(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))))))
(defmethod c/step!
World
[{:keys [^World world time-step velocity-iterations position-iterations]
:or {time-step (/ 1 60) velocity-iterations 10 position-iterations 10}
:as screen}]
(assert world)
(cond
(isa? (type world) World)
(.step ^World world time-step velocity-iterations position-iterations)))
([screen entities]
(step! screen)
(map (fn [entity]
(if-let [body (:body entity)]
(assoc entity
:x (body-x body)
:y (body-y body))
entity))
:as screen}
& [entities]]
(.step world time-step velocity-iterations position-iterations)
(when entities
(map (fn [e]
(if (u/get-obj e :body)
(assoc e
:x (body-x e)
:y (body-y e))
e))
entities)))

234
src/play_clj/g3d_physics.clj Normal file
View File

@@ -0,0 +1,234 @@
(ns play-clj.g3d-physics
(:require [play-clj.core :as c]
[play-clj.math :as m]
[play-clj.utils :as u])
(:import [com.badlogic.gdx.math Matrix4]
[com.badlogic.gdx.physics.bullet Bullet]
[com.badlogic.gdx.physics.bullet.collision btBoxShape
btCollisionDispatcher btCylinderShape btCollisionObject
btCollisionWorld btDefaultCollisionConfiguration btDbvtBroadphase
btSphereShape]
[com.badlogic.gdx.physics.bullet.dynamics btDiscreteDynamicsWorld
btRigidBody btRigidBody$btRigidBodyConstructionInfo
btSequentialImpulseConstraintSolver]
[com.badlogic.gdx.physics.bullet.linearmath btMotionState]))
(def ^:private init (delay (Bullet/init)))
; world
(defn ^:private discrete-dynamics
[]
(let [config (btDefaultCollisionConfiguration.)
dispatcher (btCollisionDispatcher. config)
broad (btDbvtBroadphase.)
solver (btSequentialImpulseConstraintSolver.)]
(btDiscreteDynamicsWorld. dispatcher broad solver config)))
(defn bullet-3d*
[type]
@init
(case type
:discrete-dynamics (discrete-dynamics)
(u/throw-key-not-found type)))
(defmacro bullet-3d
"Returns a subclass of btCollisionWorld.
(bullet-3d :discrete-dynamics)"
[type & options]
`(let [^btCollisionWorld object# (bullet-3d* ~type)]
(u/calls! object# ~@options)))
(defmacro bullet-3d!
"Calls a single method on a `bullet-3d`."
[screen k & options]
`(let [^btCollisionWorld object# (u/get-obj ~screen :world)]
(u/call! object# ~k ~@options)))
; bodies
(defn basic-body*
[]
(btCollisionObject.))
(defmacro basic-body
"Returns a btCollisionObject."
[& options]
`(u/calls! ^btCollisionObject (basic-body*) ~@options))
(defmacro basic-body!
"Calls a single method on a `basic-body`."
[object k & options]
`(u/call! ^btCollisionObject (u/get-obj ~object :body) ~k ~@options))
(defn rigid-body*
[info]
(btRigidBody. info))
(defmacro rigid-body
"Returns a btRigidBody."
[info & options]
`(u/calls! ^btRigidBody (rigid-body* ~info) ~@options))
(defmacro rigid-body!
"Calls a single method on a `rigid-body`."
[object k & options]
`(u/call! ^btRigidBody (u/get-obj ~object :body) ~k ~@options))
(defn rigid-body-info
"Returns a btRigidBodyConstructionInfo."
[mass motion-state collision-shape local-inertia]
(btRigidBody$btRigidBodyConstructionInfo.
mass motion-state collision-shape local-inertia))
(defmacro rigid-body-info!
"Calls a single method on a `rigid-body-info`."
[object k & options]
`(u/call! ^btRigidBody$btRigidBodyConstructionInfo ~object ~k ~@options))
(defn ^:private body-x
[entity]
(let [^btCollisionObject object (u/get-obj entity :body)]
(-> object .getWorldTransform (. val) (aget Matrix4/M03))))
(defn ^:private body-y
[entity]
(let [^btCollisionObject object (u/get-obj entity :body)]
(-> object .getWorldTransform (. val) (aget Matrix4/M13))))
(defn ^:private body-z
[entity]
(let [^btCollisionObject object (u/get-obj entity :body)]
(-> object .getWorldTransform (. val) (aget Matrix4/M23))))
(defmethod c/body-position!
btCollisionObject
[entity x y z]
(let [^btCollisionObject object (u/get-obj entity :body)]
(.setWorldTransform object
(doto (m/matrix-4*)
(m/matrix-4! :set-translation x y z)))))
(defmethod c/body-x!
btCollisionObject
[entity x]
(c/body-position! entity x (body-y entity) (body-z entity)))
(defmethod c/body-y!
btCollisionObject
[entity y]
(c/body-position! entity (body-x entity) y (body-z entity)))
(defmethod c/body-z!
btCollisionObject
[entity z]
(c/body-position! entity (body-x entity) (body-y entity) z))
; shapes
(defn box-shape*
[box-half-extents]
(btBoxShape. box-half-extents))
(defmacro box-shape
"Returns a btSphereShape."
[box-half-extents & options]
`(u/calls! ^btBoxShape (box-shape* ~box-half-extents) ~@options))
(defmacro box-shape!
"Calls a single method on a `box-shape`."
[object k & options]
`(u/call! ^btBoxShape ~object ~k ~@options))
(defn cylinder-shape*
[half-extents]
(btCylinderShape. half-extents))
(defmacro cylinder-shape
"Returns a btCylinderShape."
[half-extents & options]
`(u/calls! ^btCylinderShape (cylinder-shape* ~half-extents) ~@options))
(defmacro cylinder-shape!
"Calls a single method on a `cylinder-shape`."
[object k & options]
`(u/call! ^btCylinderShape ~object ~k ~@options))
(defn sphere-shape*
[radius]
(btSphereShape. radius))
(defmacro sphere-shape
"Returns a btSphereShape."
[radius & options]
`(u/calls! ^btSphereShape (sphere-shape* ~radius) ~@options))
(defmacro sphere-shape!
"Calls a single method on a `sphere-shape`."
[object k & options]
`(u/call! ^btSphereShape ~object ~k ~@options))
; misc
(defmethod c/add-body!
btCollisionWorld
[screen body]
(cond
(isa? (type body) btRigidBody)
(bullet-3d! screen :add-rigid-body body)
:else
(bullet-3d! screen :add-collision-object body))
body)
(defn ^:private get-bodies
[screen]
(let [arr (bullet-3d! screen :get-collision-object-array)]
(for [i (range (.size arr))]
(.at arr i))))
(defmethod c/update-physics!
btCollisionWorld
[screen & [entities]]
; initialize bodies
(doseq [e entities]
(let [object (u/get-obj e :object)
body (u/get-obj e :body)]
(when (and object body)
(cond
(isa? (type body) btRigidBody)
(when-not (rigid-body! body :get-motion-state)
(rigid-body! body
:set-motion-state
(proxy [btMotionState] []
(getWorldTransform [world-t])
(setWorldTransform [world-t]
(m/matrix-4! (. object transform) :set world-t)))))
:else
(.setWorldTransform body (. object transform))))))
; remove bodies that no longer exist
(when entities
(doseq [body (get-bodies screen)]
(when-not (some #(= body (:body %)) entities)
(cond
(isa? (type body) btRigidBody)
(bullet-3d! screen :remove-rigid-body body)
:else
(bullet-3d! screen :remove-collision-object body))))))
(defmethod c/step!
btCollisionWorld
[{:keys [^btCollisionWorld world delta-time max-sub-steps time-step]
:or {max-sub-steps 5 time-step (/ 1 60)}
:as screen}
& [entities]]
(.stepSimulation world delta-time max-sub-steps time-step)
(when entities
(map (fn [e]
(if (u/get-obj e :body)
(assoc e
:x (body-x e)
:y (body-y e)
:z (body-z e))
e))
entities)))

73
src/play_clj/math.clj
View File

@@ -4,7 +4,8 @@
Circle ConvexHull DelaunayTriangulator EarClippingTriangulator
Ellipse FloatCounter Frustum GridPoint2 GridPoint3 Matrix3 Matrix4
Plane Polygon Polyline Quaternion Rectangle Vector2 Vector3
WindowedMean]))
WindowedMean]
[com.badlogic.gdx.math.collision BoundingBox Ray Segment Sphere]))
; static methods/fields
@@ -436,3 +437,73 @@
"Calls a single method on a `windowed-mean`."
[object k & options]
`(u/call! ^WindowedMean ~object ~k ~@options))
; bounding-box
(defn bounding-box*
([]
(BoundingBox.))
([box]
(BoundingBox. box))
([min max]
(BoundingBox. min max)))
(defmacro bounding-box
"Returns a [BoundingBox](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/math/collision/BoundingBox.html)."
[min max & options]
`(u/calls! ^BoundingBox (bounding-box* ~min ~max) ~@options))
(defmacro bounding-box!
"Calls a single method on a `bounding-box`."
[object k & options]
`(u/call! ^BoundingBox ~object ~k ~@options))
; ray
(defn ray*
[origin direction]
(Ray. origin direction))
(defmacro ray
"Returns a [Ray](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/math/collision/Ray.html)."
[origin direction & options]
`(u/calls! ^Ray (ray* ~origin ~direction) ~@options))
(defmacro ray!
"Calls a single method on a `ray`."
[object k & options]
`(u/call! ^Ray ~object ~k ~@options))
; segment
(defn segment*
([a-x a-y a-z b-x b-y b-z]
(Segment. a-x a-y a-z b-x b-y b-z))
([a b]
(Segment. a b)))
(defmacro segment
"Returns a [Segment](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/math/collision/Segment.html)."
[a b & options]
`(u/calls! ^Segment (segment* ~a ~b) ~@options))
(defmacro segment!
"Calls a single method on a `segment`."
[object k & options]
`(u/call! ^Segment ~object ~k ~@options))
; sphere
(defn sphere*
[center radius]
(Sphere. center radius))
(defmacro sphere
"Returns a [Sphere](http://libgdx.badlogicgames.com/nightlies/docs/api/com/badlogic/gdx/math/collision/Sphere.html)."
[center radius & options]
`(u/calls! ^Sphere (sphere* ~center ~radius) ~@options))
(defmacro sphere!
"Calls a single method on a `sphere`."
[object k & options]
`(u/call! ^Sphere ~object ~k ~@options))