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

Add basic corpse shapes

Browse Source
This commit is contained in:
justin
2022-06-04 13:23:31 +01:00
parent 5f5b1dd422
commit 63af928a1a
4 changed files with 44 additions and 19 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+40 -16
View File
@@ -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)