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

Continue to refactor body/equipment positionings

Browse Source
This commit is contained in:
justin
2025-08-27 14:40:13 +01:00
parent 9d2a2e6730
commit 86696deb56
14 changed files with 151 additions and 189 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+19 -26
View File
@@ -9,6 +9,7 @@ module Dodge.Creature.Picture (
deadFeet,
) where
import Dodge.Data.Equipment.Misc
import Dodge.Creature.HandPos
import qualified Data.IntMap.Strict as IM
import Control.Lens
@@ -27,19 +28,19 @@ import Shape
import ShapePicture
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape m cr)
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible
basicCrShape :: IM.IntMap Item -> Creature -> Shape
basicCrShape m cr
basicCrShape :: Creature -> Shape
basicCrShape cr
| crCamouflage cr == Invisible = mempty
| otherwise =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ scalp m cr
, colorSH (_skinUpper cskin) $ upperBody m cr
[ colorSH (_skinHead cskin) $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
@@ -68,17 +69,17 @@ deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
arms :: IM.IntMap Item -> Creature -> Shape
arms :: Creature -> Shape
{-# INLINE arms #-}
arms m cr =
arms cr =
(^. _1) $
translateToRightHand cr aHand
<> translateToLeftHand m cr aHand
<> translateToLeftHand cr aHand
where
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
deadScalp :: IM.IntMap Item -> Creature -> Shape
deadScalp m cr = deadRot cr . translateSHz 10 . scalp m $ cr
deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
deadRot :: Creature -> Shape -> Shape
deadRot cr = overPosSH (Q.rotateToZ d)
@@ -89,9 +90,9 @@ deadRot cr = overPosSH (Q.rotateToZ d)
(addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
(damageDirection $ _crDamage cr)
scalp :: IM.IntMap Item -> Creature -> Shape
scalp :: Creature -> Shape
{-# INLINE scalp #-}
scalp m cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
scalp cr = overPosSH (translateToES cr OnHead) fhead
-- | twists cr = translateSHxy 0 5 . rotateSH (-1) $ translateSHxy (negate 2.5) 0.25 fhead
-- | oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
-- | otherwise = translateSHxy 2.5 0 fhead
@@ -100,15 +101,7 @@ scalp m cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
torso :: Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
-- | oneH cr = rotateSH 0.5 tsh
-- | twists cr =
-- translateSHxy 0 3 . rotateSH (-1.3) $ tsh
---- mconcat
---- [ rotateSH (negate 0.2) . translateSHxy 2 3 . rotateSH (negate 0.4) $ aShoulder
---- , rotateSH (negate 0.2) . translateSHxy 0 (negate 3) . rotateSH 0.2 $ aShoulder
---- ]
-- | otherwise = tsh
torso cr = overPosSH (translateToES cr OnBack) tsh
where
tsh =
mconcat
@@ -117,20 +110,20 @@ torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
]
aShoulder = scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: IM.IntMap Item -> Creature -> Shape
deadUpperBody m cr = deadRot cr . translateSHz (negate 10) . upperBody m $ cr
deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: IM.IntMap Item -> Creature -> Shape
upperBody :: Creature -> Shape
{-# INLINE upperBody #-}
upperBody m cr = arms m cr <> shoulderSH (torso cr)
upperBody cr = arms cr <> shoulderSH (torso cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment m cr = foldMap (itemEquipPict m cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)