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

Major item refactor, still broken

Browse Source
This commit is contained in:
justin
2025-08-24 19:34:09 +01:00
parent 22b4be440a
commit 94f6d5c630
62 changed files with 820 additions and 805 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+23 -22
View File
@@ -10,6 +10,7 @@ module Dodge.Creature.Picture (
) where
import Dodge.Creature.HandPos
import qualified Data.IntMap.Strict as IM
import Control.Lens
import Dodge.Creature.Radius
import Dodge.Creature.Shape
@@ -25,20 +26,20 @@ import Shape
--import Shape
import ShapePicture
basicCrPict :: Creature -> SPic
basicCrPict cr = drawEquipment cr <> noPic (basicCrShape cr)
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape m cr)
crCamouflage :: Creature -> CamouflageStatus
crCamouflage _ = FullyVisible
basicCrShape :: Creature -> Shape
basicCrShape cr
basicCrShape :: IM.IntMap Item -> Creature -> Shape
basicCrShape m cr
| crCamouflage cr == Invisible = mempty
| otherwise =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) $ scalp cr
, colorSH (_skinUpper cskin) $ upperBody cr
[ colorSH (_skinHead cskin) $ scalp m cr
, colorSH (_skinUpper cskin) $ upperBody m cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
@@ -67,17 +68,17 @@ deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
arms :: Creature -> Shape
arms :: IM.IntMap Item -> Creature -> Shape
{-# INLINE arms #-}
arms cr =
arms m cr =
(^. _1) $
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
translateToRightHand m cr aHand
<> translateToLeftHand m cr aHand
where
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
deadScalp :: IM.IntMap Item -> Creature -> Shape
deadScalp m cr = deadRot cr . translateSHz 10 . scalp m $ cr
deadRot :: Creature -> Shape -> Shape
deadRot cr = overPosSH (Q.rotateToZ d)
@@ -88,18 +89,18 @@ deadRot cr = overPosSH (Q.rotateToZ d)
(addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
(damageDirection $ _crDamage cr)
scalp :: Creature -> Shape
scalp :: IM.IntMap Item -> Creature -> Shape
{-# INLINE scalp #-}
scalp cr = overPosSH (\p -> fst (headPQ cr `Q.comp` (p,Q.qID))) fhead
scalp m cr = overPosSH (\p -> fst (headPQ m cr `Q.comp` (p,Q.qID))) 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
where
fhead = colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5
torso :: Creature -> Shape
torso :: IM.IntMap Item -> Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
torso m cr = overPosSH (\p -> fst (backPQ m cr `Q.comp` (p,Q.qID))) tsh
-- | oneH cr = rotateSH 0.5 tsh
-- | twists cr =
-- translateSHxy 0 3 . rotateSH (-1.3) $ tsh
@@ -116,20 +117,20 @@ torso cr = overPosSH (\p -> fst (backPQ cr `Q.comp` (p,Q.qID))) tsh
]
aShoulder = scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
deadUpperBody :: IM.IntMap Item -> Creature -> Shape
deadUpperBody m cr = deadRot cr . translateSHz (negate 10) . upperBody m $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: Creature -> Shape
upperBody :: IM.IntMap Item -> Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr = arms cr <> shoulderSH (torso cr)
upperBody m cr = arms m cr <> shoulderSH (torso m cr)
shoulderSH :: Shape -> Shape
shoulderSH = translateSHz 20
drawEquipment :: Creature -> SPic
drawEquipment :: IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment cr = foldMap (itemEquipPict cr) (invDT $ _crInv cr)
drawEquipment m cr = foldMap (itemEquipPict m cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)