From d65a4529bec24c1f4f9cc80bc51db6614a4de6a7 Mon Sep 17 00:00:00 2001 From: justin Date: Fri, 3 Apr 2026 11:03:05 +0100 Subject: [PATCH] Work on Falling carriage type --- src/Dodge/Creature/ChaseCrit.hs | 2 +- src/Dodge/Creature/State/WalkCycle.hs | 10 ++++- src/Dodge/Creature/Update.hs | 7 ++++ src/Dodge/Room/Room.hs | 1 + src/Dodge/Room/Tutorial.hs | 60 ++++++++++++++------------- src/Dodge/TestString.hs | 7 +++- 6 files changed, 54 insertions(+), 33 deletions(-) diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index 3bb5706e0..c7b625dd6 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -36,7 +36,7 @@ hoverCrit :: Creature hoverCrit = defaultCreature & crName .~ "hoverCrit" - & crHP .~ HP 1000 + & crHP .~ HP 500 & crType .~ HoverCrit 0 & crFaction .~ ColorFaction blue & crStance . carriage .~ Flying 15 0.975 diff --git a/src/Dodge/Creature/State/WalkCycle.hs b/src/Dodge/Creature/State/WalkCycle.hs index 58ba6b6ec..b1ac7aa76 100644 --- a/src/Dodge/Creature/State/WalkCycle.hs +++ b/src/Dodge/Creature/State/WalkCycle.hs @@ -2,6 +2,7 @@ module Dodge.Creature.State.WalkCycle (updateCarriage) where +import Geometry.Polygon import Data.Maybe import Dodge.Creature.HandPos import Linear @@ -32,8 +33,13 @@ updateCarriage' cid cr w = \case & cWorld . lWorld . creatures . ix cid . crStance . carriage . zSpeed %~ if cr ^. crPos . _z < 17 then min 0.05 . (+0.001) else max (-0.05) . subtract 0.001 Boosting {} -> w - Falling _ _ -> w & cWorld . lWorld . creatures . ix cid . crPos +~ - 0.99 *^ (cr ^. crOldPos - oop & _z -~ 0.5) + Falling _ _ -> + let v = 0.9 *^ (cr ^. crOldPos - oop & _z -~ 0.5) + ep = cr ^. crPos + v + in if ep ^. _z < 0 && not (any (pointInPoly (ep ^. _xy)) (w ^. cWorld . chasms)) + then w & cWorld . lWorld . creatures . ix cid . crPos .~ (ep & _z .~ 0) + & cWorld . lWorld . creatures . ix cid . crStance . carriage .~ OnGround + else w & cWorld . lWorld . creatures . ix cid . crPos .~ ep OnGround {} -> w where oop = cr ^. crOldOldPos diff --git a/src/Dodge/Creature/Update.hs b/src/Dodge/Creature/Update.hs index bc129c84f..194a46f6b 100644 --- a/src/Dodge/Creature/Update.hs +++ b/src/Dodge/Creature/Update.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE LambdaCase #-} module Dodge.Creature.Update (updateCreature) where import Color @@ -93,10 +94,16 @@ checkDeath' cr w = case cr ^. crHP of & dropAll cr -- the order of these is possibly important & stopSoundFrom (CrWeaponSound (_crID cr) 0) & corpseOrGib cr + & tocr . crStance . carriage %~ toDeathCarriage _ -> w where tocr = cWorld . lWorld . creatures . ix (_crID cr) +toDeathCarriage :: Carriage -> Carriage +toDeathCarriage = \case + Flying {} -> Falling 0 RightForward + x -> x + -- could look at the amount of damage here (given by maxDamage) too corpseOrGib :: Creature -> World -> World corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of diff --git a/src/Dodge/Room/Room.hs b/src/Dodge/Room/Room.hs index 5a3ae6889..bcc24fcb5 100644 --- a/src/Dodge/Room/Room.hs +++ b/src/Dodge/Room/Room.hs @@ -14,6 +14,7 @@ module Dodge.Room.Room ( distributerRoom, critDeadEnd, deadEndPSType, + deadEndRoom, ) where import qualified Data.IntMap.Strict as IM diff --git a/src/Dodge/Room/Tutorial.hs b/src/Dodge/Room/Tutorial.hs index b08997b60..0b2feb86c 100644 --- a/src/Dodge/Room/Tutorial.hs +++ b/src/Dodge/Room/Tutorial.hs @@ -58,34 +58,34 @@ tutAnoTree = do , corDoor , chasmSpitTerminal -- , loadAmmoTut - , corDoor - , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns - , corDoor - , chasmSpitTerminal - -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a , corDoor - -- a , tToBTree "sdr" . return . cleatOnward - -- a <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000) - -- a , -- , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a -- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom - -- a ---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] [] - -- a -- , return $ tToBTree "door" $ return $ cleatOnward door - -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a -- , tToBTree "sdr" . return . cleatOnward <$> - -- a -- (shuffleLinks =<< tanksPipesRoom) - -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a return $ tToBTree "door" $ return $ cleatOnward door - -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a , tutHub - -- a , chasmSpitTerminal - -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a , tutLight - -- a , tutDrop - -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor - -- a ---- , AnTree $ pickupTut - -- a ---- , AnTree $ weaponTut +--b , corDoor +--b , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns +--b , corDoor +--b , chasmSpitTerminal +--b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a , corDoor +--b -- a , tToBTree "sdr" . return . cleatOnward +--b -- a <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000) +--b -- a , -- , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a -- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom +--b -- a ---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] [] +--b -- a -- , return $ tToBTree "door" $ return $ cleatOnward door +--b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a -- , tToBTree "sdr" . return . cleatOnward <$> +--b -- a -- (shuffleLinks =<< tanksPipesRoom) +--b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a return $ tToBTree "door" $ return $ cleatOnward door +--b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a , tutHub +--b -- a , chasmSpitTerminal +--b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a , tutLight +--b -- a , tutDrop +--b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor +--b -- a ---- , AnTree $ pickupTut +--b -- a ---- , AnTree $ weaponTut ] foldMTRS :: @@ -339,7 +339,9 @@ chasmSpitTerminal = do tToBTree "chasmTerm" $ Node (addDoorToggleTerminal' i1 (PS 150 0) y') - [ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)] + --[ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit chaseCrit)] + [ treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)] + --[ treePost [triggerDoorRoom i1, deadEndRoom] , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)] , return $ cleatOnward $ triggerDoorRoom i1 ] diff --git a/src/Dodge/TestString.hs b/src/Dodge/TestString.hs index 93cbbf449..97303477c 100644 --- a/src/Dodge/TestString.hs +++ b/src/Dodge/TestString.hs @@ -35,7 +35,12 @@ import Data.Monoid import RandomHelp testStringInit :: Universe -> [String] -testStringInit u = u ^.. uvWorld . cWorld . lWorld . creatures . each . crPos . _z . to show +testStringInit u = u ^.. uvWorld . cWorld . lWorld . creatures . ix 2 . crPos . _z . to show + <> [show v] + where + v = x - y + x = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 2 . crOldPos + y = fromMaybe 0 $ u ^? uvWorld . cWorld . lWorld . creatures . ix 2 . crOldOldPos -- u = [show p, show op, show oop, show (op - oop), show . norm $ op - oop, show d] -- where -- f = fromMaybe 0