move collision detection out of MainGame module

This commit is contained in:
nek0 2019-02-15 20:01:14 +01:00
parent 06845657f2
commit a68f4fc7e7
4 changed files with 69 additions and 30 deletions

35
src/Collision.hs Normal file
View file

@ -0,0 +1,35 @@
module Collision where
import Linear (V2(..))
import Types
checkBoundsCollision2
:: V2 Double
-> V2 Double
-> Double
-> V2 Double
-> Boundaries Double
-> V2 Double
checkBoundsCollision2
pre@(V2 pr pc) nex dt acc (Boundaries (minr, minc) (maxr, maxc))
| colltr < dt && colltc < dt = V2 0 0
| colltr < dt = V2 0 0
| colltc < dt = V2 0 0
| otherwise = acc
where
V2 vr vc = fmap (/ dt) (nex - pre)
colltr
| vr > 0 && prr <= maxr && (prc + 0.15 >= minc && prc - 0.15 <= maxc) =
((fromIntegral (floor pr :: Int) + minr - 0.15) - pr) / vr
| vr < 0 && prr >= minr && (prc + 0.15 >= minc && prc - 0.15 <= maxc) =
((fromIntegral (floor pr :: Int) + maxr + 0.15) - pr) / vr
| otherwise = dt
colltc
| vc > 0 && prc <= maxc && (prr + 0.15 >= minr && prr - 0.15 <= maxr) =
((fromIntegral (floor pc :: Int) + minc - 0.15) - pc) / vc
| vc < 0 && prc >= minc && (prr + 0.15 >= minr && prr - 0.15 <= maxr) =
((fromIntegral (floor pc :: Int) + maxc + 0.15) - pc) / vc
| otherwise = dt
prr = pr - fromIntegral (floor pr :: Int)
prc = pc - fromIntegral (floor pc :: Int)

View file

@ -18,7 +18,9 @@ import NanoVG hiding (V2(..))
import Types import Types
import MainGame.WorldMap (checkBoundsCollision2, drawTile) import MainGame.WorldMap (drawTile)
import Collision
import Util import Util

View file

@ -40,6 +40,7 @@ import MindMap
import NPC import NPC
-- import Object -- import Object
import Animation import Animation
import Collision
loadMap :: Affection UserData () loadMap :: Affection UserData ()
loadMap = do loadMap = do
@ -956,32 +957,32 @@ updateMap dt = do
{ worldState = nws2 { worldState = nws2
} }
checkBoundsCollision2 -- checkBoundsCollision2
:: V2 Double -- :: V2 Double
-> V2 Double -- -> V2 Double
-> Double -- -> Double
-> V2 Double -- -> V2 Double
-> Boundaries Double -- -> Boundaries Double
-> V2 Double -- -> V2 Double
checkBoundsCollision2 -- checkBoundsCollision2
pre@(V2 pr pc) nex dt acc (Boundaries (minr, minc) (maxr, maxc)) -- pre@(V2 pr pc) nex dt acc (Boundaries (minr, minc) (maxr, maxc))
| colltr < dt && colltc < dt = V2 0 0 -- | colltr < dt && colltc < dt = V2 0 0
| colltr < dt = V2 0 0 -- | colltr < dt = V2 0 0
| colltc < dt = V2 0 0 -- | colltc < dt = V2 0 0
| otherwise = acc -- | otherwise = acc
where -- where
V2 vr vc = fmap (/ dt) (nex - pre) -- V2 vr vc = fmap (/ dt) (nex - pre)
colltr -- colltr
| vr > 0 && prr <= maxr && (prc + 0.15 >= minc && prc - 0.15 <= maxc) = -- | vr > 0 && prr <= maxr && (prc + 0.15 >= minc && prc - 0.15 <= maxc) =
((fromIntegral (floor pr :: Int) + minr - 0.15) - pr) / vr -- ((fromIntegral (floor pr :: Int) + minr - 0.15) - pr) / vr
| vr < 0 && prr >= minr && (prc + 0.15 >= minc && prc - 0.15 <= maxc) = -- | vr < 0 && prr >= minr && (prc + 0.15 >= minc && prc - 0.15 <= maxc) =
((fromIntegral (floor pr :: Int) + maxr + 0.15) - pr) / vr -- ((fromIntegral (floor pr :: Int) + maxr + 0.15) - pr) / vr
| otherwise = dt -- | otherwise = dt
colltc -- colltc
| vc > 0 && prc <= maxc && (prr + 0.15 >= minr && prr - 0.15 <= maxr) = -- | vc > 0 && prc <= maxc && (prr + 0.15 >= minr && prr - 0.15 <= maxr) =
((fromIntegral (floor pc :: Int) + minc - 0.15) - pc) / vc -- ((fromIntegral (floor pc :: Int) + minc - 0.15) - pc) / vc
| vc < 0 && prc >= minc && (prr + 0.15 >= minr && prr - 0.15 <= maxr) = -- | vc < 0 && prc >= minc && (prr + 0.15 >= minr && prr - 0.15 <= maxr) =
((fromIntegral (floor pc :: Int) + maxc + 0.15) - pc) / vc -- ((fromIntegral (floor pc :: Int) + maxc + 0.15) - pc) / vc
| otherwise = dt -- | otherwise = dt
prr = pr - fromIntegral (floor pr :: Int) -- prr = pr - fromIntegral (floor pr :: Int)
prc = pc - fromIntegral (floor pc :: Int) -- prc = pc - fromIntegral (floor pc :: Int)

View file

@ -35,6 +35,7 @@ executable tracer-game
, Types.Entity , Types.Entity
, Types.NPCState , Types.NPCState
, Animation , Animation
, Collision
, StateMachine , StateMachine
, Floorplan , Floorplan
, Interior , Interior