justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Tweak creature cliff interaction, using updateCarriage

Browse Source
This commit is contained in:
justin
2026-04-05 15:14:50 +01:00
parent 22a1162e14
commit d5c98f7c4e
4 changed files with 130 additions and 100 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Corpse/Make.hs
+1 -1
View File
@@ -35,7 +35,7 @@ chaseCorpse cr = mconcat
& each %~ vNormal
& each . _y *~ 0.6
, colorSH (_skinUpper cskin) . overPosSH (Q.apply neckq) $
(upperPrismPolyHalfMI 3 $ (+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
upperPrismPolyHalfMI 3 ((+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
, colorSH (_skinHead cskin)
(overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
src/Dodge/Creature/State/WalkCycle.hs
+91 -11
View File
@@ -2,8 +2,11 @@
module Dodge.Creature.State.WalkCycle (updateCarriage) where
import Dodge.Creature.Radius
import Geometry
import Dodge.Update.Camera.Rotate
import qualified SDL
import Dodge.WorldEvent.ThingsHit
import Geometry.Polygon
import Data.Maybe
import Dodge.Creature.HandPos
import Linear
@@ -19,16 +22,9 @@ updateCarriage cid w = fromMaybe w $ do
updateCarriage' :: Int -> Creature -> World -> Carriage -> World
updateCarriage' cid cr w = \case
Walking -> case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just x,Just ff) | x >= strideLength cr -> w
& soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos . _xy)
(chooseFootSound ff)
Nothing
& over (cWorld . lWorld . creatures . ix cid . crType) resetStride
& tocr . crPos . _xy +~ 0.5 *^ (cr ^. crOldPos - oop) ^. _xy
_ -> w & tocr . crPos . _xy +~ 0.5 *^ (cr ^. crOldPos - oop) ^. _xy
Walking -> maybeTakeStep cid cr w
& tocr . crPos . _xy +~ 0.5 *^ (cr ^. crOldPos - oop) ^. _xy
& chasmTestCliffPush walkCliffPush cr
Floating -> w
Flying {_zSpeed = dz, _flyInertia = x} ->
w & tocr . crPos . _xy +~ x *^ f (cr ^. crOldPos . _xy - oop ^. _xy)
@@ -47,12 +43,96 @@ updateCarriage' cid cr w = \case
else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep
OnGround {} -> w
& tocr . crPos . _xy +~ 0.8 *^ (cr ^. crOldPos . _xy - oop ^. _xy)
& chasmTestCliffPush groundCliffPush cr
where
tocr = cWorld . lWorld . creatures . ix cid
oop = cr ^. crOldOldPos
f v | norm v > 10 = 10 *^ signorm v
| otherwise = v
pushAgainst :: Point2 -> Point2 -> Point2
pushAgainst x y
| a > norm y = 0
| a > 0 = y - project y x
| otherwise = y
where
-- project y x is the projection of x onto y
a = dotV (normalize y) (project y x)
walkCliffPush :: Creature -> [(Point2,Point2)] -> Point2
walkCliffPush cr xs = pushAgainst (cr ^. crOldPos . _xy - cr ^. crOldOldPos . _xy) (-h xs)
where
cxy = cr ^. crPos . _xy
h = circSegsInside cxy (cr ^. crType . to crRad)
groundCliffPush :: Creature -> [(Point2,Point2)] -> Point2
groundCliffPush cr xs = x *^ h xs
where
--x = max 0.05 $ 0.05 + 0.05 * (1 - dist cxy p / (2*r))
x = max 0 $ 0.25 * (1 - dist cxy p / (2*r)) ** 2
cxy = cr ^. crPos . _xy
r = cr ^. crType . to crRad
h = circSegsInside cxy r
p = circSegsInside' cxy r xs
circSegsInside' :: Point2 -> Float -> [(Point2,Point2)] -> Point2
circSegsInside' p r = \case
[x,y] -> fromJust (uncurry (uncurry intersectLineLine (f x)) (f y))
((x,y):_) -> closestPointOnLine x y p + r *^ normalizeV (vNormal (x-y))
_ -> error "circSegsInside"
where
r' = r+0.5
f (x,y) = (x+r'*^n,y+r'*^n)
where
n = normalizeV (vNormal (x-y))
circSegsInside :: Point2 -> Float -> [(Point2,Point2)] -> Point2
circSegsInside p r = \case
[x,y] -> normalize $ fromJust (uncurry (uncurry intersectLineLine (f x)) (f y)) - p
((x,y):_) -> normalizeV (vNormal (x-y))
_ -> error "circSegsInside"
where
r' = r+0.5
f (x,y) = (x+r'*^n,y+r'*^n)
where
n = normalizeV (vNormal (x-y))
--circTwoLineCorner :: Float -> Point2 -> Point2 -> Point2 -> Point2 -> Maybe Point2
--circTwoLineCorner r x y a b = intersectLineLine x y a b
chasmTestCliffPush :: (Creature -> [(Point2,Point2)] -> Point2) -> Creature -> World -> World
chasmTestCliffPush f' cr w
| (xy:xys) <- filter g (w ^. cWorld . cliffs) =
w
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
& tocr . crPos . _xy +~ f' cr (xy:xys) -- (f cr (xy:xys)) *^ h xy xys
& chasmRotate cr (uncurry (-) xy)
| any f (w ^. cWorld . chasms) = w & tocr . crStance . carriage .~ Falling -- %~ startFalling
| otherwise = w
where
cxy = cr ^. crPos . _xy
tocr = cWorld . lWorld . creatures . ix (_crID cr)
g = uncurry $ crOnSeg cr
f = pointInPoly cxy
chasmRotate :: Creature -> Point2 -> World -> World
chasmRotate cr v w
| t = rotateTo8 (argV v) w
| otherwise = w
where
t = cr ^. crID == 0 && null (w ^? input . mouseButtons . ix SDL.ButtonRight)
maybeTakeStep :: Int -> Creature -> World -> World
maybeTakeStep cid cr = case (cr ^? crType . strideAmount,cr ^? crType . footForward) of
(Just x,Just ff) | x >= strideLength cr ->
soundMultiFrom
[FootstepSound i | i <- [0 .. 10]]
(cr ^. crPos . _xy)
(chooseFootSound ff)
Nothing
. over (cWorld . lWorld . creatures . ix cid . crType) resetStride
_ -> id
resetStride :: CreatureType -> CreatureType
resetStride ct = case ct ^? footForward of
src/Dodge/Creature/Update.hs
+9 -62
View File
@@ -1,18 +1,15 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.Update (updateCreature) where
import Dodge.WorldEvent.ThingsHit
import Dodge.Base.You
import Control.Monad
import Color
import qualified Data.IntMap.Strict as IM
import qualified Data.List as List
import Data.Maybe
import Dodge.Barreloid
-- import Dodge.Base.NewID
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Radius
import Dodge.Creature.State
import Dodge.Creature.State.WalkCycle
import Dodge.Creature.Vocalization
@@ -25,14 +22,12 @@ import Dodge.Inventory
import Dodge.Lampoid
import Dodge.Prop.Gib
import Dodge.SoundLogic
import Dodge.Update.Camera.Rotate
import FoldableHelp
import Geometry
import LensHelp
import Linear
import NewInt
import RandomHelp
import SDL (MouseButton (..))
import Shape
import ShapePicture.Data
@@ -41,7 +36,7 @@ import ShapePicture.Data
updateCreature :: Creature -> World -> World
updateCreature cr
| cr ^. crPos . _z < negate 300 = (tocr . crHP .~ CrDestroyed Pitted) . destroyAllInvItems cr
| CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr) . chasmTestCorpse cr
| CrIsCorpse _ <- cr ^. crHP = updateCarriage (_crID cr)
| null (cr ^? crHP . _HP) = id
| otherwise = updateLivingCreature cr
where
@@ -49,7 +44,7 @@ updateCreature cr
updateLivingCreature :: Creature -> World -> World
updateLivingCreature cr =
chasmTestLiving cr . case _crType cr of
case _crType cr of
Avatar{} ->
(cWorld . lWorld . creatures . ix 0 . crType . avatarPulse %~ updatePulse)
. crUpdate cid
@@ -130,7 +125,8 @@ startDeathTimer cr = cr
toDeathCarriage :: Carriage -> Carriage
toDeathCarriage = \case
Flying {} -> Falling
x -> x
Walking -> OnGround
_ -> Falling
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
@@ -142,7 +138,7 @@ corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of
sethp (CrIsCorpse $ poisonSPic thecorpse)
. dodeathsound PoisonDeath
Just PhysicalDamage
| _crPain cr > 200 ->
| _crPain cr > 300 ->
makeCrGibs cr
. sethp (CrDestroyed Gibbed)
. dodeathsound GibsDeath
@@ -172,59 +168,10 @@ poisonSPic = _1 %~ overColSH (mixColors 0.5 0.5 green . normalizeColor)
dropAll :: Creature -> World -> World
dropAll cr w = foldl' (flip (dropItem cr)) w . reverse . IM.keys . _unNIntMap $ _crInv cr
chasmTestLiving :: Creature -> World -> World
chasmTestLiving cr w
| Flying {} <- cr ^. crStance . carriage = w
| Falling {} <- cr ^. crStance . carriage = w
| Just (x, y) <- List.find g (w ^. cWorld . cliffs) =
w
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
& tocr . crPos . _xy -~ normalizeV (vNormal (x - y))
& chasmRotate cr (x - y)
| any f (w ^. cWorld . chasms) = w & tocr %~ startFalling
| otherwise = w
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
g = uncurry $ crOnSeg cr
f = pointInPoly (cr ^. crPos . _xy)
startFalling :: Creature -> Creature
startFalling cr = case cr ^. crStance . carriage of
Walking -> cr & crStance . carriage .~ Falling
_ -> cr & crStance . carriage .~ Falling
chasmTestCorpse :: Creature -> World -> World
chasmTestCorpse cr w
| (xy:xys) <- filter g (w ^. cWorld . cliffs) =
w
& soundContinue (CrChasm (_crID cr)) (cr ^. crPos . _xy) debrisS (Just 100)
& tocr . crPos . _xy +~ h xy xys
| any f (w ^. cWorld . chasms) = w & tocr %~ startFalling
| otherwise = w
where
h :: (Point2,Point2) -> [(Point2,Point2)] -> Point2
h (x,y) [] = normalizeV (vNormal (x-y))
h x (y:_) = unitVectorAtAngle $ tweenAngles (d1/(d1+d2)) (h' x) (h' y)
where
h' :: (Point2,Point2) -> Float
h' = argV . vNormal . uncurry (-)
d a = uncurry closestPointOnLine a (cr ^. crPos . _xy)
d1 :: Float
d1 = norm (cxy - d x)
d2 :: Float
d2 = norm (cxy - d y)
cxy = cr ^. crPos . _xy
tocr = cWorld . lWorld . creatures . ix (_crID cr)
g = uncurry $ circOnSeg cxy (crRad $ cr ^. crType)
f = pointInPoly cxy
chasmRotate :: Creature -> Point2 -> World -> World
chasmRotate cr v w
| t = rotateTo8 (argV v) w
| otherwise = w
where
t = cr ^. crID == 0 && null (w ^? input . mouseButtons . ix SDL.ButtonRight)
--startFalling :: Creature -> Creature
--startFalling cr = case cr ^. crStance . carriage of
-- Walking -> cr & crStance . carriage .~ Falling
-- _ -> cr & crStance . carriage .~ Falling
updatePulse :: Pulse -> Pulse
updatePulse p