reworking walking
This commit is contained in:
parent
87b70cd93a
commit
8dd37e8e95
7 changed files with 114 additions and 115 deletions
|
|
@ -196,10 +196,10 @@ class (Show c, Mass c) => Collidible c where
|
|||
collide
|
||||
:: (Collidible other)
|
||||
=> c -- ^ Original object
|
||||
-> other -- ^ Collision partner
|
||||
-> CollisionResult Double (V2 Int) -- ^ Collision reaction
|
||||
-> [(other, CollisionResult Double (V2 Int))] -- ^ Collision partners and results
|
||||
-> Double -- ^ Timestep length
|
||||
-> c -- ^ Updated original object
|
||||
collide = elasticCollision 1
|
||||
collide coll1 collrs = elasticCollision 0.9 coll1 (head collrs)
|
||||
|
||||
-- | Implementation of a dampened elastic collision used as default collision
|
||||
-- implementation of the collision reaction
|
||||
|
|
@ -207,11 +207,11 @@ elasticCollision
|
|||
:: (Collidible c1, Collidible c2)
|
||||
=> Double
|
||||
-> c1
|
||||
-> c2
|
||||
-> CollisionResult Double (V2 Int)
|
||||
-> (c2, CollisionResult Double (V2 Int))
|
||||
-> Double -- ^ Timestep length
|
||||
-> c1
|
||||
elasticCollision _ mo1 _ NoCollision = mo1
|
||||
elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx _)) =
|
||||
elasticCollision _ mo1 (_, NoCollision) _ = mo1
|
||||
elasticCollision damping mo1 (mo2, (Collision ddt (V2 dirx _))) _ =
|
||||
let v1@(V2 v1x v1y) = velocity mo1
|
||||
(V2 v2x v2y) = velocity mo2
|
||||
p1 = position mo1
|
||||
|
|
@ -230,5 +230,6 @@ elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx _)) =
|
|||
else V2 v1x' v1y'
|
||||
in
|
||||
velocityUpdater
|
||||
(positionUpdater mo1 (p1 + ((ddt *) <$> v1)))
|
||||
mo1
|
||||
-- (positionUpdater mo1 (p1 + ((ddt *) <$> v1)))
|
||||
nvel
|
||||
|
|
|
|||
|
|
@ -84,6 +84,7 @@ load level progress = do
|
|||
Nothing
|
||||
ViewRight
|
||||
[]
|
||||
False
|
||||
oil = PowerUp
|
||||
(realToFrac <$> (startpos + V2 200 0))
|
||||
(V2 0 0)
|
||||
|
|
|
|||
|
|
@ -68,25 +68,31 @@ update level dt = liftIO $ do
|
|||
then iacc
|
||||
else iacc `V.snoc`
|
||||
( index
|
||||
, head
|
||||
(sortOn (collisionTime . snd) (V.toList partners))
|
||||
, sortOn (collisionTime . snd) (V.toList partners)
|
||||
)
|
||||
)
|
||||
V.empty
|
||||
indexedTangibles
|
||||
updater (aindex, partner) =
|
||||
updater (aindex, partners) =
|
||||
let aobject = (snd $ indexedTangibles V.! aindex)
|
||||
digest = map
|
||||
(\(pindex, presults) ->
|
||||
( snd $ indexedTangibles V.! pindex
|
||||
, presults
|
||||
)
|
||||
)
|
||||
partners
|
||||
res =
|
||||
(\(pindex, presult) ->
|
||||
(\d ->
|
||||
let inter =
|
||||
collide
|
||||
aobject
|
||||
(snd $ indexedTangibles V.! pindex)
|
||||
presult
|
||||
d
|
||||
dt
|
||||
in
|
||||
inter
|
||||
)
|
||||
partner
|
||||
digest
|
||||
in
|
||||
(aindex, res)
|
||||
in
|
||||
|
|
@ -219,34 +225,34 @@ update level dt = liftIO $ do
|
|||
-- }
|
||||
-- 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
|
||||
-- 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
|
||||
|
|
|
|||
|
|
@ -34,4 +34,4 @@ instance Collidible Cast where
|
|||
|
||||
collisionCheck dt (Cast c1) c2 = collisionCheck dt c1 c2
|
||||
|
||||
collide (Cast c1) c2 res = Cast $ collide c1 c2 res
|
||||
collide (Cast c1) res dt = Cast $ collide c1 res dt
|
||||
|
|
|
|||
|
|
@ -41,6 +41,7 @@ data Pituicat = Pituicat
|
|||
, pcMoveState :: Maybe Action
|
||||
, pcViewDirection :: ViewDirection
|
||||
, pcEffects :: [EffectHolder]
|
||||
, pcXColl :: Bool
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
|
|
@ -49,7 +50,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
|
||||
|
|
@ -116,6 +117,9 @@ instance Actor Pituicat where
|
|||
{ pcMoveVel =
|
||||
lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
|
||||
, pcGrounded = pcGrounded physCat && abs dy * dt <= 2
|
||||
, pcPos = pcPos physCat + if not (pcXColl physCat)
|
||||
then ((dt *) <$> pcMoveVel physCat)
|
||||
else V2 0 0
|
||||
, pcEffects =
|
||||
foldl
|
||||
(\acc eff ->
|
||||
|
|
@ -155,28 +159,12 @@ instance Mass Pituicat where
|
|||
{ pcAcc = accel
|
||||
}
|
||||
|
||||
velocity cat =
|
||||
let mvel@(V2 mx _) = pcMoveVel cat
|
||||
nvel@(V2 x y) = pcVel cat + mvel
|
||||
in
|
||||
if abs x > abs mx then V2 (signum x * abs mx) y else nvel
|
||||
velocity =
|
||||
pcVel
|
||||
|
||||
velocityUpdater cat =
|
||||
\(V2 vx vy) ->
|
||||
let
|
||||
(V2 mx my) = pcMoveVel cat
|
||||
nvel = V2
|
||||
(if abs mx > abs vx
|
||||
then 0
|
||||
else signum vx * (abs vx - abs mx)
|
||||
)
|
||||
(if abs my > abs vy
|
||||
then 0
|
||||
else signum vy * (abs vy - abs my)
|
||||
)
|
||||
in
|
||||
cat
|
||||
{ pcVel = nvel
|
||||
\vel -> cat
|
||||
{ pcVel = vel
|
||||
}
|
||||
|
||||
position = pcPos
|
||||
|
|
@ -199,41 +187,43 @@ instance Collidible Pituicat where
|
|||
, V2 18 15
|
||||
)
|
||||
|
||||
collide cat _ NoCollision = cat
|
||||
collide cat other collr@(Collision ddt (V2 dirx diry)) =
|
||||
let ncat = elasticCollision 0.3 cat other collr
|
||||
nvel@(V2 _ vy) = pcVel ncat
|
||||
grounded = diry == -1 && abs (vy * ddt) < 2
|
||||
fact = fromIntegral <$> V2
|
||||
(1 - abs dirx)
|
||||
(if diry /= -1 && quadrance nvel > bounceThreshold then 1 else 0)
|
||||
in
|
||||
ncat
|
||||
{ pcVel = nvel * fact
|
||||
, pcMoveVel = pcMoveVel ncat * fact
|
||||
, pcTMoveVel = pcTMoveVel ncat * fact
|
||||
, pcGrounded = grounded
|
||||
collide cat [] _ = cat
|
||||
{ pcXColl = False
|
||||
}
|
||||
-- let ncat = (elasticCollision 0.3 cat other collr)
|
||||
-- vel@(V2 vx vy) = velocity ncat
|
||||
-- moveVel@(V2 mx my) = pcMoveVel cat
|
||||
-- nvel = V2
|
||||
-- (if abs mx > abs vx
|
||||
-- then 0
|
||||
-- else (signum vx) * (abs vx - abs mx)
|
||||
-- )
|
||||
-- ((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat))
|
||||
-- grounded =
|
||||
-- diry == -1 && abs (vy * ddt) < 2
|
||||
collide cat collrs@((_, NoCollision):_) _ = cat
|
||||
{ pcXColl = any
|
||||
(\(_, Collision _ (V2 cx _)) -> cx /= 0)
|
||||
(filter ((NoCollision /= ) . snd) collrs)
|
||||
}
|
||||
collide cat collrs@(collr@((other, Collision ddt (V2 dirx diry))):_) dt =
|
||||
-- let ncat = elasticCollision 0.3 cat other collr
|
||||
-- nvel@(V2 _ vy) = pcVel ncat
|
||||
-- grounded = diry == -1 && abs (vy * ddt) < 2
|
||||
-- fact = fromIntegral <$> V2
|
||||
-- (1 - abs dirx)
|
||||
-- (if diry /= -1 && quadrance nvel > bounceThreshold then 1 else 0)
|
||||
-- in
|
||||
-- ncat
|
||||
-- { pcGrounded = grounded
|
||||
-- , pcMoveVel = pcMoveVel ncat *
|
||||
-- if dirx /= 0
|
||||
-- then V2 0 1
|
||||
-- else V2 1 1
|
||||
-- , pcVel = nvel *
|
||||
-- if dirx /= 0
|
||||
-- then V2 0 1
|
||||
-- else V2 1 1
|
||||
-- { pcVel = nvel * fact
|
||||
-- , pcMoveVel = pcMoveVel ncat * fact
|
||||
-- , pcTMoveVel = pcTMoveVel ncat * fact
|
||||
-- , pcGrounded = grounded
|
||||
-- }
|
||||
let ncat = elasticCollision 0.3 cat collr dt
|
||||
vel@(V2 vx vy) = velocity ncat
|
||||
moveVel@(V2 mx my) = pcMoveVel cat
|
||||
nvel = V2
|
||||
(if abs mx > abs vx
|
||||
then 0
|
||||
else signum vx * (abs vx - abs mx)
|
||||
)
|
||||
((\(V2 _ y) -> y) (if diry /= 0 then pcVel ncat else pcVel cat))
|
||||
grounded =
|
||||
diry == -1 && abs (vy * ddt) < 2
|
||||
in
|
||||
ncat
|
||||
{ pcGrounded = grounded
|
||||
, pcXColl = any
|
||||
(\(_, Collision _ (V2 cx _)) -> cx /= 0)
|
||||
(filter ((NoCollision /=) . snd) collrs) || dirx /= 0
|
||||
}
|
||||
|
|
|
|||
|
|
@ -106,10 +106,11 @@ instance Collidible PowerUp where
|
|||
, V2 20 20
|
||||
)
|
||||
|
||||
collide o _ NoCollision = o
|
||||
collide o ((_, NoCollision):_) _ = o
|
||||
collide o [] _ = o
|
||||
|
||||
collide o other collr@(Collision ddr (V2 dirx diry)) =
|
||||
let no = elasticCollision 0.5 o other collr
|
||||
collide o (collr:_) dt =
|
||||
let no = elasticCollision 0.5 o collr dt
|
||||
in
|
||||
no
|
||||
|
||||
|
|
|
|||
|
|
@ -70,7 +70,7 @@ instance Collidible Tangible where
|
|||
collisionCheck dt (TPowerUp c1) c2 = collisionCheck dt c1 c2
|
||||
collisionCheck dt (TTile c1) c2 = collisionCheck dt c1 c2
|
||||
|
||||
collide (TPlayer c1) c2 res = TPlayer $ collide c1 c2 res
|
||||
collide (TCast c1) c2 res = TCast $ collide c1 c2 res
|
||||
collide (TPowerUp c1) c2 res = TPowerUp $ collide c1 c2 res
|
||||
collide (TTile c1) c2 res = TTile $ collide c1 c2 res
|
||||
collide (TPlayer c1) res dt = TPlayer $ collide c1 res dt
|
||||
collide (TCast c1) res dt = TCast $ collide c1 res dt
|
||||
collide (TPowerUp c1) res dt = TPowerUp $ collide c1 res dt
|
||||
collide (TTile c1) res dt = TTile $ collide c1 res dt
|
||||
|
|
|
|||
Loading…
Reference in a new issue