Move towards unifying (your) creature manipulation with selection

This commit is contained in:
2026-05-14 13:42:33 +01:00
parent ab393febcb
commit 59d128f87a
35 changed files with 271 additions and 252 deletions
+24 -24
View File
@@ -40,9 +40,9 @@ drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
BarrelCrit{} -> barrelShape
LampCrit{_lampHeight = h} -> lampCrSPic h
ChaseCrit{} -> noPic $ drawChaseCrit w cr
Avatar{} -> basicCrPict m cr
SwarmCrit -> basicCrPict m cr
AutoCrit -> basicCrPict m cr
Avatar{} -> basicCrPict w m cr
SwarmCrit -> basicCrPict w m cr
AutoCrit -> basicCrPict w m cr
CrabCrit{} -> noPic $ drawCrabCrit w cr
HoverCrit{} -> noPic $ drawHoverCrit cr
SlinkCrit{} -> noPic $ drawSlinkCrit cr
@@ -67,15 +67,15 @@ drawSlimeCrit cr =
guard $ length qs == 12
return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs)
basicCrPict :: IM.IntMap Item -> Creature -> SPic
basicCrPict m cr = drawEquipment m cr <> noPic (basicCrShape cr)
basicCrPict :: World -> IM.IntMap Item -> Creature -> SPic
basicCrPict w m cr = drawEquipment w m cr <> noPic (basicCrShape w cr)
basicCrShape :: Creature -> Shape
basicCrShape cr =
basicCrShape :: World -> Creature -> Shape
basicCrShape w cr =
scaleSH (V3 crsize crsize crsize) $
mconcat
[ colorSH (_skinHead cskin) . overPosSH (translateToES cr OnHead) $ scalp
, colorSH (_skinUpper cskin) $ upperBody cr
[ colorSH (_skinHead cskin) . overPosSH (translateToES w cr OnHead) $ scalp
, colorSH (_skinUpper cskin) $ upperBody w cr
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
]
where
@@ -294,8 +294,8 @@ spiderJoint p q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a + b)), f . Q.axisAngle
-- c = argV $ (p-q) ^. _xy
-- f x = Q.qz c * x
makeCorpse :: StdGen -> Creature -> SPic
makeCorpse g cr = case cr ^. crType of
makeCorpse :: World -> StdGen -> Creature -> SPic
makeCorpse w g cr = case cr ^. crType of
HoverCrit{} -> noPic $ drawHoverCrit cr
ChaseCrit{} -> noPic $ chaseCorpse g cr
CrabCrit{} -> noPic $ crabCorpse g cr
@@ -305,7 +305,7 @@ makeCorpse g cr = case cr ^. crType of
. scaleSH (V3 crsize crsize crsize)
$ mconcat
[ colorSH (_skinHead cskin) $ deadScalp cr
, colorSH (_skinUpper cskin) $ deadUpperBody cr
, colorSH (_skinUpper cskin) $ deadUpperBody w cr
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
]
where
@@ -375,12 +375,12 @@ deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet = feet
arms :: Creature -> Shape
arms :: World -> Creature -> Shape
{-# INLINE arms #-}
arms cr =
arms w cr =
(^. _1) $
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
translateToRightHand w cr aHand
<> translateToLeftHand w cr aHand
where
aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4
@@ -404,28 +404,28 @@ scalp =
(colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
& each . sfShadowImportance .~ Unimportant
torso :: Creature -> Shape
torso :: World -> Creature -> Shape
{-# INLINE torso #-}
torso cr = overPosSH (translateToES cr OnBack) tsh
torso w cr = overPosSH (translateToES w cr OnBack) tsh
where
tsh = ashoulder 3 (-0.2) <> ashoulder (-3) 0.2
ashoulder y a = translateSHxy 0 y . rotateSH a $ scaleSH (V3 10 10 1) baseShoulder
deadUpperBody :: Creature -> Shape
deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
deadUpperBody :: World -> Creature -> Shape
deadUpperBody w cr = deadRot cr . translateSHz (negate 10) . upperBody w $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
-- baseShoulder = translateSHz (-20) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
baseShoulder = scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: Creature -> Shape
upperBody :: World -> Creature -> Shape
{-# INLINE upperBody #-}
upperBody cr = arms cr <> torso cr
upperBody w cr = arms w cr <> torso w cr
drawEquipment :: IM.IntMap Item -> Creature -> SPic
drawEquipment :: World -> IM.IntMap Item -> Creature -> SPic
{-# INLINE drawEquipment #-}
drawEquipment m cr = foldMap (itemEquipPict cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
drawEquipment w m cr = foldMap (itemEquipPict w cr) (invDT . fmap (\i -> m ^?! ix i) $ _crInv cr)
barrelShape :: SPic
barrelShape = noPic $ cylinderPoly Medium Important (map (addZ 20) ps) (map (addZ 0) ps)