Move towards adding corpses

src/Dodge/Creature.hs

@@ -158,8 +158,7 @@ startCr = defaultCreature
     , _crHP = 1000
     , _crMaxHP = 1500
     , _crInv = startInventory 
-    , _crCorpse = setDepth 5
+    , _crCorpse = basicCrCorpse
-        $ color (greyN 0.5) $ pictures [color (greyN 0.8) $ circleSolid 10, circLine 10]
     , _crFaction = PlayerFaction
     , _crMvType = MvWalking yourDefaultSpeed
     }

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

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)

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 
+    thecorpse = Corpse
-        $ uncurryV translate (_crOldPos cr) 
+        { _cpID = 0
-        $ rotate (_crDir cr)
+        , _cpPos = _crPos cr
-        (_crCorpse cr)
+        , _cpDir = _crDir cr
+        , _cpPict = _crCorpse cr cr
+        , _cpRes = Nothing
+        }
 
 internalUpdate :: Creature -> World -> World
 internalUpdate cr = creatures . ix (_crID cr) %~ 

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
     }

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
+    { _cpID  :: Int
-    , _cpPict :: Picture
+    , _cpPos :: Point2
-    , _cpRes :: Creature
+    , _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

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

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 = []