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

Work on Falling carriage type

Browse Source
This commit is contained in:
justin
2026-04-03 11:03:05 +01:00
parent 43a5817ef3
commit d65a4529be
6 changed files with 54 additions and 33 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/ChaseCrit.hs
+1 -1
View File
@@ -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
src/Dodge/Creature/State/WalkCycle.hs
+8 -2
View File
@@ -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
src/Dodge/Creature/Update.hs
+7
View File
@@ -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
src/Dodge/Room/Room.hs
+1
View File
@@ -14,6 +14,7 @@ module Dodge.Room.Room (
distributerRoom,
critDeadEnd,
deadEndPSType,
deadEndRoom,
) where
import qualified Data.IntMap.Strict as IM
src/Dodge/Room/Tutorial.hs
+31 -29
View File
@@ -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
]
src/Dodge/TestString.hs
+6 -1
View File
@@ -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