reworking walking

This commit is contained in:
nek0 2021-07-24 09:35:41 +02:00
parent 87b70cd93a
commit 8dd37e8e95
7 changed files with 114 additions and 115 deletions

View File

@ -195,11 +195,11 @@ class (Show c, Mass c) => Collidible c where
-- | This Function is called for every collision on both colliding objects. -- | This Function is called for every collision on both colliding objects.
collide collide
:: (Collidible other) :: (Collidible other)
=> c -- ^ Original object => c -- ^ Original object
-> other -- ^ Collision partner -> [(other, CollisionResult Double (V2 Int))] -- ^ Collision partners and results
-> CollisionResult Double (V2 Int) -- ^ Collision reaction -> Double -- ^ Timestep length
-> c -- ^ Updated original object -> 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 a dampened elastic collision used as default collision
-- implementation of the collision reaction -- implementation of the collision reaction
@ -207,11 +207,11 @@ elasticCollision
:: (Collidible c1, Collidible c2) :: (Collidible c1, Collidible c2)
=> Double => Double
-> c1 -> c1
-> c2 -> (c2, CollisionResult Double (V2 Int))
-> CollisionResult Double (V2 Int) -> Double -- ^ Timestep length
-> c1 -> c1
elasticCollision _ mo1 _ NoCollision = mo1 elasticCollision _ mo1 (_, NoCollision) _ = mo1
elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx _)) = elasticCollision damping mo1 (mo2, (Collision ddt (V2 dirx _))) _ =
let v1@(V2 v1x v1y) = velocity mo1 let v1@(V2 v1x v1y) = velocity mo1
(V2 v2x v2y) = velocity mo2 (V2 v2x v2y) = velocity mo2
p1 = position mo1 p1 = position mo1
@ -230,5 +230,6 @@ elasticCollision damping mo1 mo2 (Collision ddt (V2 dirx _)) =
else V2 v1x' v1y' else V2 v1x' v1y'
in in
velocityUpdater velocityUpdater
(positionUpdater mo1 (p1 + ((ddt *) <$> v1))) mo1
nvel -- (positionUpdater mo1 (p1 + ((ddt *) <$> v1)))
nvel

View File

@ -84,6 +84,7 @@ load level progress = do
Nothing Nothing
ViewRight ViewRight
[] []
False
oil = PowerUp oil = PowerUp
(realToFrac <$> (startpos + V2 200 0)) (realToFrac <$> (startpos + V2 200 0))
(V2 0 0) (V2 0 0)

View File

@ -68,25 +68,31 @@ update level dt = liftIO $ do
then iacc then iacc
else iacc `V.snoc` else iacc `V.snoc`
( index ( index
, head , sortOn (collisionTime . snd) (V.toList partners)
(sortOn (collisionTime . snd) (V.toList partners))
) )
) )
V.empty V.empty
indexedTangibles indexedTangibles
updater (aindex, partner) = updater (aindex, partners) =
let aobject = (snd $ indexedTangibles V.! aindex) let aobject = (snd $ indexedTangibles V.! aindex)
res = digest = map
(\(pindex, presult) -> (\(pindex, presults) ->
( snd $ indexedTangibles V.! pindex
, presults
)
)
partners
res =
(\d ->
let inter = let inter =
collide collide
aobject aobject
(snd $ indexedTangibles V.! pindex) d
presult dt
in in
inter inter
) )
partner digest
in in
(aindex, res) (aindex, res)
in in
@ -219,34 +225,34 @@ update level dt = liftIO $ do
-- } -- }
-- in Just $ move dt affectedCat -- in Just $ move dt affectedCat
performWorldCollision -- performWorldCollision
:: (Collidible c) -- :: (Collidible c)
=> c -- ^ Cast member to check -- => c -- ^ Cast member to check
-> Layer -- ^ The walk layer of the level -- -> Layer -- ^ The walk layer of the level
-> Double -- ^ Tick length -- -> Double -- ^ Tick length
-> c -- ^ Updated cast member -- -> c -- ^ Updated cast member
performWorldCollision c layer dt = -- performWorldCollision c layer dt =
let partner = V.foldl -- let partner = V.foldl
(\acc@(part, cr) tile -> -- (\acc@(part, cr) tile ->
let res = collisionCheck dt c tile -- let res = collisionCheck dt c tile
ret = if cr == NoCollision && res == NoCollision -- ret = if cr == NoCollision && res == NoCollision
then -- then
acc -- acc
else -- else
if cr == NoCollision && res /= NoCollision -- if cr == NoCollision && res /= NoCollision
then (tile, res) -- then (tile, res)
else -- else
if cr /= NoCollision && res == NoCollision -- if cr /= NoCollision && res == NoCollision
then -- then
acc -- acc
else -- else
if collisionTime cr < collisionTime res -- if collisionTime cr < collisionTime res
then acc -- then acc
else (tile, res) -- else (tile, res)
in -- in
ret -- ret
) -- )
(V.head layer, collisionCheck dt c $ V.head layer) -- (V.head layer, collisionCheck dt c $ V.head layer)
layer -- layer
in -- in
uncurry (collide c) partner -- (uncurry (collide c) partner) dt

View File

@ -34,4 +34,4 @@ instance Collidible Cast where
collisionCheck dt (Cast c1) c2 = collisionCheck dt c1 c2 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

View File

@ -41,6 +41,7 @@ data Pituicat = Pituicat
, pcMoveState :: Maybe Action , pcMoveState :: Maybe Action
, pcViewDirection :: ViewDirection , pcViewDirection :: ViewDirection
, pcEffects :: [EffectHolder] , pcEffects :: [EffectHolder]
, pcXColl :: Bool
} }
deriving (Eq, Show) deriving (Eq, Show)
@ -49,7 +50,7 @@ data ViewDirection = ViewLeft | ViewRight
instance Drawable Pituicat where 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 [0, 1, 2, 2, 3, 0]
, V.fromList , V.fromList
[ newVertex [ newVertex
@ -116,6 +117,9 @@ instance Actor Pituicat where
{ pcMoveVel = { pcMoveVel =
lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat) lerp (min 0.95 (60 * dt)) (pcMoveVel physCat) (pcTMoveVel physCat)
, pcGrounded = pcGrounded physCat && abs dy * dt <= 2 , pcGrounded = pcGrounded physCat && abs dy * dt <= 2
, pcPos = pcPos physCat + if not (pcXColl physCat)
then ((dt *) <$> pcMoveVel physCat)
else V2 0 0
, pcEffects = , pcEffects =
foldl foldl
(\acc eff -> (\acc eff ->
@ -155,29 +159,13 @@ instance Mass Pituicat where
{ pcAcc = accel { pcAcc = accel
} }
velocity cat = velocity =
let mvel@(V2 mx _) = pcMoveVel cat pcVel
nvel@(V2 x y) = pcVel cat + mvel
in
if abs x > abs mx then V2 (signum x * abs mx) y else nvel
velocityUpdater cat = velocityUpdater cat =
\(V2 vx vy) -> \vel -> cat
let { pcVel = vel
(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
}
position = pcPos position = pcPos
@ -199,41 +187,43 @@ instance Collidible Pituicat where
, V2 18 15 , V2 18 15
) )
collide cat _ NoCollision = cat collide cat [] _ = cat
collide cat other collr@(Collision ddt (V2 dirx diry)) = { pcXColl = False
let ncat = elasticCollision 0.3 cat other collr }
nvel@(V2 _ vy) = pcVel ncat collide cat collrs@((_, NoCollision):_) _ = cat
grounded = diry == -1 && abs (vy * ddt) < 2 { pcXColl = any
fact = fromIntegral <$> V2 (\(_, Collision _ (V2 cx _)) -> cx /= 0)
(1 - abs dirx) (filter ((NoCollision /= ) . snd) collrs)
(if diry /= -1 && quadrance nvel > bounceThreshold then 1 else 0) }
in collide cat collrs@(collr@((other, Collision ddt (V2 dirx diry))):_) dt =
ncat -- let ncat = elasticCollision 0.3 cat other collr
{ pcVel = nvel * fact -- nvel@(V2 _ vy) = pcVel ncat
, pcMoveVel = pcMoveVel ncat * fact -- grounded = diry == -1 && abs (vy * ddt) < 2
, pcTMoveVel = pcTMoveVel ncat * fact -- fact = fromIntegral <$> V2
, pcGrounded = grounded -- (1 - abs dirx)
} -- (if diry /= -1 && quadrance nvel > bounceThreshold then 1 else 0)
-- 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
-- in -- in
-- ncat -- ncat
-- { pcGrounded = grounded -- { pcVel = nvel * fact
-- , pcMoveVel = pcMoveVel ncat * -- , pcMoveVel = pcMoveVel ncat * fact
-- if dirx /= 0 -- , pcTMoveVel = pcTMoveVel ncat * fact
-- then V2 0 1 -- , pcGrounded = grounded
-- else V2 1 1
-- , pcVel = nvel *
-- if dirx /= 0
-- then V2 0 1
-- else V2 1 1
-- } -- }
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
}

View File

@ -106,10 +106,11 @@ instance Collidible PowerUp where
, V2 20 20 , V2 20 20
) )
collide o _ NoCollision = o collide o ((_, NoCollision):_) _ = o
collide o [] _ = o
collide o other collr@(Collision ddr (V2 dirx diry)) = collide o (collr:_) dt =
let no = elasticCollision 0.5 o other collr let no = elasticCollision 0.5 o collr dt
in in
no no

View File

@ -70,7 +70,7 @@ instance Collidible Tangible where
collisionCheck dt (TPowerUp c1) c2 = collisionCheck dt c1 c2 collisionCheck dt (TPowerUp c1) c2 = collisionCheck dt c1 c2
collisionCheck dt (TTile 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 (TPlayer c1) res dt = TPlayer $ collide c1 res dt
collide (TCast c1) c2 res = TCast $ collide c1 c2 res collide (TCast c1) res dt = TCast $ collide c1 res dt
collide (TPowerUp c1) c2 res = TPowerUp $ collide c1 c2 res collide (TPowerUp c1) res dt = TPowerUp $ collide c1 res dt
collide (TTile c1) c2 res = TTile $ collide c1 c2 res collide (TTile c1) res dt = TTile $ collide c1 res dt