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 = hoverCrit =
defaultCreature defaultCreature
& crName .~ "hoverCrit" & crName .~ "hoverCrit"
& crHP .~ HP 1000 & crHP .~ HP 500
& crType .~ HoverCrit 0 & crType .~ HoverCrit 0
& crFaction .~ ColorFaction blue & crFaction .~ ColorFaction blue
& crStance . carriage .~ Flying 15 0.975 & 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 module Dodge.Creature.State.WalkCycle (updateCarriage) where
import Geometry.Polygon
import Data.Maybe import Data.Maybe
import Dodge.Creature.HandPos import Dodge.Creature.HandPos
import Linear import Linear
@@ -32,8 +33,13 @@ updateCarriage' cid cr w = \case
& cWorld . lWorld . creatures . ix cid . crStance . carriage . zSpeed & 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 %~ if cr ^. crPos . _z < 17 then min 0.05 . (+0.001) else max (-0.05) . subtract 0.001
Boosting {} -> w Boosting {} -> w
Falling _ _ -> w & cWorld . lWorld . creatures . ix cid . crPos +~ Falling _ _ ->
0.99 *^ (cr ^. crOldPos - oop & _z -~ 0.5) 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 OnGround {} -> w
where where
oop = cr ^. crOldOldPos oop = cr ^. crOldOldPos
src/Dodge/Creature/Update.hs
+7
View File
@@ -1,3 +1,4 @@
{-# LANGUAGE LambdaCase #-}
module Dodge.Creature.Update (updateCreature) where module Dodge.Creature.Update (updateCreature) where
import Color import Color
@@ -93,10 +94,16 @@ checkDeath' cr w = case cr ^. crHP of
& dropAll cr -- the order of these is possibly important & dropAll cr -- the order of these is possibly important
& stopSoundFrom (CrWeaponSound (_crID cr) 0) & stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr & corpseOrGib cr
& tocr . crStance . carriage %~ toDeathCarriage
_ -> w _ -> w
where where
tocr = cWorld . lWorld . creatures . ix (_crID cr) 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 -- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World corpseOrGib :: Creature -> World -> World
corpseOrGib cr = case cr ^? crDamage . to maxDamageType . _Just . _1 of 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, distributerRoom,
critDeadEnd, critDeadEnd,
deadEndPSType, deadEndPSType,
deadEndRoom,
) where ) where
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
src/Dodge/Room/Tutorial.hs
+31 -29
View File
@@ -58,34 +58,34 @@ tutAnoTree = do
, corDoor , corDoor
, chasmSpitTerminal , chasmSpitTerminal
-- , loadAmmoTut -- , loadAmmoTut
, corDoor --b , corDoor
, tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns --b , tToBTree "slowCrush" . return . cleatOnward <$> pushCaverns
, corDoor --b , corDoor
, chasmSpitTerminal --b , chasmSpitTerminal
-- a , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a , corDoor --b -- a , corDoor
-- a , tToBTree "sdr" . return . cleatOnward --b -- a , tToBTree "sdr" . return . cleatOnward
-- a <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000) --b -- a <$> (shuffleLinks =<< distributerRoom BulletAmmo 100000)
-- a , -- , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a , -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a -- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom --b -- a -- --, tToBTree "sdr" . return . cleatOnward <$> slowDoorRoom
-- a ---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] [] --b -- a ---- , tToBTree "sr" . return . cleatOnward <$> tanksRoom [] []
-- a -- , return $ tToBTree "door" $ return $ cleatOnward door --b -- a -- , return $ tToBTree "door" $ return $ cleatOnward door
-- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a -- , tToBTree "sdr" . return . cleatOnward <$> --b -- a -- , tToBTree "sdr" . return . cleatOnward <$>
-- a -- (shuffleLinks =<< tanksPipesRoom) --b -- a -- (shuffleLinks =<< tanksPipesRoom)
-- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a -- , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a return $ tToBTree "door" $ return $ cleatOnward door --b -- a return $ tToBTree "door" $ return $ cleatOnward door
-- a , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a , tutHub --b -- a , tutHub
-- a , chasmSpitTerminal --b -- a , chasmSpitTerminal
-- a , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a , tutLight --b -- a , tutLight
-- a , tutDrop --b -- a , tutDrop
-- a , return $ tToBTree "cor" $ return $ cleatOnward corridor --b -- a , return $ tToBTree "cor" $ return $ cleatOnward corridor
-- a ---- , AnTree $ pickupTut --b -- a ---- , AnTree $ pickupTut
-- a ---- , AnTree $ weaponTut --b -- a ---- , AnTree $ weaponTut
] ]
foldMTRS :: foldMTRS ::
@@ -339,7 +339,9 @@ chasmSpitTerminal = do
tToBTree "chasmTerm" $ tToBTree "chasmTerm" $
Node Node
(addDoorToggleTerminal' i1 (PS 150 0) y') (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)] , treePost [triggerDoorRoom i1, deadEndPSType (PutCrit hoverCrit)]
, return $ cleatOnward $ triggerDoorRoom i1 , return $ cleatOnward $ triggerDoorRoom i1
] ]
src/Dodge/TestString.hs
+6 -1
View File
@@ -35,7 +35,12 @@ import Data.Monoid
import RandomHelp import RandomHelp
testStringInit :: Universe -> [String] 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] -- u = [show p, show op, show oop, show (op - oop), show . norm $ op - oop, show d]
-- where -- where
-- f = fromMaybe 0 -- f = fromMaybe 0