1 files changed, 241 insertions, 241 deletions
diff --git a/Spear/Math/Collision.hs b/Spear/Math/Collision.hs
index 47cc5fd..a69ea7a 100644
--- a/Spear/Math/Collision.hs
+++ b/Spear/Math/Collision.hs
@@ -1,242 +1,242 @@
-module Spear.Math.Collision
+module Spear.Math.Collision
-(
+(
-    CollisionType(..)
+    CollisionType(..)
-    -- * 2D Collision
+    -- * 2D Collision
-,   Collisionable2(..)
+,   Collisionable2(..)
-,   Collisioner2(..)
+,   Collisioner2(..)
-    -- ** Construction
+    -- ** Construction
-,   aabb2Collisioner
+,   aabb2Collisioner
-,   circleCollisioner
+,   circleCollisioner
-,   mkCols
+,   mkCols
-    -- ** Collision test
+    -- ** Collision test
-,   collide
+,   collide
-    -- ** Manipulation
+    -- ** Manipulation
-,   move
+,   move
-    -- ** Helpers
+    -- ** Helpers
-,   buildAABB2
+,   buildAABB2
-,   aabb2FromCircle
+,   aabb2FromCircle
-,   circleFromAABB2
+,   circleFromAABB2
-    -- * 3D Collision
+    -- * 3D Collision
-,   Collisionable3(..)
+,   Collisionable3(..)
-    -- ** Helpers
+    -- ** Helpers
-,   aabb3FromSphere
+,   aabb3FromSphere
-)
+)
-where
+where
-import Spear.Assets.Model
+import Spear.Assets.Model
-import Spear.Math.AABB
+import Spear.Math.AABB
-import Spear.Math.Circle
+import Spear.Math.Circle
-import qualified Spear.Math.Matrix4 as M4
+import qualified Spear.Math.Matrix4 as M4
-import Spear.Math.Plane
+import Spear.Math.Plane
-import Spear.Math.Sphere
+import Spear.Math.Sphere
-import Spear.Math.Vector
+import Spear.Math.Vector
-import Data.List (foldl')
+import Data.List (foldl')
-data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
+data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
-     deriving (Eq, Show)
+     deriving (Eq, Show)
-- 2D collision
+-- 2D collision
-class Collisionable2 a where
+class Collisionable2 a where
-      -- | Collide the object with an AABB.
+      -- | Collide the object with an AABB.
-      collideAABB2 :: AABB2 -> a -> CollisionType
+      collideAABB2 :: AABB2 -> a -> CollisionType
-      -- | Collide the object with a circle.
+      -- | Collide the object with a circle.
-      collideCircle :: Circle -> a -> CollisionType
+      collideCircle :: Circle -> a -> CollisionType
-instance Collisionable2 AABB2 where
+instance Collisionable2 AABB2 where
-    collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2)
+    collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2)
-        | (x max1) < (x min2) = NoCollision
+        | (x max1) < (x min2) = NoCollision
-        | (x min1) > (x max2) = NoCollision
+        | (x min1) > (x max2) = NoCollision
-        | (y max1) < (y min2) = NoCollision
+        | (y max1) < (y min2) = NoCollision
-        | (y min1) > (y max2) = NoCollision
+        | (y min1) > (y max2) = NoCollision
-        | box1 `aabb2pt` min2 && box1 `aabb2pt` max2 = FullyContains
+        | box1 `aabb2pt` min2 && box1 `aabb2pt` max2 = FullyContains
-        | box2 `aabb2pt` min1 && box2 `aabb2pt` max1 = FullyContainedBy
+        | box2 `aabb2pt` min1 && box2 `aabb2pt` max1 = FullyContainedBy
-        | otherwise = Collision
+        | otherwise = Collision
-    collideCircle circle@(Circle c r) aabb@(AABB2 min max)
+    collideCircle circle@(Circle c r) aabb@(AABB2 min max)
-        | test == FullyContains || test == FullyContainedBy = test
+        | test == FullyContains || test == FullyContainedBy = test
-        | normSq (c - boxC) > (l + r)^2 = NoCollision
+        | normSq (c - boxC) > (l + r)^2 = NoCollision
-        | otherwise = Collision
+        | otherwise = Collision
-            where
+            where
-                test = collideAABB2 aabb $ aabb2FromCircle circle
+                test = collideAABB2 aabb $ aabb2FromCircle circle
-                boxC = min + (max-min)/2
+                boxC = min + (max-min)/2
-                l = norm $ min + (vec2 (x boxC) (y min)) - min
+                l = norm $ min + (vec2 (x boxC) (y min)) - min
-instance Collisionable2 Circle where
+instance Collisionable2 Circle where
-    collideAABB2 box circle = case collideCircle circle box of
+    collideAABB2 box circle = case collideCircle circle box of
-        FullyContains    -> FullyContainedBy
+        FullyContains    -> FullyContainedBy
-        FullyContainedBy -> FullyContains
+        FullyContainedBy -> FullyContains
-        x -> x
+        x -> x
-    collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)
+    collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)
-        | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy
+        | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy
-        | distance_centers <= sum_radii = Collision
+        | distance_centers <= sum_radii = Collision
-        | otherwise = NoCollision
+        | otherwise = NoCollision
-        where
+        where
-            distance_centers = normSq $ c1 - c2
+            distance_centers = normSq $ c1 - c2
-            sum_radii    = (r1 + r2)^2
+            sum_radii    = (r1 + r2)^2
-            sub_radii    = (r1 - r2)^2
+            sub_radii    = (r1 - r2)^2
-instance Collisionable2 Collisioner2 where
+instance Collisionable2 Collisioner2 where
-    collideAABB2 box (AABB2Col self)  = collideAABB2 box self
+    collideAABB2 box (AABB2Col self)  = collideAABB2 box self
-    collideAABB2 box (CircleCol self) = collideAABB2 box self
+    collideAABB2 box (CircleCol self) = collideAABB2 box self
-    collideCircle circle (AABB2Col self)  = collideCircle circle self
+    collideCircle circle (AABB2Col self)  = collideCircle circle self
-    collideCircle circle (CircleCol self) = collideCircle circle self
+    collideCircle circle (CircleCol self) = collideCircle circle self
-aabbPoints :: AABB2 -> [Vector2]
+aabbPoints :: AABB2 -> [Vector2]
-aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
+aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
-    where
+    where
-        p1 = vec2 (x min) (y min)
+        p1 = vec2 (x min) (y min)
-        p2 = vec2 (x min) (y min)
+        p2 = vec2 (x min) (y min)
-        p3 = vec2 (x min) (y max)
+        p3 = vec2 (x min) (y max)
-        p4 = vec2 (x min) (y max)
+        p4 = vec2 (x min) (y max)
-        p5 = vec2 (x max) (y min)
+        p5 = vec2 (x max) (y min)
-        p6 = vec2 (x max) (y min)
+        p6 = vec2 (x max) (y min)
-        p7 = vec2 (x max) (y max)
+        p7 = vec2 (x max) (y max)
-        p8 = vec2 (x max) (y max)
+        p8 = vec2 (x max) (y max)
-- | A collisioner component.
+-- | A collisioner component.
-data Collisioner2
+data Collisioner2
-    -- | An axis-aligned bounding box.
+    -- | An axis-aligned bounding box.
-    = AABB2Col {-# UNPACK #-} !AABB2
+    = AABB2Col {-# UNPACK #-} !AABB2
-    -- | A bounding circle.
+    -- | A bounding circle.
-    | CircleCol {-# UNPACK #-} !Circle
+    | CircleCol {-# UNPACK #-} !Circle
-- | Create a collisioner from the specified box.
+-- | Create a collisioner from the specified box.
-aabb2Collisioner :: AABB2 -> Collisioner2
+aabb2Collisioner :: AABB2 -> Collisioner2
-aabb2Collisioner = AABB2Col
+aabb2Collisioner = AABB2Col
-- | Create a collisioner from the specified circle.
+-- | Create a collisioner from the specified circle.
-circleCollisioner :: Circle -> Collisioner2
+circleCollisioner :: Circle -> Collisioner2
-circleCollisioner = CircleCol
+circleCollisioner = CircleCol
-- | Compute AABB collisioners in view space from the given AABB.
+-- | Compute AABB collisioners in view space from the given AABB.
-mkCols :: M4.Matrix4 -- ^ Modelview matrix
+mkCols :: M4.Matrix4 -- ^ Modelview matrix
-       -> Box
+       -> Box
-       -> [Collisioner2]
+       -> [Collisioner2]
-mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) =
+mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) =
-    let
+    let
-        toVec2 v = vec2 (x v) (y v)
+        toVec2 v = vec2 (x v) (y v)
-        p1   = toVec2 $ modelview `M4.mulp` vec3 xmin ymin zmax
+        p1   = toVec2 $ modelview `M4.mulp` vec3 xmin ymin zmax
-        p2   = toVec2 $ modelview `M4.mulp` vec3 xmax ymin zmin
+        p2   = toVec2 $ modelview `M4.mulp` vec3 xmax ymin zmin
-        p3   = toVec2 $ modelview `M4.mulp` vec3 xmax ymax zmin
+        p3   = toVec2 $ modelview `M4.mulp` vec3 xmax ymax zmin
-        col1 = AABB2Col $ AABB2 p1 p2
+        col1 = AABB2Col $ AABB2 p1 p2
-        col2 = AABB2Col $ AABB2 p1 p3
+        col2 = AABB2Col $ AABB2 p1 p3
-    in
+    in
-        [col1, col2]
+        [col1, col2]
-- | Create the minimal AABB fully containing the specified collisioners.
+-- | Create the minimal AABB fully containing the specified collisioners.
-buildAABB2 :: [Collisioner2] -> AABB2
+buildAABB2 :: [Collisioner2] -> AABB2
-buildAABB2 cols = aabb2 $ generatePoints cols
+buildAABB2 cols = aabb2 $ generatePoints cols
-- | Create the minimal box fully containing the specified circle.
+-- | Create the minimal box fully containing the specified circle.
-aabb2FromCircle :: Circle -> AABB2
+aabb2FromCircle :: Circle -> AABB2
-aabb2FromCircle (Circle c r) = AABB2 bot top
+aabb2FromCircle (Circle c r) = AABB2 bot top
-    where
+    where
-        bot = c - (vec2 r r)
+        bot = c - (vec2 r r)
-        top = c + (vec2 r r)
+        top = c + (vec2 r r)
-- | Create the minimal circle fully containing the specified box.
+-- | Create the minimal circle fully containing the specified box.
-circleFromAABB2 :: AABB2 -> Circle
+circleFromAABB2 :: AABB2 -> Circle
-circleFromAABB2 (AABB2 min max) = Circle c r
+circleFromAABB2 (AABB2 min max) = Circle c r
-    where
+    where
-        c = scale 0.5 (min + max)
+        c = scale 0.5 (min + max)
-        r = norm . scale 0.5 $ max - min
+        r = norm . scale 0.5 $ max - min
-generatePoints :: [Collisioner2] -> [Vector2]
+generatePoints :: [Collisioner2] -> [Vector2]
-generatePoints = foldl' generate []
+generatePoints = foldl' generate []
-    where
+    where
-        generate acc (AABB2Col (AABB2 pmin pmax)) = p1:p2:p3:p4:p5:p6:p7:p8:acc
+        generate acc (AABB2Col (AABB2 pmin pmax)) = p1:p2:p3:p4:p5:p6:p7:p8:acc
-            where
+            where
-                p1 = vec2 (x pmin) (y pmin)
+                p1 = vec2 (x pmin) (y pmin)
-                p2 = vec2 (x pmin) (y pmin)
+                p2 = vec2 (x pmin) (y pmin)
-                p3 = vec2 (x pmin) (y pmax)
+                p3 = vec2 (x pmin) (y pmax)
-                p4 = vec2 (x pmin) (y pmax)
+                p4 = vec2 (x pmin) (y pmax)
-                p5 = vec2 (x pmax) (y pmin)
+                p5 = vec2 (x pmax) (y pmin)
-                p6 = vec2 (x pmax) (y pmin)
+                p6 = vec2 (x pmax) (y pmin)
-                p7 = vec2 (x pmax) (y pmax)
+                p7 = vec2 (x pmax) (y pmax)
-                p8 = vec2 (x pmax) (y pmax)
+                p8 = vec2 (x pmax) (y pmax)
-        generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc
+        generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc
-            where
+            where
-                p1 = c + unitx2 * (vec2 r r)
+                p1 = c + unitx2 * (vec2 r r)
-                p2 = c - unitx2 * (vec2 r r)
+                p2 = c - unitx2 * (vec2 r r)
-                p3 = c + unity2 * (vec2 r r)
+                p3 = c + unity2 * (vec2 r r)
-                p4 = c - unity2 * (vec2 r r)
+                p4 = c - unity2 * (vec2 r r)
-- | Collide the given collisioners.
+-- | Collide the given collisioners.
-collide :: Collisioner2 -> Collisioner2 -> CollisionType
+collide :: Collisioner2 -> Collisioner2 -> CollisionType
-collide (AABB2Col box1) (AABB2Col box2)   = collideAABB2  box1   box2
+collide (AABB2Col box1) (AABB2Col box2)   = collideAABB2  box1   box2
-collide (AABB2Col box) (CircleCol circle) = collideAABB2  box    circle
+collide (AABB2Col box) (CircleCol circle) = collideAABB2  box    circle
-collide (CircleCol s1) (CircleCol s2)     = collideCircle s1     s2
+collide (CircleCol s1) (CircleCol s2)     = collideCircle s1     s2
-collide (CircleCol circle) (AABB2Col box) = collideCircle circle box
+collide (CircleCol circle) (AABB2Col box) = collideCircle circle box
-- | Move the collisioner.
+-- | Move the collisioner.
-move :: Vector2 -> Collisioner2 -> Collisioner2
+move :: Vector2 -> Collisioner2 -> Collisioner2
-move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v))
+move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v))
-move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)
+move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)
-- 3D collision
+-- 3D collision
-class Collisionable3 a where
+class Collisionable3 a where
-      -- | Collide the object with an AABB.
+      -- | Collide the object with an AABB.
-      collideAABB3 :: AABB3 -> a -> CollisionType
+      collideAABB3 :: AABB3 -> a -> CollisionType
-      -- | Collide the object with a sphere.
+      -- | Collide the object with a sphere.
-      collideSphere :: Sphere -> a -> CollisionType
+      collideSphere :: Sphere -> a -> CollisionType
-instance Collisionable3 AABB3 where
+instance Collisionable3 AABB3 where
-         collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2)
+         collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2)
-                      | (x max1) < (x min2) = NoCollision
+                      | (x max1) < (x min2) = NoCollision
-                      | (x min1) > (x max2) = NoCollision
+                      | (x min1) > (x max2) = NoCollision
-                      | (y max1) < (y min2) = NoCollision
+                      | (y max1) < (y min2) = NoCollision
-                      | (y min1) > (y max2) = NoCollision
+                      | (y min1) > (y max2) = NoCollision
-                      | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains
+                      | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains
-                      | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy
+                      | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy
-                      | otherwise = Collision
+                      | otherwise = Collision
-         collideSphere sphere@(Sphere c r) aabb@(AABB3 min max)
+         collideSphere sphere@(Sphere c r) aabb@(AABB3 min max)
-                       | test == FullyContains || test == FullyContainedBy = test
+                       | test == FullyContains || test == FullyContainedBy = test
-                       | normSq (c - boxC) > (l + r)^2 = NoCollision
+                       | normSq (c - boxC) > (l + r)^2 = NoCollision
-                       | otherwise = Collision
+                       | otherwise = Collision
-                         where
+                         where
-                            test = collideAABB3 aabb $ aabb3FromSphere sphere
+                            test = collideAABB3 aabb $ aabb3FromSphere sphere
-                            boxC = min + v
+                            boxC = min + v
-                            l = norm v
+                            l = norm v
-                            v = (max-min)/2
+                            v = (max-min)/2
-instance Collisionable3 Sphere where
+instance Collisionable3 Sphere where
-         collideAABB3 box sphere = case collideSphere sphere box of
+         collideAABB3 box sphere = case collideSphere sphere box of
-                      FullyContains    -> FullyContainedBy
+                      FullyContains    -> FullyContainedBy
-                      FullyContainedBy -> FullyContains
+                      FullyContainedBy -> FullyContains
-                      x -> x
+                      x -> x
-         collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)
+         collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)
-                       | distance_centers <= sub_radii =
+                       | distance_centers <= sub_radii =
-                         if (r1 > r2) then FullyContains else FullyContainedBy
+                         if (r1 > r2) then FullyContains else FullyContainedBy
-                       | distance_centers <= sum_radii = Collision
+                       | distance_centers <= sum_radii = Collision
-                       | otherwise = NoCollision
+                       | otherwise = NoCollision
-                         where
+                         where
-                            distance_centers = normSq $ c1 - c2
+                            distance_centers = normSq $ c1 - c2
-                            sum_radii = (r1 + r2)^2
+                            sum_radii = (r1 + r2)^2
-                            sub_radii = (r1 - r2)^2
+                            sub_radii = (r1 - r2)^2
-- | Create the minimal box fully containing the specified sphere.
+-- | Create the minimal box fully containing the specified sphere.
-aabb3FromSphere :: Sphere -> AABB3
+aabb3FromSphere :: Sphere -> AABB3
-aabb3FromSphere (Sphere c r) = AABB3 bot top
+aabb3FromSphere (Sphere c r) = AABB3 bot top
-    where
+    where
-        bot = c - (vec3 r r r)
+        bot = c - (vec3 r r r)
        top = c + (vec3 r r r)
 \ No newline at end of file

diff --git a/Spear/Math/Collision.hs b/Spear/Math/Collision.hs index 47cc5fd..a69ea7a 100644 --- a/Spear/Math/Collision.hs +++ b/Spear/Math/Collision.hs
@@ -1,242 +1,242 @@
1	module Spear.Math.Collision	1	module Spear.Math.Collision
2	(	2	(
3	CollisionType(..)	3	CollisionType(..)
4	-- * 2D Collision	4	-- * 2D Collision
5	, Collisionable2(..)	5	, Collisionable2(..)
6	, Collisioner2(..)	6	, Collisioner2(..)
7	-- ** Construction	7	-- ** Construction
8	, aabb2Collisioner	8	, aabb2Collisioner
9	, circleCollisioner	9	, circleCollisioner
10	, mkCols	10	, mkCols
11	-- ** Collision test	11	-- ** Collision test
12	, collide	12	, collide
13	-- ** Manipulation	13	-- ** Manipulation
14	, move	14	, move
15	-- ** Helpers	15	-- ** Helpers
16	, buildAABB2	16	, buildAABB2
17	, aabb2FromCircle	17	, aabb2FromCircle
18	, circleFromAABB2	18	, circleFromAABB2
19	-- * 3D Collision	19	-- * 3D Collision
20	, Collisionable3(..)	20	, Collisionable3(..)
21	-- ** Helpers	21	-- ** Helpers
22	, aabb3FromSphere	22	, aabb3FromSphere
23	)	23	)
24	where	24	where
25		25
26	import Spear.Assets.Model	26	import Spear.Assets.Model
27	import Spear.Math.AABB	27	import Spear.Math.AABB
28	import Spear.Math.Circle	28	import Spear.Math.Circle
29	import qualified Spear.Math.Matrix4 as M4	29	import qualified Spear.Math.Matrix4 as M4
30	import Spear.Math.Plane	30	import Spear.Math.Plane
31	import Spear.Math.Sphere	31	import Spear.Math.Sphere
32	import Spear.Math.Vector	32	import Spear.Math.Vector
33		33
34	import Data.List (foldl')	34	import Data.List (foldl')
35		35
36	data CollisionType = NoCollision \| Collision \| FullyContains \| FullyContainedBy	36	data CollisionType = NoCollision \| Collision \| FullyContains \| FullyContainedBy
37	deriving (Eq, Show)	37	deriving (Eq, Show)
38		38
39	-- 2D collision	39	-- 2D collision
40		40
41	class Collisionable2 a where	41	class Collisionable2 a where
42		42
43	-- \| Collide the object with an AABB.	43	-- \| Collide the object with an AABB.
44	collideAABB2 :: AABB2 -> a -> CollisionType	44	collideAABB2 :: AABB2 -> a -> CollisionType
45		45
46	-- \| Collide the object with a circle.	46	-- \| Collide the object with a circle.
47	collideCircle :: Circle -> a -> CollisionType	47	collideCircle :: Circle -> a -> CollisionType
48		48
49	instance Collisionable2 AABB2 where	49	instance Collisionable2 AABB2 where
50		50
51	collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2)	51	collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2)
52	\| (x max1) < (x min2) = NoCollision	52	\| (x max1) < (x min2) = NoCollision
53	\| (x min1) > (x max2) = NoCollision	53	\| (x min1) > (x max2) = NoCollision
54	\| (y max1) < (y min2) = NoCollision	54	\| (y max1) < (y min2) = NoCollision
55	\| (y min1) > (y max2) = NoCollision	55	\| (y min1) > (y max2) = NoCollision
56	\| box1 `aabb2pt` min2 && box1 `aabb2pt` max2 = FullyContains	56	\| box1 `aabb2pt` min2 && box1 `aabb2pt` max2 = FullyContains
57	\| box2 `aabb2pt` min1 && box2 `aabb2pt` max1 = FullyContainedBy	57	\| box2 `aabb2pt` min1 && box2 `aabb2pt` max1 = FullyContainedBy
58	\| otherwise = Collision	58	\| otherwise = Collision
59		59
60	collideCircle circle@(Circle c r) aabb@(AABB2 min max)	60	collideCircle circle@(Circle c r) aabb@(AABB2 min max)
61	\| test == FullyContains \|\| test == FullyContainedBy = test	61	\| test == FullyContains \|\| test == FullyContainedBy = test
62	\| normSq (c - boxC) > (l + r)^2 = NoCollision	62	\| normSq (c - boxC) > (l + r)^2 = NoCollision
63	\| otherwise = Collision	63	\| otherwise = Collision
64	where	64	where
65	test = collideAABB2 aabb $ aabb2FromCircle circle	65	test = collideAABB2 aabb $ aabb2FromCircle circle
66	boxC = min + (max-min)/2	66	boxC = min + (max-min)/2
67	l = norm $ min + (vec2 (x boxC) (y min)) - min	67	l = norm $ min + (vec2 (x boxC) (y min)) - min
68		68
69	instance Collisionable2 Circle where	69	instance Collisionable2 Circle where
70		70
71	collideAABB2 box circle = case collideCircle circle box of	71	collideAABB2 box circle = case collideCircle circle box of
72	FullyContains -> FullyContainedBy	72	FullyContains -> FullyContainedBy
73	FullyContainedBy -> FullyContains	73	FullyContainedBy -> FullyContains
74	x -> x	74	x -> x
75		75
76	collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)	76	collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)
77	\| distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy	77	\| distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy
78	\| distance_centers <= sum_radii = Collision	78	\| distance_centers <= sum_radii = Collision
79	\| otherwise = NoCollision	79	\| otherwise = NoCollision
80	where	80	where
81	distance_centers = normSq $ c1 - c2	81	distance_centers = normSq $ c1 - c2
82	sum_radii = (r1 + r2)^2	82	sum_radii = (r1 + r2)^2
83	sub_radii = (r1 - r2)^2	83	sub_radii = (r1 - r2)^2
84		84
85	instance Collisionable2 Collisioner2 where	85	instance Collisionable2 Collisioner2 where
86		86
87	collideAABB2 box (AABB2Col self) = collideAABB2 box self	87	collideAABB2 box (AABB2Col self) = collideAABB2 box self
88	collideAABB2 box (CircleCol self) = collideAABB2 box self	88	collideAABB2 box (CircleCol self) = collideAABB2 box self
89		89
90	collideCircle circle (AABB2Col self) = collideCircle circle self	90	collideCircle circle (AABB2Col self) = collideCircle circle self
91	collideCircle circle (CircleCol self) = collideCircle circle self	91	collideCircle circle (CircleCol self) = collideCircle circle self
92		92
93	aabbPoints :: AABB2 -> [Vector2]	93	aabbPoints :: AABB2 -> [Vector2]
94	aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8]	94	aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
95	where	95	where
96	p1 = vec2 (x min) (y min)	96	p1 = vec2 (x min) (y min)
97	p2 = vec2 (x min) (y min)	97	p2 = vec2 (x min) (y min)
98	p3 = vec2 (x min) (y max)	98	p3 = vec2 (x min) (y max)
99	p4 = vec2 (x min) (y max)	99	p4 = vec2 (x min) (y max)
100	p5 = vec2 (x max) (y min)	100	p5 = vec2 (x max) (y min)
101	p6 = vec2 (x max) (y min)	101	p6 = vec2 (x max) (y min)
102	p7 = vec2 (x max) (y max)	102	p7 = vec2 (x max) (y max)
103	p8 = vec2 (x max) (y max)	103	p8 = vec2 (x max) (y max)
104		104
105		105
106	-- \| A collisioner component.	106	-- \| A collisioner component.
107	data Collisioner2	107	data Collisioner2
108	-- \| An axis-aligned bounding box.	108	-- \| An axis-aligned bounding box.
109	= AABB2Col {-# UNPACK #-} !AABB2	109	= AABB2Col {-# UNPACK #-} !AABB2
110	-- \| A bounding circle.	110	-- \| A bounding circle.
111	\| CircleCol {-# UNPACK #-} !Circle	111	\| CircleCol {-# UNPACK #-} !Circle
112		112
113		113
114	-- \| Create a collisioner from the specified box.	114	-- \| Create a collisioner from the specified box.
115	aabb2Collisioner :: AABB2 -> Collisioner2	115	aabb2Collisioner :: AABB2 -> Collisioner2
116	aabb2Collisioner = AABB2Col	116	aabb2Collisioner = AABB2Col
117		117
118	-- \| Create a collisioner from the specified circle.	118	-- \| Create a collisioner from the specified circle.
119	circleCollisioner :: Circle -> Collisioner2	119	circleCollisioner :: Circle -> Collisioner2
120	circleCollisioner = CircleCol	120	circleCollisioner = CircleCol
121		121
122	-- \| Compute AABB collisioners in view space from the given AABB.	122	-- \| Compute AABB collisioners in view space from the given AABB.
123	mkCols :: M4.Matrix4 -- ^ Modelview matrix	123	mkCols :: M4.Matrix4 -- ^ Modelview matrix
124	-> Box	124	-> Box
125	-> [Collisioner2]	125	-> [Collisioner2]
126	mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) =	126	mkCols modelview (Box (Vec3 xmin ymin zmin) (Vec3 xmax ymax zmax)) =
127	let	127	let
128	toVec2 v = vec2 (x v) (y v)	128	toVec2 v = vec2 (x v) (y v)
129	p1 = toVec2 $ modelview `M4.mulp` vec3 xmin ymin zmax	129	p1 = toVec2 $ modelview `M4.mulp` vec3 xmin ymin zmax
130	p2 = toVec2 $ modelview `M4.mulp` vec3 xmax ymin zmin	130	p2 = toVec2 $ modelview `M4.mulp` vec3 xmax ymin zmin
131	p3 = toVec2 $ modelview `M4.mulp` vec3 xmax ymax zmin	131	p3 = toVec2 $ modelview `M4.mulp` vec3 xmax ymax zmin
132	col1 = AABB2Col $ AABB2 p1 p2	132	col1 = AABB2Col $ AABB2 p1 p2
133	col2 = AABB2Col $ AABB2 p1 p3	133	col2 = AABB2Col $ AABB2 p1 p3
134	in	134	in
135	[col1, col2]	135	[col1, col2]
136		136
137	-- \| Create the minimal AABB fully containing the specified collisioners.	137	-- \| Create the minimal AABB fully containing the specified collisioners.
138	buildAABB2 :: [Collisioner2] -> AABB2	138	buildAABB2 :: [Collisioner2] -> AABB2
139	buildAABB2 cols = aabb2 $ generatePoints cols	139	buildAABB2 cols = aabb2 $ generatePoints cols
140		140
141	-- \| Create the minimal box fully containing the specified circle.	141	-- \| Create the minimal box fully containing the specified circle.
142	aabb2FromCircle :: Circle -> AABB2	142	aabb2FromCircle :: Circle -> AABB2
143	aabb2FromCircle (Circle c r) = AABB2 bot top	143	aabb2FromCircle (Circle c r) = AABB2 bot top
144	where	144	where
145	bot = c - (vec2 r r)	145	bot = c - (vec2 r r)
146	top = c + (vec2 r r)	146	top = c + (vec2 r r)
147		147
148	-- \| Create the minimal circle fully containing the specified box.	148	-- \| Create the minimal circle fully containing the specified box.
149	circleFromAABB2 :: AABB2 -> Circle	149	circleFromAABB2 :: AABB2 -> Circle
150	circleFromAABB2 (AABB2 min max) = Circle c r	150	circleFromAABB2 (AABB2 min max) = Circle c r
151	where	151	where
152	c = scale 0.5 (min + max)	152	c = scale 0.5 (min + max)
153	r = norm . scale 0.5 $ max - min	153	r = norm . scale 0.5 $ max - min
154		154
155	generatePoints :: [Collisioner2] -> [Vector2]	155	generatePoints :: [Collisioner2] -> [Vector2]
156	generatePoints = foldl' generate []	156	generatePoints = foldl' generate []
157	where	157	where
158	generate acc (AABB2Col (AABB2 pmin pmax)) = p1:p2:p3:p4:p5:p6:p7:p8:acc	158	generate acc (AABB2Col (AABB2 pmin pmax)) = p1:p2:p3:p4:p5:p6:p7:p8:acc
159	where	159	where
160	p1 = vec2 (x pmin) (y pmin)	160	p1 = vec2 (x pmin) (y pmin)
161	p2 = vec2 (x pmin) (y pmin)	161	p2 = vec2 (x pmin) (y pmin)
162	p3 = vec2 (x pmin) (y pmax)	162	p3 = vec2 (x pmin) (y pmax)
163	p4 = vec2 (x pmin) (y pmax)	163	p4 = vec2 (x pmin) (y pmax)
164	p5 = vec2 (x pmax) (y pmin)	164	p5 = vec2 (x pmax) (y pmin)
165	p6 = vec2 (x pmax) (y pmin)	165	p6 = vec2 (x pmax) (y pmin)
166	p7 = vec2 (x pmax) (y pmax)	166	p7 = vec2 (x pmax) (y pmax)
167	p8 = vec2 (x pmax) (y pmax)	167	p8 = vec2 (x pmax) (y pmax)
168		168
169	generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc	169	generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc
170	where	170	where
171	p1 = c + unitx2 * (vec2 r r)	171	p1 = c + unitx2 * (vec2 r r)
172	p2 = c - unitx2 * (vec2 r r)	172	p2 = c - unitx2 * (vec2 r r)
173	p3 = c + unity2 * (vec2 r r)	173	p3 = c + unity2 * (vec2 r r)
174	p4 = c - unity2 * (vec2 r r)	174	p4 = c - unity2 * (vec2 r r)
175		175
176	-- \| Collide the given collisioners.	176	-- \| Collide the given collisioners.
177	collide :: Collisioner2 -> Collisioner2 -> CollisionType	177	collide :: Collisioner2 -> Collisioner2 -> CollisionType
178	collide (AABB2Col box1) (AABB2Col box2) = collideAABB2 box1 box2	178	collide (AABB2Col box1) (AABB2Col box2) = collideAABB2 box1 box2
179	collide (AABB2Col box) (CircleCol circle) = collideAABB2 box circle	179	collide (AABB2Col box) (CircleCol circle) = collideAABB2 box circle
180	collide (CircleCol s1) (CircleCol s2) = collideCircle s1 s2	180	collide (CircleCol s1) (CircleCol s2) = collideCircle s1 s2
181	collide (CircleCol circle) (AABB2Col box) = collideCircle circle box	181	collide (CircleCol circle) (AABB2Col box) = collideCircle circle box
182		182
183	-- \| Move the collisioner.	183	-- \| Move the collisioner.
184	move :: Vector2 -> Collisioner2 -> Collisioner2	184	move :: Vector2 -> Collisioner2 -> Collisioner2
185	move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v))	185	move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v))
186	move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)	186	move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)
187		187
188		188
189	-- 3D collision	189	-- 3D collision
190		190
191	class Collisionable3 a where	191	class Collisionable3 a where
192		192
193	-- \| Collide the object with an AABB.	193	-- \| Collide the object with an AABB.
194	collideAABB3 :: AABB3 -> a -> CollisionType	194	collideAABB3 :: AABB3 -> a -> CollisionType
195		195
196	-- \| Collide the object with a sphere.	196	-- \| Collide the object with a sphere.
197	collideSphere :: Sphere -> a -> CollisionType	197	collideSphere :: Sphere -> a -> CollisionType
198		198
199	instance Collisionable3 AABB3 where	199	instance Collisionable3 AABB3 where
200		200
201	collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2)	201	collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2)
202	\| (x max1) < (x min2) = NoCollision	202	\| (x max1) < (x min2) = NoCollision
203	\| (x min1) > (x max2) = NoCollision	203	\| (x min1) > (x max2) = NoCollision
204	\| (y max1) < (y min2) = NoCollision	204	\| (y max1) < (y min2) = NoCollision
205	\| (y min1) > (y max2) = NoCollision	205	\| (y min1) > (y max2) = NoCollision
206	\| box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains	206	\| box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains
207	\| box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy	207	\| box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy
208	\| otherwise = Collision	208	\| otherwise = Collision
209		209
210	collideSphere sphere@(Sphere c r) aabb@(AABB3 min max)	210	collideSphere sphere@(Sphere c r) aabb@(AABB3 min max)
211	\| test == FullyContains \|\| test == FullyContainedBy = test	211	\| test == FullyContains \|\| test == FullyContainedBy = test
212	\| normSq (c - boxC) > (l + r)^2 = NoCollision	212	\| normSq (c - boxC) > (l + r)^2 = NoCollision
213	\| otherwise = Collision	213	\| otherwise = Collision
214	where	214	where
215	test = collideAABB3 aabb $ aabb3FromSphere sphere	215	test = collideAABB3 aabb $ aabb3FromSphere sphere
216	boxC = min + v	216	boxC = min + v
217	l = norm v	217	l = norm v
218	v = (max-min)/2	218	v = (max-min)/2
219		219
220	instance Collisionable3 Sphere where	220	instance Collisionable3 Sphere where
221		221
222	collideAABB3 box sphere = case collideSphere sphere box of	222	collideAABB3 box sphere = case collideSphere sphere box of
223	FullyContains -> FullyContainedBy	223	FullyContains -> FullyContainedBy
224	FullyContainedBy -> FullyContains	224	FullyContainedBy -> FullyContains
225	x -> x	225	x -> x
226		226
227	collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)	227	collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)
228	\| distance_centers <= sub_radii =	228	\| distance_centers <= sub_radii =
229	if (r1 > r2) then FullyContains else FullyContainedBy	229	if (r1 > r2) then FullyContains else FullyContainedBy
230	\| distance_centers <= sum_radii = Collision	230	\| distance_centers <= sum_radii = Collision
231	\| otherwise = NoCollision	231	\| otherwise = NoCollision
232	where	232	where
233	distance_centers = normSq $ c1 - c2	233	distance_centers = normSq $ c1 - c2
234	sum_radii = (r1 + r2)^2	234	sum_radii = (r1 + r2)^2
235	sub_radii = (r1 - r2)^2	235	sub_radii = (r1 - r2)^2
236		236
237	-- \| Create the minimal box fully containing the specified sphere.	237	-- \| Create the minimal box fully containing the specified sphere.
238	aabb3FromSphere :: Sphere -> AABB3	238	aabb3FromSphere :: Sphere -> AABB3
239	aabb3FromSphere (Sphere c r) = AABB3 bot top	239	aabb3FromSphere (Sphere c r) = AABB3 bot top
240	where	240	where
241	bot = c - (vec3 r r r)	241	bot = c - (vec3 r r r)
242	top = c + (vec3 r r r) \ No newline at end of file	242	top = c + (vec3 r r r) \ No newline at end of file