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

Remove external corpses, handle them as creatures

Browse Source
This commit is contained in:
justin
2025-09-25 09:31:58 +01:00
parent fcb02850d0
commit 23f61081cf
33 changed files with 184 additions and 159 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Barreloid.hs
+12 -10
View File
@@ -18,19 +18,20 @@ updateBarreloid = \case
PlainBarrel -> updateBarrel
updateExpBarrel :: [Point2] -> Creature -> World -> World
updateExpBarrel ps cr w
| cr ^. crHP > 0 =
updateExpBarrel ps cr w = case cr ^. crHP of
HP x | x > 0 ->
w
& hiss
& cWorld . lWorld . creatures . ix (_crID cr) %~ damsToExpBarrel damages
& cWorld . lWorld . creatures . ix (_crID cr) . crHP
& cWorld . lWorld . creatures . ix (_crID cr) . crHP . _HP
-~ length (_piercedPoints . _barrelType $ _crType cr)
& cWorld . lWorld . creatures . ix (_crID cr) . crDamage .~ mempty
& flip (foldl' f) ps
| otherwise =
HP _ ->
w
& makeExplosionAt ((cr ^. crPos) `v2z` 20) 0
& cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
& cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
_ -> w
where
f w' p = makeSpark NormalSpark (p + normalizeV p + cr ^. crPos) (argV p) w'
damages = cr ^. crDamage
@@ -39,9 +40,10 @@ updateExpBarrel ps cr w
| otherwise = soundContinue (BarrelHiss (_crID cr)) (_crPos cr) foamSprayLoopS (Just 1)
updateBarrel :: Creature -> World -> World
updateBarrel cr
| _crHP cr > 0 = doDamage (cr ^. crID)
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
updateBarrel cr = case cr ^. crHP of
HP x | x > 0 -> doDamage (cr ^. crID)
HP _ -> cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ CrIsGibs
_ -> id
damsToExpBarrel :: [Damage] -> Creature -> Creature
damsToExpBarrel = flip $ foldl' damToExpBarrel
@@ -49,8 +51,8 @@ damsToExpBarrel = flip $ foldl' damToExpBarrel
damToExpBarrel :: Creature -> Damage -> Creature
damToExpBarrel cr dm = case dm of
Piercing x p _ ->
cr & crHP -~ div x 200
cr & crHP . _HP -~ div x 200
& crType . barrelType . piercedPoints .:~ (p - _crPos cr)
Poison{} -> cr
Sparking{} -> cr
_ -> cr & crHP -~ fromMaybe 0 (dm ^? dmAmount)
_ -> cr & crHP . _HP -~ fromMaybe 0 (dm ^? dmAmount)
src/Dodge/Corpse/Draw.hs
+2 -2
View File
@@ -3,5 +3,5 @@ import Dodge.Data.Corpse
import ShapePicture
-- not currently used, too simple
drawCorpse :: Corpse -> SPic
drawCorpse = _cpSPic
--drawCorpse :: Corpse -> SPic
--drawCorpse = _cpSPic
src/Dodge/Corpse/Make.hs
+18 -16
View File
@@ -4,19 +4,21 @@ import Dodge.Creature.Radius
import Dodge.Creature.Shape
import Control.Lens
import Dodge.Creature.Picture
import Dodge.Data.Corpse
--import Dodge.Data.Corpse
import Dodge.Data.Creature
import Geometry
import Shape
import ShapePicture
makeCorpse :: Creature -> Corpse
--makeCorpse :: Creature -> Corpse
makeCorpse :: Creature -> SPic
makeCorpse cr =
defaultCorpse
& cpPos .~ _crPos cr
& cpDir .~ _crDir cr
& cpSPic
.~ noPic
-- defaultCorpse
-- & cpPos .~ _crPos cr
-- & cpDir .~ _crDir cr
-- & cpSPic
-- .~
noPic
( scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
@@ -29,12 +31,12 @@ makeCorpse cr =
crsize = 0.1 * crRad (cr ^. crType)
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
defaultCorpse :: Corpse
defaultCorpse =
Corpse
{ _cpID = 0
, _cpPos = 0
, _cpDir = 0
, _cpSPic = mempty
, _cpRes = NoResurrection
}
--defaultCorpse :: Corpse
--defaultCorpse =
-- Corpse
-- { _cpID = 0
-- , _cpPos = 0
-- , _cpDir = 0
-- , _cpSPic = mempty
-- , _cpRes = NoResurrection
-- }
src/Dodge/Creature.hs
+2 -2
View File
@@ -56,7 +56,7 @@ import Picture
spawnerCrit :: Creature
spawnerCrit =
defaultCreature
& crHP .~ 300
& crHP .~ HP 300
-- & crInv .~ IM.empty
-- & crType . skinUpper .~ lightx4 blue
@@ -97,7 +97,7 @@ startCr =
& crDir .~ pi / 2
& crMvDir .~ pi / 2
& crID .~ 0
& crHP .~ 10000
& crHP .~ HP 10000
& crInv .~ mempty
& crFaction .~ PlayerFaction
-- & crMvType .~ MvWalking yourDefaultSpeed
src/Dodge/Creature/ArmourChase.hs
+1 -1
View File
@@ -15,7 +15,7 @@ flockArmourChaseCrit :: Creature
flockArmourChaseCrit =
defaultCreature
{ _crName = "armourChaseCrit"
, _crHP = 300
, _crHP = HP 300
, _crInv = mempty
-- IM.fromList
-- [ --(0, frontArmour)
src/Dodge/Creature/AutoCrit.hs
+1 -1
View File
@@ -13,7 +13,7 @@ autoCrit :: Creature
autoCrit =
defaultCreature
{ --_crInv = IM.fromList [(0, autoRifle)]
_crHP = 300
_crHP = HP 300
-- , _crMvType = defaultAimMvType
}
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/ChaseCrit.hs
+2 -2
View File
@@ -14,7 +14,7 @@ import Picture
smallChaseCrit :: Creature
smallChaseCrit =
chaseCrit
{ _crHP = 1
{ _crHP = HP 1
, _crInv = mempty
}
@@ -28,7 +28,7 @@ chaseCrit :: Creature
chaseCrit =
defaultCreature
{ _crName = "chaseCrit"
, _crHP = 150
, _crHP = HP 150
, _crInv = mempty
, _crFaction = ColorFaction green
, _crVocalization = chaseCritVocalization
src/Dodge/Creature/Damage.hs
+1 -1
View File
@@ -33,5 +33,5 @@ applyPiercingDamage cr dm w
damageHP :: Creature -> Int -> World -> World
damageHP cr x =
(cWorld . lWorld . creatures . ix (_crID cr) . crHP -~ x)
(cWorld . lWorld . creatures . ix (_crID cr) . crHP . _HP -~ x)
. (cWorld . lWorld . creatures . ix (_crID cr) . crPain +~ x)
src/Dodge/Creature/Inanimate.hs
+2 -2
View File
@@ -17,7 +17,7 @@ import Dodge.Default
barrel :: Creature
barrel =
defaultInanimate
{ _crHP = 500
{ _crHP = HP 500
, _crType = BarrelCrit PlainBarrel
-- , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
@@ -25,7 +25,7 @@ barrel =
explosiveBarrel :: Creature
explosiveBarrel =
defaultInanimate
{ _crHP = 400
{ _crHP = HP 400
, _crType = BarrelCrit (ExplosiveBarrel [])
-- , _crInv = IM.empty -- IM.fromList [(0,frontArmour)]
}
src/Dodge/Creature/Lamp.hs
+1 -1
View File
@@ -13,7 +13,7 @@ colorLamp ::
Creature
colorLamp col h =
defaultInanimate
{ _crHP = 100
{ _crHP = HP 100
, _crType = LampCrit h col Nothing
-- , _crRad = 3
}
src/Dodge/Creature/LauncherCrit.hs
+1 -1
View File
@@ -13,7 +13,7 @@ launcherCrit :: Creature
launcherCrit =
defaultCreature
{ -- _crInv = IM.fromList [(0, rLauncher)]
_crHP = 300
_crHP = HP 300
}
-- & crType . skinUpper .~ lightx4 red
-- & crType . humanoidAI .~ LauncherAI
src/Dodge/Creature/LtAutoCrit.hs
+1 -1
View File
@@ -13,7 +13,7 @@ ltAutoCrit :: Creature
ltAutoCrit =
defaultCreature
{ --_crInv = IM.fromList [(0, autoPistol)]
_crHP = 500
_crHP = HP 500
}
-- & crType .~ LtAutoCrit
-- & crType . humanoidAI .~ LtAutoAI
src/Dodge/Creature/SpreadGunCrit.hs
+1 -1
View File
@@ -12,7 +12,7 @@ spreadGunCrit :: Creature
spreadGunCrit =
defaultCreature
{ --_crInv = IM.fromList [(0, bangStick 6)]
_crHP = 500
_crHP = HP 500
}
-- & crType . humanoidAI .~ SpreadGunAI
-- & crType . skinUpper .~ lightx4 red
src/Dodge/Creature/SwarmCrit.hs
+1 -1
View File
@@ -10,7 +10,7 @@ import Picture
swarmCrit :: Creature
swarmCrit =
defaultCreature
{ _crHP = 1
{ _crHP = HP 1
-- , _crRad = 2
, _crFaction = ColorFaction yellow
}
src/Dodge/Creature/Update.hs
+39 -26
View File
@@ -5,7 +5,7 @@ import Color
import qualified Data.IntMap.Strict as IM
import qualified Data.List as List
import Dodge.Barreloid
import Dodge.Base.NewID
--import Dodge.Base.NewID
import Dodge.Corpse.Make
import Dodge.Creature.Action
import Dodge.Creature.Radius
@@ -30,7 +30,8 @@ import ShapePicture.Data
-- allow for knockbacks etc to be determined as well as intended movements
updateCreature :: Creature -> World -> World
updateCreature cr
| _crZ cr < negate 100 = (tocr . crHP .~ negate 1) . destroyAllInvItems cr
| null (cr ^? crHP . _HP) = id
| _crZ cr < negate 100 = (tocr . crHP .~ CrIsPitted) . destroyAllInvItems cr
| _crZ cr < 0 = (tocr . crZVel -~ 0.5) . (tocr . crZ +~ _crZVel cr)
| otherwise = updateCreature' cr
where
@@ -69,44 +70,56 @@ checkDeath :: Int -> World -> World
checkDeath cid w = maybe id checkDeath' (w ^? cWorld . lWorld . creatures . ix cid) w
checkDeath' :: Creature -> World -> World
checkDeath' cr w
| _crHP cr > 0 = w & tocr . crDamage .~ []
| _crHP cr <= -200 = w
& dropAll cr -- the order of
& destroyCreature cr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& addCrGibs cr
| _crHP cr > -200 && _crDeathTimer cr < 5 = w
checkDeath' cr w = case cr ^. crHP of
HP x | x > 0 -> w & tocr . crDamage .~ []
HP x | x > -200 && _crDeathTimer cr < 5 -> w
& tocr . crDamage .~ []
& tocr . crDeathTimer +~ 1
| otherwise = w
HP x | x > -200 -> w
& dropAll cr -- the order of
& removecr -- these is important
-- & removecr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& corpseOrGib cr
HP _ -> w
& dropAll cr -- the order of
& tocr . crHP .~ CrIsGibs
-- & destroyCreature cr -- these is important
& stopSoundFrom (CrWeaponSound (_crID cr) 0)
& addCrGibs cr
_ -> w
-- | otherwise = w
-- & dropAll cr -- the order of
-- & removecr -- these is important
-- & stopSoundFrom (CrWeaponSound (_crID cr) 0)
-- & corpseOrGib cr
where
tocr = cWorld . lWorld . creatures . ix (_crID cr)
removecr
| _crID cr == 0 = id
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-- removecr
-- | _crID cr == 0 = id
-- -- hack to get around player creature being killed but left with more than 0 hp
-- | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
destroyCreature :: Creature -> World -> World
destroyCreature cr
| _crID cr == 0 = id
-- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- hack to get around player creature being killed but left with more than 0 hp
| otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
--destroyCreature :: Creature -> World -> World
--destroyCreature cr
-- | _crID cr == 0 = id
-- -- cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ 0
-- -- hack to get around player creature being killed but left with more than 0 hp
-- | otherwise = cWorld . lWorld . creatures . at (_crID cr) .~ Nothing
-- could look at the amount of damage here (given by maxDamage) too
corpseOrGib :: Creature -> World -> World
corpseOrGib cr w = w & case cr ^? crDamage . to maxDamageType . _Just . _1 of
Just CookingDamage -> addcorpse (thecorpse & cpSPic %~ scorchSPic)
Just PoisonDamage -> addcorpse (thecorpse & cpSPic %~ poisonSPic)
Just CookingDamage -> -- addcorpse (thecorpse & cpSPic %~ scorchSPic)
sethp (CrIsCorpse $ scorchSPic thecorpse)
Just PoisonDamage -> --addcorpse (thecorpse & cpSPic %~ poisonSPic)
sethp (CrIsCorpse $ poisonSPic thecorpse)
Just PhysicalDamage | _crPain cr > 200 -> addCrGibs cr
_ -> addcorpse thecorpse
. sethp CrIsGibs
_ -> -- addcorpse thecorpse
sethp (CrIsCorpse thecorpse)
where
addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
sethp x = cWorld . lWorld . creatures . ix (_crID cr) . crHP .~ x
-- addcorpse ctype = plNew (cWorld . lWorld . corpses) cpID ctype
thecorpse = makeCorpse cr
scorchSPic :: SPic -> SPic
src/Dodge/Data/Corpse.hs
+14 -14
View File
@@ -11,18 +11,18 @@ import Data.Aeson.TH
import Geometry.Data
import ShapePicture.Data
data CorpseResurrection = NoResurrection
deriving (Eq, Ord, Show, Read) --Generic, Flat)
--data CorpseResurrection = NoResurrection
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
--
--data Corpse = Corpse
-- { _cpID :: Int
-- , _cpPos :: Point2
-- , _cpDir :: Float
-- , _cpSPic :: SPic
-- , _cpRes :: CorpseResurrection
-- }
-- deriving (Eq, Ord, Show, Read) --Generic, Flat)
data Corpse = Corpse
{ _cpID :: Int
, _cpPos :: Point2
, _cpDir :: Float
, _cpSPic :: SPic
, _cpRes :: CorpseResurrection
}
deriving (Eq, Ord, Show, Read) --Generic, Flat)
makeLenses ''Corpse
deriveJSON defaultOptions ''CorpseResurrection
deriveJSON defaultOptions ''Corpse
--makeLenses ''Corpse
--deriveJSON defaultOptions ''CorpseResurrection
--deriveJSON defaultOptions ''Corpse
src/Dodge/Data/Creature.hs
+4 -2
View File
@@ -17,6 +17,7 @@ module Dodge.Data.Creature (
module Dodge.Data.Item.Use.Consumption.LoadAction,
) where
import ShapePicture.Data
import NewInt
import Dodge.Data.Item.Use.Consumption.LoadAction
import Dodge.Data.Equipment.Misc
@@ -45,7 +46,7 @@ data Creature = Creature
, _crMvAim :: Float
, _crType :: CreatureType
, _crID :: Int
, _crHP :: Int
, _crHP :: CrHP
, _crInv :: NewIntMap InvInt Int
, _crManipulation :: Manipulation
, _crEquipment :: M.Map EquipSite (NewInt ItmInt)
@@ -68,8 +69,9 @@ data Creature = Creature
data CrHP
= HP Int
| CrIsCorpse
| CrIsCorpse SPic
| CrIsGibs
| CrIsPitted
data Intention = Intention
{ _targetCr :: Maybe Creature
src/Dodge/Data/LWorld.hs
+1 -1
View File
@@ -137,7 +137,7 @@ data LWorld = LWorld
, _pressPlates :: IM.IntMap PressPlate
, _buttons :: IM.IntMap Button
, _foregroundShapes :: IM.IntMap ForegroundShape
, _corpses :: IM.IntMap Corpse
-- , _corpses :: IM.IntMap Corpse
, _lightSources :: IM.IntMap LightSource
, _lights :: [LSParam]
, _seenLocations :: IM.IntMap (WdP2, String)
src/Dodge/Debug/Picture.hs
+1 -1
View File
@@ -417,7 +417,7 @@ drawCrInfo cfig w =
( _crPos cr
, catMaybes
-- [fmap show $ ap ^? crGoal
[ fpreShow "crHP" $ cr ^? crHP
[ fpreShow "crHP" $ cr ^? crHP . _HP
, fpreShow "crStrategy" $ ap ^? apStrategy
, fmap (("crPos....." ++) . shortShow) $ cr ^? crPos
, fpreShow "cpVigilance" $ cr ^? crPerception . cpVigilance
src/Dodge/Debug/Terminal.hs
+2 -1
View File
@@ -84,7 +84,8 @@ applySetTerminalString :: String -> Universe -> Universe
applySetTerminalString [] = id
applySetTerminalString var = case key' of
"" -> showTerminalError ("set " ++ var)
"hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP .~ round (fromJust val')
"hp" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crHP . _HP
.~ round (fromJust val')
-- "invcap" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crInvCapacity .~ round (fromJust val')
-- "mass" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMass .~ fromJust val'
-- "mvspeed" -> uvWorld . cWorld . lWorld . creatures . ix 0 . crMvType . mvSpeed .~ fromJust val'
src/Dodge/Default/Creature.hs
+1 -1
View File
@@ -23,7 +23,7 @@ defaultCreature =
, _crID = 1
, _crType = ChaseCrit {_meleeCooldown = 0}
-- , _crRad = 10
, _crHP = 100
, _crHP = HP 100
-- , _crMaxHP = 150
, _crInv = mempty
, _crManipulation = Manipulator SelNothing
src/Dodge/Default/World.hs
+1 -1
View File
@@ -135,7 +135,7 @@ defaultLWorld =
, _delayedEvents = []
, _pressPlates = IM.empty
, _buttons = IM.empty
, _corpses = IM.empty
-- , _corpses = IM.empty
, _lightSources = IM.empty
, _lights = mempty
, _seenLocations =
src/Dodge/Inventory/SelectionList.hs
+1 -1
View File
@@ -79,7 +79,7 @@ epText Nothing = " @NOT.EQP"
introScanValue :: Creature -> IntroScanType -> Either Int String
introScanValue cr = \case
HEALTH -> Left $ cr ^. crHP
HEALTH -> Left $ fromMaybe 0 $ cr ^? crHP . _HP
MAXHEALTH -> Left $ crMaxHP $ cr ^. crType
itemExternalValue :: Item -> World -> Creature -> Maybe (Either Int String)
src/Dodge/Lampoid.hs
+1 -1
View File
@@ -16,7 +16,7 @@ updateLampoid cr w = case cr ^?! crType . lampLSID of
in w & cWorld . lWorld . lightSources %~ IM.insert i (lsColPosID lcol (addZ h cpos) i)
& cWorld . lWorld . creatures . ix (_crID cr) . crType . lampLSID ?~ i
Just i
| _crHP cr < 0 ->
| cr ^?! crHP . _HP < 0 ->
w
-- & cWorld . lWorld . tempLightSources .:~ tlsTimeRadFunPos 20 150 (TLSFade 1 10) (addZ 20 cpos)
& cWorld . lWorld . worldEvents .:~ MakeTempLight
src/Dodge/Machine/Update.hs
+2 -2
View File
@@ -201,12 +201,12 @@ sensorReqToString = \case
mcProxTest :: World -> ProximityRequirement -> Bool
mcProxTest w = \case
RequireHealth x -> _crHP cr >= x
RequireHealth x -> fromMaybe 0 (cr ^? crHP . _HP) >= x
RequireEquipment ct ->
any
(\itm -> _itType itm == ct)
((\k -> w ^?! cWorld . lWorld . items . ix k) <$> _crInv cr)
RequireDeadCreatures is -> all (\x -> _crHP x < 0)
RequireDeadCreatures is -> all (\x -> null (x ^? crHP . _HP))
(IM.restrictKeys (w ^. cWorld . lWorld . creatures) (IS.fromList is))
where
cr = you w
src/Dodge/Render/ShapePicture.hs
+8 -6
View File
@@ -28,7 +28,7 @@ worldSPic cfig u =
<> foldup drawPulseBall (filtOn _pbPos _pulseBalls)
<> foldup (shiftDraw _blPos _blDir (drawBlock . _blDraw)) (filtOn _blPos _blocks)
<> foldup (shiftDraw _fsPos _fsDir (const _fsSPic)) (filtOn _fsPos _foregroundShapes)
<> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
-- <> foldup (shiftDraw' _cpPos _cpDir _cpSPic) (filtOn _cpPos _corpses)
<> foldup (drawCreature (u ^. uvWorld . cWorld . lWorld . items))
(filtOn _crPos _creatures)
<> foldup (Prelude.uncurry floorItemSPic) (IM.intersectionWith (,) (u^.uvWorld.cWorld.lWorld.items) (filtOn _flItPos _floorItems))
@@ -62,6 +62,8 @@ drawPulseBall pb =
drawCreature :: IM.IntMap Item -> Creature -> SPic
drawCreature m cr = translateSPz (_crZ cr) . uncurryV translateSPxy (_crPos cr) . rotateSP (_crDir cr) $
case cr ^. crType of
_ | CrIsCorpse sp <- cr ^. crHP -> sp
_ | null (cr ^? crHP . _HP) -> mempty
BarrelCrit{} -> barrelShape
LampCrit{_lampHeight = h} -> lampCrSPic h
_ -> basicCrPict m cr
@@ -82,11 +84,11 @@ shiftDraw fpos fdir fdraw x =
. rotateSP (fdir x)
$ fdraw x x
shiftDraw' :: (a -> Point2) -> (a -> Float) -> (a -> SPic) -> a -> SPic
shiftDraw' fpos fdir fdraw x =
uncurryV translateSPxy (fpos x)
. rotateSP (fdir x)
$ fdraw x
--shiftDraw' :: (a -> Point2) -> (a -> Float) -> (a -> SPic) -> a -> SPic
--shiftDraw' fpos fdir fdraw x =
-- uncurryV translateSPxy (fpos x)
-- . rotateSP (fdir x)
-- $ fdraw x
cullPoint :: Config -> World -> Point2 -> Bool
cullPoint cfig w p
src/Dodge/Update.hs
+1 -1
View File
@@ -759,7 +759,7 @@ checkEndGame uv = case w ^? timeFlow . respawnDelay of
& uvWorld . timeFlow .~ NormalTimeFlow
& uvWorld %~ respawn
Just _ -> uv & uvWorld . timeFlow . respawnDelay -~ 1
_ | _crHP (you w) < 1 -> uv & uvWorld . timeFlow .~ RespawnDelay 50
_ | null (you w ^? crHP . _HP) -> uv & uvWorld . timeFlow .~ RespawnDelay 50
_ -> uv
where
w = _uvWorld uv