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 |
