reworked physics
This commit is contained in:
parent
c574671244
commit
9f47b192a5
8 changed files with 177 additions and 259 deletions
|
|
@ -6,20 +6,16 @@ import Affection as A
|
|||
|
||||
import Linear
|
||||
|
||||
import Data.String (fromString)
|
||||
|
||||
import Data.List (sortBy)
|
||||
|
||||
-- internal imports
|
||||
|
||||
import Physics.Classes.Mass
|
||||
|
||||
data CollisionResult time direction
|
||||
data CollisionResult direction
|
||||
= NoCollision
|
||||
| CollisionImminent
|
||||
{ collisionTime :: time
|
||||
, collisionDirection :: direction
|
||||
}
|
||||
-- | CollisionImminent
|
||||
-- { collisionTime :: time
|
||||
-- , collisionDirection :: direction
|
||||
-- }
|
||||
| OverlapCollision
|
||||
{ collisionDepth :: direction
|
||||
}
|
||||
|
|
@ -52,6 +48,9 @@ class (Show c, Mass c) => Collidible c where
|
|||
-- | Flag indicating a collision during the current time step
|
||||
collisionOccured :: c -> Bool
|
||||
|
||||
-- | Update the collision occurence flag
|
||||
updateCollisionOccurence :: c -> (Bool -> c)
|
||||
|
||||
-- | returns the bottom left and top right corners relative to the objects
|
||||
-- positional vector of the axis aligned bounding box (AABB) serving here
|
||||
-- as collision boundaries.
|
||||
|
|
@ -65,72 +64,73 @@ class (Show c, Mass c) => Collidible c where
|
|||
:: (Collidible other)
|
||||
=> c -- ^ First object
|
||||
-> other -- ^ second object
|
||||
-> CollisionResult Double (V2 Int) -- ^ Do the objects collide?
|
||||
-> CollisionResult (V2 Double) -- ^ Do the objects collide?
|
||||
collisionCheck m1 m2 =
|
||||
let p1@(V2 p1x p1y) = position m1
|
||||
p2@(V2 p2x p2y) = position m2
|
||||
v1@(V2 v1x v1y) = velocity m1
|
||||
v2@(V2 v2x v2y) = velocity m2
|
||||
(V2 dvx dvy) = v1 - v2
|
||||
(V2 dx dy) = p1 - p2
|
||||
let (V2 p1x p1y) = position m1
|
||||
(V2 p2x p2y) = position m2
|
||||
(V2 b1minx b1miny, V2 b1maxx b1maxy) = boundary m1
|
||||
(V2 b2minx b2miny, V2 b2maxx b2maxy) = boundary m2
|
||||
getCoordinates
|
||||
| p1x <= p2x && p1y <= p2y =
|
||||
let x1 = p1x + b1maxx
|
||||
y1 = p1y + b1maxy
|
||||
x2 = p2x + b2minx
|
||||
y2 = p2y + b2minx
|
||||
in (x1, y1, x2, y2)
|
||||
| p1x > p2x && p1y <= p2y =
|
||||
let x1 = p1x + b1minx
|
||||
y1 = p1y + b1maxy
|
||||
x2 = p2x + b2maxx
|
||||
y2 = p2y + b2miny
|
||||
in (x1, y1, x2, y2)
|
||||
| p1x <= p2x && p1y > p2y =
|
||||
let x1 = p1x + b1maxx
|
||||
y1 = p1y + b1miny
|
||||
x2 = p2x + b2minx
|
||||
y2 = p2y + b2maxy
|
||||
in (x1, y1, x2, y2)
|
||||
| otherwise =
|
||||
let x1 = p1x + b1minx
|
||||
y1 = p1y + b1miny
|
||||
x2 = p2x + b2maxx
|
||||
y2 = p2y + b2maxy
|
||||
in (x1, y1, x2, y2)
|
||||
(ox1, oy1, ox2, oy2) = getCoordinates
|
||||
in
|
||||
error "collisionCheck: Not yet implemented!"
|
||||
if ox2 - ox1 < 0 || oy2 - oy1 < 0
|
||||
then OverlapCollision
|
||||
(V2
|
||||
(min 0 (ox2 - ox1) * (- 1))
|
||||
(min 0 (oy2 - oy1) * (- 1))
|
||||
)
|
||||
else
|
||||
NoCollision
|
||||
|
||||
-- | This Function is called for every collision on both colliding objects.
|
||||
collide
|
||||
:: (Collidible other)
|
||||
=> c -- ^ Original object
|
||||
-> [(other, CollisionResult Double (V2 Int))] -- ^ Collision partners and results
|
||||
-> Double -- ^ Timestep length
|
||||
-> c -- ^ Updated original object
|
||||
collide coll1 collrs = elasticCollision 0.9 coll1 (head collrs)
|
||||
=> c -- ^ Original object
|
||||
-> [(other, CollisionResult (V2 Double))] -- ^ Collision partners and results
|
||||
-> Double -- ^ Timestep length
|
||||
-> c -- ^ Updated original object
|
||||
collide coll1 collrs dt =
|
||||
foldl (\acc a -> elasticCollision 0.9 acc a dt) coll1 collrs
|
||||
|
||||
-- | Implementation of a dampened elastic collision used as default collision
|
||||
-- implementation of the collision reaction
|
||||
elasticCollision
|
||||
:: (Collidible c1, Collidible c2)
|
||||
=> Double
|
||||
-> c1
|
||||
-> (c2, CollisionResult Double (V2 Int))
|
||||
-> Double -- ^ Timestep length
|
||||
-> c1
|
||||
=> Double -- ^ Restitution coefficient
|
||||
-> c1 -- ^ First collision partner
|
||||
-> (c2, CollisionResult (V2 Double)) -- ^ Second collision partner with collision result
|
||||
-> Double -- ^ Timestep length
|
||||
-> c1 -- ^ Updated first collision partner
|
||||
elasticCollision _ mo1 (_, NoCollision) _ = mo1
|
||||
elasticCollision damping mo1 (mo2, CollisionImminent ddt (V2 dirx diry)) dt =
|
||||
let v1@(V2 v1x v1y) = velocity mo1
|
||||
(V2 v2x v2y) = velocity mo2
|
||||
p1 = position mo1
|
||||
m1 = mass mo1
|
||||
m2 = mass mo2
|
||||
v1x' = 2 * (m1 * v1x + m2 * v2x) / (m1 + m2) - v1x
|
||||
v1y' = 2 * (m1 * v1y + m2 * v2y) / (m1 + m2) - v1y
|
||||
nvel = if m1 == recip 0
|
||||
then V2 0 0
|
||||
else (damping *) <$>
|
||||
if m2 == recip 0
|
||||
then
|
||||
if dirx /= 0
|
||||
then V2 (-v1x) v1y
|
||||
else V2 v1x (-v1y)
|
||||
else V2 v1x' v1y'
|
||||
elasticCollision restitution mo1 (mo2, OverlapCollision depth) dt =
|
||||
let dvel = (velocity mo1 - velocity mo2) * normalize depth
|
||||
j = (restitution + 1) * (- (dvel `dot` dvel)) /
|
||||
(1 / mass mo1 + 1 / mass mo2)
|
||||
fi = (* (j / dt)) <$> normalize depth
|
||||
in
|
||||
velocityUpdater
|
||||
mo1
|
||||
nvel
|
||||
elasticCollision damping mo1 (mo2, OverlapCollision depth) dt =
|
||||
let m1 = mass mo1
|
||||
m2 = mass mo2
|
||||
(V2 dx dy) = (/ dt) . fromIntegral <$> depth
|
||||
v1x' = 2 * (m1 * dx + m2 * (-dx)) / (m1 + m2) - dx
|
||||
v1y' = 2 * (m1 * dy + m2 * (-dy)) / (m1 + m2) - dy
|
||||
nvel = if m1 == recip 0
|
||||
then V2 0 0
|
||||
else (damping *) <$>
|
||||
if m2 == recip 0
|
||||
then
|
||||
if dx /= 0
|
||||
then V2 (-v1x') v1y'
|
||||
else V2 v1x' (-v1y')
|
||||
else
|
||||
V2 v1x' v1y'
|
||||
in
|
||||
velocityUpdater mo1 nvel
|
||||
positionUpdater (addImpactForce (updateCollisionOccurence mo1 True) fi)
|
||||
(position mo1 - depth)
|
||||
|
|
|
|||
|
|
@ -52,4 +52,11 @@ class Mass m where
|
|||
dpos = (* dt) <$> nvel
|
||||
npos = position m + dpos
|
||||
in
|
||||
positionUpdater (velocityUpdater m nvel) npos
|
||||
resetForces $ positionUpdater (velocityUpdater m nvel) npos
|
||||
|
||||
calculateLoads
|
||||
:: m -- ^ Original mass object
|
||||
-> V2 Double -- ^ Gravitational force vector
|
||||
-> m -- ^ Updated mass object
|
||||
calculateLoads =
|
||||
addLoads
|
||||
|
|
|
|||
|
|
@ -21,6 +21,7 @@ import Scenes.Test.Types
|
|||
import Classes
|
||||
import Types
|
||||
import Physics
|
||||
import Util
|
||||
|
||||
update
|
||||
:: Test
|
||||
|
|
@ -58,7 +59,7 @@ update level dt = liftIO $ do
|
|||
let res = collisionCheck dt tangible1 tangible2
|
||||
in
|
||||
case res of
|
||||
c@(CollisionImminent _ _) ->
|
||||
c@(OverlapCollision _) ->
|
||||
if qInd /= index
|
||||
then jacc `V.snoc` (qInd, c)
|
||||
else jacc
|
||||
|
|
@ -71,7 +72,9 @@ update level dt = liftIO $ do
|
|||
then iacc
|
||||
else iacc `V.snoc`
|
||||
( index
|
||||
, sortOn (collisionTime . snd) (V.toList partners)
|
||||
, sortOn
|
||||
((\v -> collisionDepth v `dot` collisionDepth v) . snd)
|
||||
(V.toList partners)
|
||||
)
|
||||
)
|
||||
V.empty
|
||||
|
|
@ -93,7 +96,10 @@ update level dt = liftIO $ do
|
|||
d
|
||||
dt
|
||||
in
|
||||
inter
|
||||
resetImpactForces $ resetCollisionOccurence $
|
||||
if collisionOccured inter
|
||||
then addLoads inter (impactForces inter)
|
||||
else addLoads inter constG
|
||||
)
|
||||
digest
|
||||
in
|
||||
|
|
@ -112,11 +118,11 @@ update level dt = liftIO $ do
|
|||
(\acc@(castAcc, pAcc, _) input ->
|
||||
case input of
|
||||
TCast c ->
|
||||
(castAcc `V.snoc` move dt c, pAcc, mnewCat)
|
||||
(castAcc `V.snoc` updateByEuler c dt, pAcc, mnewCat)
|
||||
TPowerUp p ->
|
||||
(castAcc, pAcc `V.snoc` move dt p, mnewCat)
|
||||
(castAcc, pAcc `V.snoc` updateByEuler p dt, mnewCat)
|
||||
TPlayer ncat ->
|
||||
(castAcc, pAcc, Just (move dt ncat))
|
||||
(castAcc, pAcc, Just (updateByEuler ncat dt))
|
||||
TTile _ ->
|
||||
acc
|
||||
)
|
||||
|
|
@ -125,144 +131,3 @@ update level dt = liftIO $ do
|
|||
writeTVar (testCast level) newCast
|
||||
writeTVar (testPowerups level) newPowerups
|
||||
writeTVar (testPlayer level) mnewCat
|
||||
|
||||
-- oldCast <- V.map (\(Cast c) -> Cast $ perform dt c) <$>
|
||||
-- readTVar (testCast level)
|
||||
-- oldCat <- perform dt <$> fromJust <$> readTVar (testPlayer level)
|
||||
-- modifyTVar (testCast level) $ \cast ->
|
||||
-- let playedCast =
|
||||
-- V.map
|
||||
-- (\(Cast c) -> Cast (perform dt c))
|
||||
-- cast
|
||||
-- collidedCast =
|
||||
-- V.map
|
||||
-- (\(Cast c1) ->
|
||||
-- let partners = V.foldl
|
||||
-- (\acc@(Cast _, ires) (Cast c2) ->
|
||||
-- let res = collisionCheck dt c1 c2
|
||||
-- in
|
||||
-- if res /= NoCollision &&
|
||||
-- collisionTime res < collisionTime ires
|
||||
-- then (Cast c2, res)
|
||||
-- else acc
|
||||
-- )
|
||||
-- (Cast c1, NoCollision)
|
||||
-- playedCast
|
||||
-- in
|
||||
-- if null partners
|
||||
-- then Cast c1
|
||||
-- else
|
||||
-- uncurry
|
||||
-- (\(Cast c2) result -> Cast $ collide c1 c2 result)
|
||||
-- partners
|
||||
-- )
|
||||
-- playedCast
|
||||
-- wallCast (Cast c) =
|
||||
-- Cast $ performWorldCollision c layer dt
|
||||
-- walledCast =
|
||||
-- V.map wallCast collidedCast
|
||||
-- cattedCast = V.map
|
||||
-- (\(Cast c) ->
|
||||
-- Cast $ collide c oldCat $ collisionCheck dt c oldCat
|
||||
-- )
|
||||
-- walledCast
|
||||
-- in
|
||||
-- V.map
|
||||
-- (\(Cast c) -> Cast $
|
||||
-- move dt c
|
||||
-- )
|
||||
-- walledCast
|
||||
-- releasedEffects <- stateTVar (testPowerups level) $ \pus ->
|
||||
-- let living = V.foldl
|
||||
-- (\acc pu ->
|
||||
-- let npu = perform dt pu
|
||||
-- in
|
||||
-- if puTTL npu > 0
|
||||
-- then npu `V.cons` acc
|
||||
-- else acc
|
||||
-- )
|
||||
-- V.empty
|
||||
-- pus
|
||||
-- indexCollected = V.filter ((/= NoCollision) . snd) $
|
||||
-- V.zip (V.fromList [0..length living])
|
||||
-- (V.map
|
||||
-- (collisionCheck dt oldCat)
|
||||
-- living
|
||||
-- )
|
||||
-- collected = V.foldl
|
||||
-- (\acc (ind, _) ->
|
||||
-- (living V.! ind) `V.cons` acc
|
||||
-- )
|
||||
-- V.empty
|
||||
-- indexCollected
|
||||
-- differ = V.foldl
|
||||
-- (\acc life -> if life `V.elem` collected
|
||||
-- then acc
|
||||
-- else life `V.cons` acc
|
||||
-- )
|
||||
-- V.empty
|
||||
-- living
|
||||
-- fin = V.map
|
||||
-- (\pu -> move dt $ performWorldCollision pu layer dt)
|
||||
-- differ
|
||||
-- in
|
||||
-- (collected, fin)
|
||||
-- modifyTVar
|
||||
-- (testPlayer level) $ \(Just pituicat) ->
|
||||
-- let playedCat = perform dt pituicat
|
||||
-- castCat =
|
||||
-- let allPartners = V.zip (V.fromList [0..V.length oldCast])
|
||||
-- (V.map
|
||||
-- (\(Cast c) -> collisionCheck dt playedCat c)
|
||||
-- oldCast
|
||||
-- )
|
||||
-- filtered = (V.filter ((/= NoCollision) . snd) allPartners)
|
||||
-- partner = V.minimumBy
|
||||
-- (\(_, e) (_, f) -> collisionTime e `compare` collisionTime f)
|
||||
-- filtered
|
||||
-- in
|
||||
-- if V.null filtered
|
||||
-- then
|
||||
-- playedCat
|
||||
-- else
|
||||
-- uncurry
|
||||
-- (\(Cast c) cr -> collide playedCat c cr)
|
||||
-- (oldCast V.! fst partner, snd partner)
|
||||
-- walledCat = performWorldCollision castCat layer dt
|
||||
-- affectedCat = walledCat
|
||||
-- { pcEffects = pcEffects walledCat ++
|
||||
-- map puEffect (V.toList releasedEffects)
|
||||
-- }
|
||||
-- in Just $ move dt affectedCat
|
||||
|
||||
-- performWorldCollision
|
||||
-- :: (Collidible c)
|
||||
-- => c -- ^ Cast member to check
|
||||
-- -> Layer -- ^ The walk layer of the level
|
||||
-- -> Double -- ^ Tick length
|
||||
-- -> c -- ^ Updated cast member
|
||||
-- performWorldCollision c layer dt =
|
||||
-- let partner = V.foldl
|
||||
-- (\acc@(part, cr) tile ->
|
||||
-- let res = collisionCheck dt c tile
|
||||
-- ret = if cr == NoCollision && res == NoCollision
|
||||
-- then
|
||||
-- acc
|
||||
-- else
|
||||
-- if cr == NoCollision && res /= NoCollision
|
||||
-- then (tile, res)
|
||||
-- else
|
||||
-- if cr /= NoCollision && res == NoCollision
|
||||
-- then
|
||||
-- acc
|
||||
-- else
|
||||
-- if collisionTime cr < collisionTime res
|
||||
-- then acc
|
||||
-- else (tile, res)
|
||||
-- in
|
||||
-- ret
|
||||
-- )
|
||||
-- (V.head layer, collisionCheck dt c $ V.head layer)
|
||||
-- layer
|
||||
-- in
|
||||
-- (uncurry (collide c) partner) dt
|
||||
|
|
|
|||
|
|
@ -16,22 +16,32 @@ instance Mass Cast where
|
|||
|
||||
mass (Cast a) = mass a
|
||||
|
||||
acceleration (Cast a) = acceleration a
|
||||
|
||||
accelerationUpdater (Cast a) = Cast . accelerationUpdater a
|
||||
|
||||
velocity (Cast a) = velocity a
|
||||
|
||||
velocityUpdater (Cast a) = Cast . velocityUpdater a
|
||||
|
||||
forces (Cast a) = forces a
|
||||
|
||||
forcesUpdater (Cast a) = Cast . forcesUpdater a
|
||||
|
||||
position (Cast a) = position a
|
||||
|
||||
positionUpdater (Cast a) = Cast . positionUpdater a
|
||||
|
||||
instance Collidible Cast where
|
||||
|
||||
prevPosition (Cast c) = prevPosition c
|
||||
|
||||
impactForces (Cast c) = impactForces c
|
||||
|
||||
impactForcesUpdater (Cast c) = Cast . impactForcesUpdater c
|
||||
|
||||
collisionOccured (Cast c) = collisionOccured c
|
||||
|
||||
updateCollisionOccurence (Cast c) = Cast . updateCollisionOccurence c
|
||||
|
||||
boundary (Cast c) = boundary c
|
||||
|
||||
collisionCheck dt (Cast c1) c2 = collisionCheck dt c1 c2
|
||||
collisionCheck (Cast c1) c2 = collisionCheck c1 c2
|
||||
|
||||
collide (Cast c1) res dt = Cast $ collide c1 res dt
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@ data Tile = Tile
|
|||
{ tilePosition :: V2 Word -- ^
|
||||
, tileOffset :: (V2 Float, V2 Float) -- ^ Graphics offset on 'TileMap'
|
||||
, tileType :: TileType -- ^ Type of tile
|
||||
, tileCollided :: Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
|
@ -48,7 +49,7 @@ instance Drawable Tile where
|
|||
|
||||
-- type VertexList Tile = V.Vector
|
||||
|
||||
toVertices (Tile (V2 x y) (V2 u1 v1, V2 u2 v2) _) =
|
||||
toVertices (Tile (V2 x y) (V2 u1 v1, V2 u2 v2) _ _) =
|
||||
( V.fromList [ 0, 1, 2, 2, 3, 0 ]
|
||||
, V.fromList
|
||||
[ newVertex
|
||||
|
|
@ -76,12 +77,12 @@ instance Drawable Tile where
|
|||
|
||||
instance Mass Tile where
|
||||
|
||||
forces _ = V2 0 0
|
||||
|
||||
forcesUpdater t _ = t
|
||||
|
||||
mass _ = recip 0
|
||||
|
||||
acceleration _ = V2 0 0
|
||||
|
||||
accelerationUpdater t = const t
|
||||
|
||||
velocity _ = V2 0 0
|
||||
|
||||
velocityUpdater t = const t
|
||||
|
|
@ -95,6 +96,18 @@ instance Mass Tile where
|
|||
|
||||
instance Collidible Tile where
|
||||
|
||||
prevPosition t = position t
|
||||
|
||||
impactForces _ = V2 0 0
|
||||
|
||||
impactForcesUpdater t _ = t
|
||||
|
||||
collisionOccured t = tileCollided t
|
||||
|
||||
updateCollisionOccurence t coll = t
|
||||
{ tileCollided = coll
|
||||
}
|
||||
|
||||
boundary _ =
|
||||
( V2 (-16) (-16)
|
||||
, V2 16 16
|
||||
|
|
|
|||
|
|
@ -31,7 +31,10 @@ catMoveVelocity = 100
|
|||
|
||||
data Pituicat = Pituicat
|
||||
{ pcPos :: V2 Double
|
||||
, pcPrevPos :: V2 Double
|
||||
, pcVel :: V2 Double
|
||||
, pcForces :: V2 Double
|
||||
, pcImpactForces :: V2 Double
|
||||
, pcMoveVel :: V2 Double
|
||||
, pcTMoveVel :: V2 Double
|
||||
, pcAcc :: V2 Double
|
||||
|
|
@ -42,6 +45,7 @@ data Pituicat = Pituicat
|
|||
, pcViewDirection :: ViewDirection
|
||||
, pcEffects :: [EffectHolder]
|
||||
, pcXColl :: Bool
|
||||
, pcCollisionOcc :: Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
|
@ -50,7 +54,7 @@ data ViewDirection = ViewLeft | ViewRight
|
|||
|
||||
instance Drawable Pituicat where
|
||||
|
||||
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _ vd _ _) =
|
||||
toVertices (Pituicat (V2 x y) _ _ _ _ _ _ _ _ _ _ _ vd _ _ _) =
|
||||
( V.fromList [0, 1, 2, 2, 3, 0]
|
||||
, V.fromList
|
||||
[ newVertex
|
||||
|
|
@ -103,7 +107,7 @@ instance Actor Pituicat where
|
|||
not (any ((SpeedUp ==) . effectReleased) (pcEffects p))
|
||||
then 1
|
||||
else 2
|
||||
physCat = (accelerate dt . gravitate constG)
|
||||
physCat =
|
||||
(p
|
||||
{ pcAcc = V2 0 0
|
||||
, pcTMoveVel =
|
||||
|
|
@ -149,13 +153,6 @@ instance Mass Pituicat where
|
|||
|
||||
mass _ = 100
|
||||
|
||||
acceleration = pcAcc
|
||||
|
||||
accelerationUpdater cat =
|
||||
\accel -> cat
|
||||
{ pcAcc = accel
|
||||
}
|
||||
|
||||
velocity =
|
||||
pcVel
|
||||
|
||||
|
|
@ -164,6 +161,12 @@ instance Mass Pituicat where
|
|||
{ pcVel = vel
|
||||
}
|
||||
|
||||
forces = pcForces
|
||||
|
||||
forcesUpdater c force = c
|
||||
{ pcForces = force
|
||||
}
|
||||
|
||||
position = pcPos
|
||||
|
||||
positionUpdater cat =
|
||||
|
|
@ -171,15 +174,22 @@ instance Mass Pituicat where
|
|||
{ pcPos = pos
|
||||
}
|
||||
|
||||
move dt cat =
|
||||
let dpos = (dt *) <$> velocity cat
|
||||
mpos = (dt *) <$>
|
||||
(if pcXColl cat then V2 (-1) 1 else V2 1 1) * pcMoveVel cat
|
||||
in
|
||||
positionUpdater cat (position cat + dpos + mpos)
|
||||
|
||||
instance Collidible Pituicat where
|
||||
|
||||
impactForces = pcImpactForces
|
||||
|
||||
impactForcesUpdater c force = c
|
||||
{ pcImpactForces = force
|
||||
}
|
||||
|
||||
collisionOccured = pcCollisionOcc
|
||||
|
||||
updateCollisionOccurence c coll = c
|
||||
{ pcCollisionOcc = coll
|
||||
}
|
||||
|
||||
prevPosition = pcPrevPos
|
||||
|
||||
boundary cat =
|
||||
if pcViewDirection cat == ViewRight
|
||||
then
|
||||
|
|
@ -196,12 +206,12 @@ instance Collidible Pituicat where
|
|||
}
|
||||
collide cat collrs@((_, NoCollision):_) _ = cat
|
||||
{ pcXColl = any
|
||||
(\(_, CollisionImminent _ (V2 cx _)) -> cx /= 0)
|
||||
(\(_, OverlapCollision (V2 cx _)) -> cx /= 0)
|
||||
(filter ((NoCollision /= ) . snd) collrs)
|
||||
}
|
||||
collide cat collrs@(collr@(_, OverlapCollision direction):_) dt =
|
||||
elasticCollision 0.3 cat collr dt
|
||||
collide cat collrs@(collr@(other, CollisionImminent ddt (V2 dirx diry)):_) dt =
|
||||
collide cat collrs@(collr@(other, OverlapCollision (V2 dirx diry)):_) dt =
|
||||
let ncat = elasticCollision 0.3 cat collr dt
|
||||
vel@(V2 vx vy) = velocity ncat
|
||||
moveVel@(V2 mx my) = pcMoveVel cat
|
||||
|
|
|
|||
|
|
@ -17,21 +17,23 @@ import Graphics.Types.Texture
|
|||
import Graphics.Classes.Drawable
|
||||
import Graphics.Classes.Bindable
|
||||
|
||||
import Util
|
||||
|
||||
data PowerUp = PowerUp
|
||||
{ puPos :: V2 Double
|
||||
, puVel :: V2 Double
|
||||
, puAcc :: V2 Double
|
||||
, puTTL :: Double
|
||||
, puTexture :: Texture
|
||||
, puEffect :: EffectHolder
|
||||
{ puPos :: V2 Double
|
||||
, puPrevPos :: V2 Double
|
||||
, puVel :: V2 Double
|
||||
, puAcc :: V2 Double
|
||||
, puTTL :: Double
|
||||
, puTexture :: Texture
|
||||
, puEffect :: EffectHolder
|
||||
, puForces :: V2 Double
|
||||
, puImpactForces :: V2 Double
|
||||
, puCollided :: Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
instance Drawable PowerUp where
|
||||
|
||||
toVertices (PowerUp (V2 x y) _ _ _ _ _) =
|
||||
toVertices (PowerUp (V2 x y) _ _ _ _ _ _ _ _ _) =
|
||||
( V.fromList [0, 1, 2, 2, 3, 0]
|
||||
, V.fromList
|
||||
[ newVertex
|
||||
|
|
@ -66,7 +68,7 @@ instance Prop PowerUp where
|
|||
instance Actor PowerUp where
|
||||
|
||||
perform dt o =
|
||||
let phys = (accelerate dt . gravitate constG)
|
||||
let phys =
|
||||
o
|
||||
{ puAcc = V2 0 0
|
||||
, puTTL = puTTL o - dt
|
||||
|
|
@ -78,12 +80,11 @@ instance Mass PowerUp where
|
|||
|
||||
mass _ = 0.1
|
||||
|
||||
acceleration = puAcc
|
||||
forces = puForces
|
||||
|
||||
accelerationUpdater o =
|
||||
\acc -> o
|
||||
{ puAcc = acc
|
||||
}
|
||||
forcesUpdater p force = p
|
||||
{ puForces = force
|
||||
}
|
||||
|
||||
velocity = puVel
|
||||
|
||||
|
|
@ -101,6 +102,20 @@ instance Mass PowerUp where
|
|||
|
||||
instance Collidible PowerUp where
|
||||
|
||||
prevPosition = puPrevPos
|
||||
|
||||
impactForces = puImpactForces
|
||||
|
||||
impactForcesUpdater p force = p
|
||||
{ puImpactForces = force
|
||||
}
|
||||
|
||||
collisionOccured = puCollided
|
||||
|
||||
updateCollisionOccurence p coll = p
|
||||
{ puCollided = coll
|
||||
}
|
||||
|
||||
boundary _ =
|
||||
( V2 (-20) (-20)
|
||||
, V2 20 20
|
||||
|
|
|
|||
|
|
@ -3,20 +3,18 @@ module Util where
|
|||
import Affection
|
||||
|
||||
import qualified SDL
|
||||
import qualified SDL.Internal.Numbered as SDL
|
||||
|
||||
import Linear
|
||||
|
||||
-- internal imports
|
||||
|
||||
import Types.Application
|
||||
import Types.Subsystems
|
||||
|
||||
globalKeyHandle
|
||||
:: GameData
|
||||
-> KeyboardMessage
|
||||
-> Affection ()
|
||||
globalKeyHandle gd mesg@(MsgKeyboardEvent time win motion repeat keysym) =
|
||||
globalKeyHandle _ mesg@MsgKeyboardEvent {} =
|
||||
case mesg of
|
||||
MsgKeyboardEvent
|
||||
_
|
||||
|
|
|
|||
Loading…
Reference in a new issue