reworking walking

movable_objects2
nek0 1 year ago
parent 87b70cd93a
commit 8dd37e8e95
  1. 23
      src/Physics/Classes/Collidible.hs
  2. 1
      src/Scenes/Test/Load.hs
  3. 84
      src/Scenes/Test/Update.hs
  4. 2
      src/Types/Cast.hs
  5. 104
      src/Types/Player.hs
  6. 7
      src/Types/PowerUp.hs
  7. 8
      src/Types/Tangible.hs

@ -195,11 +195,11 @@ class (Show c, Mass c) => Collidible c where
-- | This Function is called for every collision on both colliding objects.
collide
:: (Collidible other)
=> c -- ^ Original object
-> other -- ^ Collision partner
-> CollisionResult Double (V2 Int) -- ^ Collision reaction
-> c -- ^ Updated original object
collide = elasticCollision 1
=> 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)
-- | 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)))
nvel
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)
res =
(\(pindex, presult) ->
digest = map
(\(pindex, presults) ->
( snd $ indexedTangibles V.! pindex
, presults
)
)
partners
res =
(\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,29 +159,13 @@ 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
}
-- 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 [] _ = cat
{ pcXColl = False
}
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…
Cancel
Save