diff options
Diffstat (limited to 'Spear/Math/Collision.hs')
-rw-r--r-- | Spear/Math/Collision.hs | 69 |
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 | |||
1 | module Spear.Math.Collision | 3 | module Spear.Math.Collision |
2 | ( | 4 | ( |
3 | CollisionType(..) | 5 | CollisionType(..) |
@@ -23,15 +25,17 @@ module Spear.Math.Collision | |||
23 | ) | 25 | ) |
24 | where | 26 | where |
25 | 27 | ||
26 | import Spear.Assets.Model | 28 | import Spear.Assets.Model |
27 | import Spear.Math.AABB | 29 | import Spear.Math.AABB |
28 | import Spear.Math.Circle | 30 | import Spear.Math.Algebra |
31 | import Spear.Math.Circle | ||
29 | import qualified Spear.Math.Matrix4 as M4 | 32 | import qualified Spear.Math.Matrix4 as M4 |
30 | import Spear.Math.Plane | 33 | import Spear.Math.Plane |
31 | import Spear.Math.Sphere | 34 | import Spear.Math.Sphere |
32 | import Spear.Math.Vector | 35 | import Spear.Math.Vector |
36 | import Spear.Prelude | ||
33 | 37 | ||
34 | import Data.List (foldl') | 38 | import Data.List (foldl') |
35 | 39 | ||
36 | data CollisionType = NoCollision | Collision | FullyContains | FullyContainedBy | 40 | data 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 | ||
41 | class Collisionable2 a where | 45 | class 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 | ||
49 | instance Collisionable2 AABB2 where | 52 | instance 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 | ||
69 | instance Collisionable2 Circle where | 71 | instance 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 | ||
85 | instance Collisionable2 Collisioner2 where | 86 | instance 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 | |||
93 | aabbPoints :: AABB2 -> [Vector2] | 94 | aabbPoints :: AABB2 -> [Vector2] |
94 | aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8] | 95 | aabbPoints (AABB2 min max) = [p1,p2,p3,p4,p5,p6,p7,p8] |
95 | where | 96 | where |
@@ -142,15 +143,15 @@ buildAABB2 cols = aabb2 $ generatePoints cols | |||
142 | aabb2FromCircle :: Circle -> AABB2 | 143 | aabb2FromCircle :: Circle -> AABB2 |
143 | aabb2FromCircle (Circle c r) = AABB2 bot top | 144 | aabb2FromCircle (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. |
149 | circleFromAABB2 :: AABB2 -> Circle | 150 | circleFromAABB2 :: AABB2 -> Circle |
150 | circleFromAABB2 (AABB2 min max) = Circle c r | 151 | circleFromAABB2 (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 | ||
155 | generatePoints :: [Collisioner2] -> [Vector2] | 156 | generatePoints :: [Collisioner2] -> [Vector2] |
156 | generatePoints = foldl' generate [] | 157 | generatePoints = 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. |
177 | collide :: Collisioner2 -> Collisioner2 -> CollisionType | 178 | collide :: Collisioner2 -> Collisioner2 -> CollisionType |
@@ -183,13 +184,11 @@ collide (CircleCol circle) (AABB2Col box) = collideCircle circle box | |||
183 | -- | Move the collisioner. | 184 | -- | Move the collisioner. |
184 | move :: Vector2 -> Collisioner2 -> Collisioner2 | 185 | move :: Vector2 -> Collisioner2 -> Collisioner2 |
185 | move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v)) | 186 | move v (AABB2Col (AABB2 min max)) = AABB2Col (AABB2 (min+v) (max+v)) |
186 | move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) | 187 | move v (CircleCol (Circle c r)) = CircleCol (Circle (c+v) r) |
187 | |||
188 | 188 | ||
189 | -- 3D collision | ||
190 | 189 | ||
190 | -- | 3D collision | ||
191 | class Collisionable3 a where | 191 | class 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 | ||
199 | instance Collisionable3 AABB3 where | 198 | instance 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 | ||
220 | instance Collisionable3 Sphere where | 218 | instance 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 | |||
238 | aabb3FromSphere :: Sphere -> AABB3 | 235 | aabb3FromSphere :: Sphere -> AABB3 |
239 | aabb3FromSphere (Sphere c r) = AABB3 bot top | 236 | aabb3FromSphere (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 |