aboutsummaryrefslogtreecommitdiff
path: root/Spear/Math/Collision.hs
diff options
context:
space:
mode:
Diffstat (limited to 'Spear/Math/Collision.hs')
-rw-r--r--Spear/Math/Collision.hs69
1 files changed, 33 insertions, 36 deletions
diff --git a/Spear/Math/Collision.hs b/Spear/Math/Collision.hs
index a69ea7a..4412b10 100644
--- a/Spear/Math/Collision.hs
+++ b/Spear/Math/Collision.hs
@@ -1,3 +1,5 @@
1{-# LANGUAGE NoImplicitPrelude #-}
2
1module Spear.Math.Collision 3module Spear.Math.Collision
2( 4(
3 CollisionType(..) 5 CollisionType(..)
@@ -23,15 +25,17 @@ module Spear.Math.Collision
23) 25)
24where 26where
25 27
26import Spear.Assets.Model 28import Spear.Assets.Model
27import Spear.Math.AABB 29import Spear.Math.AABB
28import Spear.Math.Circle 30import Spear.Math.Algebra
31import Spear.Math.Circle
29import qualified Spear.Math.Matrix4 as M4 32import qualified Spear.Math.Matrix4 as M4
30import Spear.Math.Plane 33import Spear.Math.Plane
31import Spear.Math.Sphere 34import Spear.Math.Sphere
32import Spear.Math.Vector 35import Spear.Math.Vector
36import Spear.Prelude
33 37
34import Data.List (foldl') 38import Data.List (foldl')
35 39
36data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy 40data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
37 deriving (Eq, Show) 41 deriving (Eq, Show)
@@ -39,7 +43,6 @@ data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy
39-- 2D collision 43-- 2D collision
40 44
41class Collisionable2 a where 45class Collisionable2 a where
42
43 -- | Collide the object with an AABB. 46 -- | Collide the object with an AABB.
44 collideAABB2 :: AABB2 -> a -> CollisionType 47 collideAABB2 :: AABB2 -> a -> CollisionType
45 48
@@ -47,7 +50,6 @@ class Collisionable2 a where
47 collideCircle :: Circle -> a -> CollisionType 50 collideCircle :: Circle -> a -> CollisionType
48 51
49instance Collisionable2 AABB2 where 52instance Collisionable2 AABB2 where
50
51 collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2) 53 collideAABB2 box1@(AABB2 min1 max1) box2@(AABB2 min2 max2)
52 | (x max1) < (x min2) = NoCollision 54 | (x max1) < (x min2) = NoCollision
53 | (x min1) > (x max2) = NoCollision 55 | (x min1) > (x max2) = NoCollision
@@ -63,15 +65,14 @@ instance Collisionable2 AABB2 where
63 | otherwise = Collision 65 | otherwise = Collision
64 where 66 where
65 test = collideAABB2 aabb $ aabb2FromCircle circle 67 test = collideAABB2 aabb $ aabb2FromCircle circle
66 boxC = min + (max-min)/2 68 boxC = min + (max-min) / (2::Float)
67 l = norm $ min + (vec2 (x boxC) (y min)) - min 69 l = norm $ min + (vec2 (x boxC) (y min)) - min
68 70
69instance Collisionable2 Circle where 71instance Collisionable2 Circle where
70
71 collideAABB2 box circle = case collideCircle circle box of 72 collideAABB2 box circle = case collideCircle circle box of
72 FullyContains -> FullyContainedBy 73 FullyContains -> FullyContainedBy
73 FullyContainedBy -> FullyContains 74 FullyContainedBy -> FullyContains
74 x -> x 75 x -> x
75 76
76 collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2) 77 collideCircle s1@(Circle c1 r1) s2@(Circle c2 r2)
77 | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy 78 | distance_centers <= sub_radii = if (r1 > r2) then FullyContains else FullyContainedBy
@@ -83,13 +84,13 @@ instance Collisionable2 Circle where
83 sub_radii = (r1 - r2)^2 84 sub_radii = (r1 - r2)^2
84 85
85instance Collisionable2 Collisioner2 where 86instance Collisionable2 Collisioner2 where
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
93aabbPoints :: AABB2 -> [Vector2] 94aabbPoints :: AABB2 -> [Vector2]
94aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8] 95aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8]
95 where 96 where
@@ -142,15 +143,15 @@ buildAABB2 cols = aabb2 $ generatePoints cols
142aabb2FromCircle :: Circle -> AABB2 143aabb2FromCircle :: Circle -> AABB2
143aabb2FromCircle (Circle c r) = AABB2 bot top 144aabb2FromCircle (Circle c r) = AABB2 bot top
144 where 145 where
145 bot = c - (vec2 r r) 146 bot = c - vec2 r r
146 top = c + (vec2 r r) 147 top = c + vec2 r r
147 148
148-- | Create the minimal circle fully containing the specified box. 149-- | Create the minimal circle fully containing the specified box.
149circleFromAABB2 :: AABB2 -> Circle 150circleFromAABB2 :: AABB2 -> Circle
150circleFromAABB2 (AABB2 min max) = Circle c r 151circleFromAABB2 (AABB2 min max) = Circle c r
151 where 152 where
152 c = scale 0.5 (min + max) 153 c = (0.5::Float) * (min + max)
153 r = norm . scale 0.5 $ max - min 154 r = norm . (*(0.5::Float)) $ max - min
154 155
155generatePoints :: [Collisioner2] -> [Vector2] 156generatePoints :: [Collisioner2] -> [Vector2]
156generatePoints = foldl' generate [] 157generatePoints = foldl' generate []
@@ -168,10 +169,10 @@ generatePoints = foldl' generate []
168 169
169 generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc 170 generate acc (CircleCol (Circle c r)) = p1:p2:p3:p4:acc
170 where 171 where
171 p1 = c + unitx2 * (vec2 r r) 172 p1 = c + unitx2 * vec2 r r
172 p2 = c - unitx2 * (vec2 r r) 173 p2 = c - unitx2 * vec2 r r
173 p3 = c + unity2 * (vec2 r r) 174 p3 = c + unity2 * vec2 r r
174 p4 = c - unity2 * (vec2 r r) 175 p4 = c - unity2 * vec2 r r
175 176
176-- | Collide the given collisioners. 177-- | Collide the given collisioners.
177collide :: Collisioner2 -> Collisioner2 -> CollisionType 178collide :: Collisioner2 -> Collisioner2 -> CollisionType
@@ -183,13 +184,11 @@ collide (CircleCol circle) (AABB2Col box) = collideCircle circle box
183-- | Move the collisioner. 184-- | Move the collisioner.
184move :: Vector2 -> Collisioner2 -> Collisioner2 185move :: Vector2 -> Collisioner2 -> Collisioner2
185move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v)) 186move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v))
186move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) 187move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r)
187
188 188
189-- 3D collision
190 189
190-- | 3D collision
191class Collisionable3 a where 191class Collisionable3 a where
192
193 -- | Collide the object with an AABB. 192 -- | Collide the object with an AABB.
194 collideAABB3 :: AABB3 -> a -> CollisionType 193 collideAABB3 :: AABB3 -> a -> CollisionType
195 194
@@ -197,12 +196,11 @@ class Collisionable3 a where
197 collideSphere :: Sphere -> a -> CollisionType 196 collideSphere :: Sphere -> a -> CollisionType
198 197
199instance Collisionable3 AABB3 where 198instance Collisionable3 AABB3 where
200
201 collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2) 199 collideAABB3 box1@(AABB3 min1 max1) box2@(AABB3 min2 max2)
202 | (x max1) < (x min2) = NoCollision 200 | x max1 < x min2 = NoCollision
203 | (x min1) > (x max2) = NoCollision 201 | x min1 > x max2 = NoCollision
204 | (y max1) < (y min2) = NoCollision 202 | y max1 < y min2 = NoCollision
205 | (y min1) > (y max2) = NoCollision 203 | y min1 > y max2 = NoCollision
206 | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains 204 | box1 `aabb3pt` min2 && box1 `aabb3pt` max2 = FullyContains
207 | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy 205 | box2 `aabb3pt` min1 && box2 `aabb3pt` max1 = FullyContainedBy
208 | otherwise = Collision 206 | otherwise = Collision
@@ -215,18 +213,17 @@ instance Collisionable3 AABB3 where
215 test = collideAABB3 aabb $ aabb3FromSphere sphere 213 test = collideAABB3 aabb $ aabb3FromSphere sphere
216 boxC = min + v 214 boxC = min + v
217 l = norm v 215 l = norm v
218 v = (max-min)/2 216 v = (max-min) / (2::Float)
219 217
220instance Collisionable3 Sphere where 218instance Collisionable3 Sphere where
221
222 collideAABB3 box sphere = case collideSphere sphere box of 219 collideAABB3 box sphere = case collideSphere sphere box of
223 FullyContains -> FullyContainedBy 220 FullyContains -> FullyContainedBy
224 FullyContainedBy -> FullyContains 221 FullyContainedBy -> FullyContains
225 x -> x 222 x -> x
226 223
227 collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2) 224 collideSphere s1@(Sphere c1 r1) s2@(Sphere c2 r2)
228 | distance_centers <= sub_radii = 225 | distance_centers <= sub_radii =
229 if (r1 > r2) then FullyContains else FullyContainedBy 226 if r1 > r2 then FullyContains else FullyContainedBy
230 | distance_centers <= sum_radii = Collision 227 | distance_centers <= sum_radii = Collision
231 | otherwise = NoCollision 228 | otherwise = NoCollision
232 where 229 where
@@ -238,5 +235,5 @@ instance Collisionable3 Sphere where
238aabb3FromSphere :: Sphere -> AABB3 235aabb3FromSphere :: Sphere -> AABB3
239aabb3FromSphere (Sphere c r) = AABB3 bot top 236aabb3FromSphere (Sphere c r) = AABB3 bot top
240 where 237 where
241 bot = c - (vec3 r r r) 238 bot = c - vec3 r r r
242 top = c + (vec3 r r r) \ No newline at end of file 239 top = c + vec3 r r r