diff --git a/src/Dodge/Creature.hs b/src/Dodge/Creature.hs index 0efa202b7..1256fc1af 100644 --- a/src/Dodge/Creature.hs +++ b/src/Dodge/Creature.hs @@ -158,8 +158,7 @@ startCr = defaultCreature , _crHP = 1000 , _crMaxHP = 1500 , _crInv = startInventory - , _crCorpse = setDepth 5 - $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10] + , _crCorpse = basicCrCorpse , _crFaction = PlayerFaction , _crMvType = MvWalking yourDefaultSpeed } diff --git a/src/Dodge/Creature/ChaseCrit.hs b/src/Dodge/Creature/ChaseCrit.hs index e3b4eab4c..b48c7b81d 100644 --- a/src/Dodge/Creature/ChaseCrit.hs +++ b/src/Dodge/Creature/ChaseCrit.hs @@ -28,7 +28,7 @@ smallChaseCrit = chaseCrit , _crRad = 4 , _crPict = basicCrPict , _crInv = IM.fromList [(0,medkit 200)] - , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 4 + , _crCorpse = basicCrCorpse } invisibleChaseCrit :: Creature invisibleChaseCrit = chaseCrit diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 7ef44b712..4b0d70df8 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -9,6 +9,7 @@ module Dodge.Creature.Picture , picAtCrPos , shapeAtCrPos , picAtCrPosNoRot + , basicCrCorpse ) where import Dodge.Data --import Dodge.Base @@ -264,3 +265,18 @@ picAtCrPos thePic cr _ _ = (,) emptySH $ tranRot (_crPos cr) (_crDir cr) thePic picAtCrPosNoRot :: Picture -> Creature -> Configuration -> World -> SPic --{-# INLINE picAtCrPos #-} picAtCrPosNoRot thePic cr _ _ = (,) emptySH $ uncurryV translate (_crPos cr) thePic + +basicCrCorpse :: Creature -> SPic +basicCrCorpse cr = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat + [ --rotdir . _spShape $ drawEquipment cr + rotdir . dm . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr + , rotdir . dm $ colorSH (_skinUpper cskin) $ upperBody cr + , dm . rotmdir $ colorSH (_skinLower cskin) $ feet cr + ] + where + cskin = _crSkin cr + crsize = 0.1 * _crRad cr + dm = damageModSH cr + tr = uncurryV translateSHf (_crPos cr) + rotdir = rotateSH (_crDir cr) + rotmdir = rotateSH (_crMvDir cr) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index e8773c494..1821014e9 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -18,7 +18,7 @@ import Dodge.WorldEvent import Dodge.Creature.Action --import Dodge.Hammer import Geometry -import Picture +--import Picture import qualified IntMapHelp as IM --import StrictHelp @@ -71,7 +71,7 @@ checkDeath cr w -- & creatures . at (_crID cr) .~ Nothing & removecr & stopSoundFrom (CrWeaponSound (_crID cr) 0) - & over decorations addCorpse + & plNew corpses cpID thecorpse & dropByState cr where removecr @@ -79,10 +79,13 @@ checkDeath cr w . (creatures . ix (_crID cr) . crPict .~ const mempty) . addCrGibs cr | otherwise = creatures . at (_crID cr) .~ Nothing - addCorpse = IM.insertNewKey - $ uncurryV translate (_crOldPos cr) - $ rotate (_crDir cr) - (_crCorpse cr) + thecorpse = Corpse + { _cpID = 0 + , _cpPos = _crPos cr + , _cpDir = _crDir cr + , _cpPict = _crCorpse cr cr + , _cpRes = Nothing + } internalUpdate :: Creature -> World -> World internalUpdate cr = creatures . ix (_crID cr) %~ diff --git a/src/Dodge/Creature/SwarmCrit.hs b/src/Dodge/Creature/SwarmCrit.hs index f1b89e2fa..307608bd1 100644 --- a/src/Dodge/Creature/SwarmCrit.hs +++ b/src/Dodge/Creature/SwarmCrit.hs @@ -31,7 +31,7 @@ swarmCrit = defaultCreature , _crRad = 2 , _crMass = 2 , _crPict = basicCrPict - , _crCorpse = setDepth 5 $ color (greyN 0.5) $ circleSolid 2 + , _crCorpse = basicCrCorpse , _crFaction = ColorFaction yellow , _crMeleeCooldown = 0 } diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 524f1f996..ebd568842 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -118,7 +118,7 @@ data World = World , _playingSounds :: M.Map SoundOrigin Sound , _decorations :: IM.IntMap Picture , _foregroundShape :: Shape - , _corpses :: Zone [Corpse] + , _corpses :: IM.IntMap Corpse , _clickMousePos :: Point2 , _pathGraph :: ~(Gr Point2 Float) , _pathGraphP :: ~[(Point2,Point2)] @@ -274,9 +274,11 @@ data CrGroupParams = CrGroupParams , _crGroupUpdate :: World -> CrGroupParams -> Maybe CrGroupParams } data Corpse = Corpse - { _cpPos :: Point2 - , _cpPict :: Picture - , _cpRes :: Creature + { _cpID :: Int + , _cpPos :: Point2 + , _cpDir :: Float + , _cpPict :: SPic + , _cpRes :: Maybe Creature } data Gust = Gust { _guID :: Int @@ -337,7 +339,7 @@ data Creature = Creature , _crEquipment :: M.Map EquipPosition Int , _crLeftInvSel :: Maybe Int , _crState :: CreatureState - , _crCorpse :: Picture + , _crCorpse :: Creature -> SPic , _crApplyDamage :: [Damage] -> Creature -> World -> World , _crPastDamage :: Int , _crStance :: Stance @@ -1596,6 +1598,7 @@ makeLenses ''EquipParams makeLenses ''TerminalCommand makeLenses ''GenParams makeLenses ''CreatureSkin +makeLenses ''Corpse ----- ROOM LENSES makeLenses ''Room diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index ce9be3fcf..0866afaec 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -10,6 +10,7 @@ import Dodge.Data import Dodge.SoundLogic import Dodge.Wall.Delete import Dodge.Creature.Damage +import Dodge.Creature.Picture import Geometry import Picture import ShapePicture @@ -30,7 +31,7 @@ defaultCreature = Creature , _crMvDir = 0 , _crTwist = 0 , _crID = 1 - , _crPict = \_ _ _ -> mempty + , _crPict = basicCrPict , _crSkin = defaultCreatureSkin , _crUpdate = const id , _crRad = 10 @@ -44,7 +45,7 @@ defaultCreature = Creature , _crInvEquipped = mempty , _crLeftInvSel = Nothing , _crState = defaultState - , _crCorpse = setLayer BottomLayer $ setDepth 5 $ color (greyN 0.5) $ circleSolid 10 + , _crCorpse = basicCrCorpse , _crApplyDamage = defaultApplyDamage , _crPastDamage = 0 , _crEquipment = M.empty diff --git a/src/Dodge/Default/World.hs b/src/Dodge/Default/World.hs index 41ec85f4e..961a5a3fe 100644 --- a/src/Dodge/Default/World.hs +++ b/src/Dodge/Default/World.hs @@ -61,7 +61,7 @@ defaultWorld = World , _buttons = IM.empty , _toPlaySounds = M.empty , _playingSounds = M.empty - , _corpses = Zone IM.empty + , _corpses = IM.empty , _decorations = IM.empty --, _savedWorlds = M.empty -- , _menuLayers = []