From 63af928a1a92f2da2020a1efc9452f28f0ecaec9 Mon Sep 17 00:00:00 2001 From: justin Date: Sat, 4 Jun 2022 13:23:31 +0100 Subject: [PATCH] Add basic corpse shapes --- src/Dodge/Creature/Picture.hs | 56 +++++++++++++++++++++++--------- src/Dodge/Creature/State.hs | 2 +- src/Dodge/Data.hs | 4 +-- src/Dodge/Render/ShapePicture.hs | 1 + 4 files changed, 44 insertions(+), 19 deletions(-) diff --git a/src/Dodge/Creature/Picture.hs b/src/Dodge/Creature/Picture.hs index 4b0d70df8..db10f2112 100644 --- a/src/Dodge/Creature/Picture.hs +++ b/src/Dodge/Creature/Picture.hs @@ -25,6 +25,7 @@ import Picture import Geometry import Shape import ShapePicture +import qualified Quaternion as Q --import Geometry.Vector3D import Control.Lens @@ -64,14 +65,13 @@ basicCrShape cr | _crCamouflage cr == Invisible = mempty | otherwise = 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 + rotdir . colorSH (_skinHead cskin) . translateSHz 20 $ scalp cr + , rotdir $ colorSH (_skinUpper cskin) $ upperBody cr + , 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) @@ -141,8 +141,6 @@ crDisplayAwake = show . _crAwakeLevel . _crPerception -- piercingMod = case fmap argV piercingDam of -- Just a -> rotate (a + cdir) . scale 0.8 1.2 . rotate (negate $ cdir + a) -- _ -> id -damageModSH :: Creature -> Shape -> Shape -damageModSH _ = id feet :: Creature -> Shape {-# INLINE feet #-} @@ -166,6 +164,28 @@ feet cr = case cr ^? crStance . carriage of sLen = _strideLength $ _crStance cr f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen +deadFeet :: Creature -> Shape +{-# INLINE deadFeet #-} +deadFeet cr = case cr ^? crStance . carriage of + Just (Walking sa LeftForward) -> mconcat + [ translateSHf ( f sa) off aFoot + , translateSHf (-f sa) (-off) aFoot + ] + Just (Walking sa RightForward) -> mconcat + [ translateSHf (-f sa) off aFoot + , translateSHf ( f sa) (-off) aFoot + ] + _ -> mconcat + [ translateSHf 0 off aFoot + , translateSHf 0 (-off) aFoot + ] + where + aFoot :: Shape + aFoot = upperPrismPoly 3 $ polyCirc 3 4 + off = 5 + sLen = _strideLength $ _crStance cr + f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen + arms :: Creature -> Shape {-# INLINE arms #-} arms cr = fst $ translateToRightHand cr aHand @@ -189,6 +209,9 @@ arms cr = fst $ translateToRightHand cr aHand -- sLen = _strideLength $ _crStance cr -- f i = negate 2 + negate 6 * fromIntegral (sLen - i) / fromIntegral sLen +deadScalp :: Creature -> Shape +deadScalp = overPosSH (Q.rotateToZ (V3 1 0 0)) . translateSHz 10 . scalp + scalp :: Creature -> Shape {-# INLINE scalp #-} scalp cr @@ -222,6 +245,9 @@ torso cr --aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPoly 10 $ polyCirc 3 crad aShoulder = scaleSH (V3 10 10 1) baseShoulder +deadUpperBody :: Creature -> Shape +deadUpperBody = overPosSH (Q.rotateToZ (V3 1 0 0)) . translateSHz (negate 10) . upperBody + baseShoulder :: Shape {-# INLINE baseShoulder #-} baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10 $ polyCirc 3 1 @@ -266,17 +292,15 @@ 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 +basicCrCorpse :: Creature -> Corpse -> SPic +basicCrCorpse cr cp = noPic . tr . scaleSH (V3 crsize crsize crsize) $ mconcat + [ rotdir . colorSH (_skinHead cskin) $ deadScalp cr + , rotdir $ colorSH (_skinUpper cskin) $ deadUpperBody cr + , rotdir . rotmdir $ colorSH (_skinLower cskin) $ deadFeet 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) + tr = uncurryV translateSHf (_cpPos cp) + rotdir = rotateSH (_cpDir cp) + rotmdir = rotateSH (_crMvDir cr - _crDir cr) diff --git a/src/Dodge/Creature/State.hs b/src/Dodge/Creature/State.hs index 1821014e9..407233cf6 100644 --- a/src/Dodge/Creature/State.hs +++ b/src/Dodge/Creature/State.hs @@ -69,10 +69,10 @@ checkDeath cr w | _crHP cr > 0 = w | otherwise = w -- & creatures . at (_crID cr) .~ Nothing + & dropByState cr & removecr & stopSoundFrom (CrWeaponSound (_crID cr) 0) & plNew corpses cpID thecorpse - & dropByState cr where removecr | _crID cr == 0 = (creatures . ix (_crID cr) . crUpdate .~ const id) diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index ebd568842..5855b3960 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -277,7 +277,7 @@ data Corpse = Corpse { _cpID :: Int , _cpPos :: Point2 , _cpDir :: Float - , _cpPict :: SPic + , _cpPict :: Corpse -> SPic , _cpRes :: Maybe Creature } data Gust = Gust @@ -339,7 +339,7 @@ data Creature = Creature , _crEquipment :: M.Map EquipPosition Int , _crLeftInvSel :: Maybe Int , _crState :: CreatureState - , _crCorpse :: Creature -> SPic + , _crCorpse :: Creature -> Corpse -> SPic , _crApplyDamage :: [Damage] -> Creature -> World -> World , _crPastDamage :: Int , _crStance :: Stance diff --git a/src/Dodge/Render/ShapePicture.hs b/src/Dodge/Render/ShapePicture.hs index 593fb0681..83c950db1 100644 --- a/src/Dodge/Render/ShapePicture.hs +++ b/src/Dodge/Render/ShapePicture.hs @@ -32,6 +32,7 @@ worldSPic :: Configuration -> World -> SPic worldSPic cfig w = (extraShapes w, extraPics cfig w) <> foldMap (dbArg _prDraw) (filtOn _pjPos _props) + <> foldMap (dbArg _cpPict) (filtOn _cpPos _corpses) <> foldMap ((($ w) . ($ cfig)) . dbArg _crPict) (filtOn _crPos _creatures) <> foldMap floorItemSPic (filtOn _flItPos _floorItems) <> foldMap btSPic (filtOn _btPos _buttons)