479 lines
17 KiB
Haskell
479 lines
17 KiB
Haskell
{- |
|
|
Drawing of creatures.
|
|
Takes into account damage etc.
|
|
-}
|
|
module Dodge.Creature.Picture (
|
|
makeCorpse,
|
|
drawCreature,
|
|
) where
|
|
|
|
import Control.Lens
|
|
import Control.Monad
|
|
import Data.Foldable
|
|
import qualified Data.IntMap.Strict as IM
|
|
import Data.Maybe
|
|
import qualified Data.Strict.Tuple as ST
|
|
import Dodge.Base.Collide
|
|
import Dodge.Creature.HandPos
|
|
import Dodge.Creature.Radius
|
|
import Dodge.Creature.Shape
|
|
import Dodge.Creature.Slime
|
|
import Dodge.Damage
|
|
import Dodge.Data.Equipment.Misc
|
|
import Dodge.Data.World
|
|
import Dodge.Item.Draw
|
|
import Dodge.Item.Grammar
|
|
import Geometry
|
|
import Geometry.Zone
|
|
import Linear
|
|
import Picture
|
|
import qualified Quaternion as Q
|
|
import RandomHelp
|
|
import Shape
|
|
import ShapePicture
|
|
|
|
drawCreature :: World -> IM.IntMap Item -> Creature -> SPic
|
|
drawCreature w m cr = translateSP (_crPos cr) . fallrot . rotateSP (_crDir cr) $
|
|
case cr ^. crType of
|
|
_ | CrIsCorpse sp <- cr ^. crHP -> sp
|
|
_ | null (cr ^? crHP . _HP) -> mempty
|
|
BarrelCrit{} -> barrelShape
|
|
LampCrit{_lampHeight = h} -> lampCrSPic h
|
|
ChaseCrit{} -> noPic $ drawChaseCrit w 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
|
|
SlimeCrit{} -> noPic $ drawSlimeCrit cr
|
|
BeeCrit{} -> noPic $ drawBeeCrit cr
|
|
HiveCrit{} -> drawHive
|
|
where
|
|
fallrot = case cr ^? crStance . carriage . carDir of
|
|
Just q -> _1 . each . sfVs . each %~ Q.rotate q
|
|
_ -> id
|
|
|
|
drawSlimeCrit :: Creature -> Shape
|
|
drawSlimeCrit cr =
|
|
colorSH green $
|
|
upperPrismPolyHalf Medium Typical (cr ^?! crType . slimeEngulfProgress + min 15 r) ps
|
|
where
|
|
r = slimeToRad $ cr ^?! crType . slimeSlime - cr ^?! crType . slimeSlimeChange
|
|
so = slimeOutline cr
|
|
ps = fromMaybe so $ do
|
|
SlimeDistortion x' qs _ <- cr ^? crType . slimeDistortion
|
|
let x = fromIntegral x'
|
|
guard $ length qs == 12
|
|
return $ zipWith (+) (fmap (0.1 * (10 - x) *^) so) (fmap (0.1 * x *^) qs)
|
|
|
|
basicCrPict :: World -> IM.IntMap Item -> Creature -> SPic
|
|
basicCrPict w m cr = drawEquipment w m cr <> noPic (basicCrShape w cr)
|
|
|
|
basicCrShape :: World -> Creature -> Shape
|
|
basicCrShape w cr =
|
|
scaleSH (V3 crsize crsize crsize) $
|
|
mconcat
|
|
[ colorSH (_skinHead cskin) . overPosSH (translateToES w cr OnHead) $ scalp
|
|
, colorSH (_skinUpper cskin) $ upperBody w cr
|
|
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
|
|
]
|
|
where
|
|
cskin = crShape $ _crType cr
|
|
crsize = 0.1 * crRad (cr ^. crType)
|
|
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
|
|
|
drawSlinkCrit :: Creature -> Shape
|
|
drawSlinkCrit cr =
|
|
snd (foldl' f ((V3 0 0 0, Q.qid), mempty) $ cr ^?! crType . slinkSpine)
|
|
<> shead
|
|
& each . sfColor .~ cskin ^?! skinUpper
|
|
where
|
|
shead =
|
|
polyCirc 6 15
|
|
& upperPrismPoly Medium Important 10
|
|
& each . sfVs . each %~ Q.apply (cr ^?! crType . slinkHeadPos)
|
|
cskin = crShape $ _crType cr
|
|
f ((p, q), sh) (p', q') = ((p, q) `Q.comp` (p', q'), sh <> (g p' & each . sfVs . each %~ Q.apply (p, q)))
|
|
g _ = upperPrismPoly Medium Important 2 $ polyCirc 6 15
|
|
|
|
drawHoverCrit :: Creature -> Shape
|
|
drawHoverCrit cr =
|
|
colorSH
|
|
(_skinHead cskin)
|
|
(overPosSH (Q.apply tpq) $ upperBoxHalf Medium Typical 1 $ square 4)
|
|
<> colorSH
|
|
(_skinUpper cskin)
|
|
(mconcat [overPosSH (Q.apply $ f a) $ upperBox Medium Typical 1 $ polyCirc 3 5 | a <- [0, pi / 2, pi, 1.5 * pi]])
|
|
where
|
|
cskin = crShape $ _crType cr
|
|
f a = tpq `Q.comp` (1 & _xy .~ rotateV a 5, Q.qid)
|
|
tpq = (V3 0 0 0, Q.qid)
|
|
|
|
drawHive :: SPic
|
|
drawHive = noPic $ upperPrismPolyHalfMI 25 $ polyCirc 6 20
|
|
|
|
drawBeeCrit :: Creature -> Shape
|
|
drawBeeCrit cr =
|
|
colorSH
|
|
col
|
|
(f . upperPrismPolyHalfMI 3 $ polyCirc 6 r)
|
|
<> colorSH (dark col) (overPosSH (Q.apply beakpos) $ upperPrismPolyHalfST 1 [V2 0 (-2), V2 4 0, V2 0 2])
|
|
where
|
|
r = cr ^. crType . to crRad
|
|
beakpos = (V3 (r - 1) 0 0, Q.qid)
|
|
col | cr ^?! crType . beeAggro > 0 = red
|
|
| otherwise = yellow
|
|
f | Mounted{} <- cr ^. crStance . carriage =
|
|
each.sfVs.each._y *~ g (modTo 1 $ cr ^?! crType . beeSlime . to ((/ 100) . fromIntegral))
|
|
| otherwise = id
|
|
g x | x > 0.5 = 2 - x
|
|
| otherwise = 1 + x
|
|
|
|
drawCrabCrit :: World -> Creature -> Shape
|
|
drawCrabCrit w cr =
|
|
mconcat
|
|
[ crabUpperBody w cr
|
|
, colorSH (_skinLower cskin) $ crabFeet w cr
|
|
]
|
|
where
|
|
cskin = crShape $ _crType cr
|
|
|
|
drawChaseCrit :: World -> Creature -> Shape
|
|
drawChaseCrit w cr =
|
|
mconcat
|
|
[ chaseUpperBody w cr
|
|
, rotmdir $ colorSH (_skinLower cskin) $ feet cr
|
|
]
|
|
where
|
|
cskin = crShape $ _crType cr
|
|
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
|
|
|
crabUpperBody :: World -> Creature -> Shape
|
|
crabUpperBody _ cr =
|
|
colorSH
|
|
(_skinUpper cskin)
|
|
( overPosSH
|
|
(Q.apply torsoq)
|
|
( upperPrismPolyHalfMI 5 $
|
|
polyCirc 4 10
|
|
& each . _x *~ 0.6
|
|
)
|
|
<> overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
|
|
<> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
|
|
)
|
|
<> colorSH
|
|
(_skinHead cskin)
|
|
(overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
|
|
where
|
|
torsoq = (V3 0 0 10, Q.qid)
|
|
lclawq = torsoq `Q.comp` (V3 2 8 1, Q.slerp latck lrest lcool)
|
|
latck = Q.axisAngle (V3 0 0 1) (-0.5 * pi)
|
|
lrest = Q.axisAngle (V3 1 0 0) 1
|
|
cskin = crShape $ _crType cr
|
|
lcool = 1 - min 10 (fromIntegral . _meleeCooldownL $ _crType cr) / 10
|
|
rclawq = torsoq `Q.comp` (V3 2 (-8) 1, Q.slerp ratck rrest rcool)
|
|
ratck = Q.axisAngle (V3 0 0 1) (0.5 * pi)
|
|
rrest = Q.axisAngle (V3 1 0 0) (-1)
|
|
rcool = 1 - min 10 (fromIntegral . _meleeCooldownR $ _crType cr) / 10
|
|
headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
|
|
|
|
chaseUpperBody :: World -> Creature -> Shape
|
|
chaseUpperBody w cr =
|
|
-- colorSH
|
|
-- (_skinUpper cskin)
|
|
( overPosSH
|
|
(Q.apply torsoq)
|
|
( upperPrismPolyHalfMI tz $
|
|
polyCirc 3 12
|
|
& each %~ vNormal
|
|
& each . _y *~ 0.6
|
|
)
|
|
<> overPosSH (Q.apply neckq) lneckshape
|
|
<> overPosSH (Q.apply neckq2) uneckshape
|
|
)
|
|
<> colorSH
|
|
-- (_skinHead cskin)
|
|
yellow headshape
|
|
where
|
|
-- time = fromIntegral (mod (w ^. unpauseClock) 100) / 5
|
|
tz = 4
|
|
cskin = crShape $ _crType cr
|
|
torsoq = (V3 0 0 (10 + tz + tbob), Q.qy (-cr ^?! crType . chaseqy0))
|
|
mcool = 1 - min 10 (fromIntegral . _meleeCooldown $ _crType cr) / 10
|
|
-- (qy1,qy2,qy3)
|
|
---- | CloseToMelee i <- cr ^?!crActionPlan.apStrategy
|
|
---- = (0,0,0)
|
|
-- | otherwise = (pi/3,-2*pi/3,pi/3)
|
|
-- | otherwise = (pi * w^.cWorld.cClock.to ((*0.01).fromIntegral),0,0)
|
|
-- | otherwise = (-1.8 * mcool , 0, 2 * mcool + vocaltilt)
|
|
qy1 = cr ^?! crType . chaseqy1
|
|
qy2 = cr ^?! crType . chaseqy2
|
|
qy3 = cr ^?! crType . chaseqy3
|
|
lneckshape = colorSH red $ upperPrismPolyHalfMI 4 (vNormal <$> trapTBH 2 5 (nlen/4))
|
|
& each . sfVs . each +~ V3 (nlen/4) 0 (-2)
|
|
uneckshape = colorSH green $ upperPrismPolyHalfMI 3 (vNormal <$> trapTBH 3 2 (nlen/4))
|
|
& each . sfVs . each +~ V3 (nlen/4) 0 (-1.5)
|
|
headshape = overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4])
|
|
neckq = torsoq `Q.comp` (V3 8 0 4, Q.qz aimrot * Q.qy (pi + qy1))
|
|
neckq2 = neckq `Q.comp` (V3 (nlen/2) 0 0, Q.qy qy2)
|
|
headq = neckq2 `Q.comp` (V3 (nlen/2) 0 0, Q.qy (pi + qy3) * Q.qz aimrot)
|
|
nlen = 16
|
|
vocaltilt = case cr ^? crVocalization . vcTime of
|
|
Just x | x < 20 -> -pi * 0.05 * (10 - abs (fromIntegral x - 10))
|
|
_ -> 0
|
|
sLen = strideLength cr
|
|
tbob = 5 * (1 - oneSmooth (abs llegpos))
|
|
llegpos = case (cr ^? crType . strideAmount, cr ^? crType . footForward) of
|
|
(Just sa, Just LeftForward) -> f sa
|
|
(Just sa, Just RightForward) -> -f sa
|
|
_ -> 0
|
|
-- tbob = 2 * oneSmooth ((sLen - 2*i) / sLen)
|
|
f i = (sLen - 2 * i) / sLen
|
|
cxy = cr ^. crPos . _xy
|
|
aimrot = fromMaybe pi $ do
|
|
i <- cr ^. crIntention . targetCr
|
|
tcxy <- w ^? cWorld . lWorld . creatures . ix i . crPos . _xy
|
|
guard $ hasLOSIndirect cxy tcxy w
|
|
return . (0.5 *) . nearZeroAngle $ argV (tcxy - cxy) - cr ^. crDir
|
|
|
|
{- NECK ARTICULATION
|
|
Viewed from side, all hinges, torso/lower neck also hinges in Q.qz (not shown)
|
|
na1 na2 na3 <- angles, in diagram all == 0, in Q.qy
|
|
| | |
|
|
---.---.---.--- z
|
|
| | | | ^>x
|
|
torso | u.neck|
|
|
l.neck head
|
|
Rough examples
|
|
Flat aim: Resting:
|
|
.\\
|
|
\ \\
|
|
. .
|
|
/ \ /
|
|
---. .--- ---.
|
|
a1 = 60 a1 = 60
|
|
a2 = -120 a2 = 60
|
|
a3 = 60 a3 = -160
|
|
-}
|
|
|
|
--ikTwoArms :: Point3 -> Point3 -> Point3 -> Point3 -> (QFloat,QFloat)
|
|
--ikTwoArms
|
|
|
|
oneSmooth :: Float -> Float
|
|
oneSmooth x = sin (pi * x * 0.5)
|
|
|
|
feet :: Creature -> Shape
|
|
{-# INLINE feet #-}
|
|
feet cr = case (cr ^? crType . strideAmount, cr ^? crType . footForward) of
|
|
(Just sa, Just LeftForward) -> sh (f sa)
|
|
(Just sa, Just RightForward) -> sh (-f sa)
|
|
_ -> sh 0
|
|
where
|
|
sh x = translateSHxy x off aFoot <> translateSHxy (-x) (-off) aFoot
|
|
aFoot = upperPrismPolyST 10 $ polyCirc 3 4
|
|
off = 5
|
|
sLen = strideLength cr
|
|
-- f i = 8 * (sLen - 2*i) / sLen
|
|
f i = 8 * oneSmooth ((sLen - 2 * i) / sLen)
|
|
|
|
crabFeet :: World -> Creature -> Shape
|
|
{-# INLINE crabFeet #-}
|
|
crabFeet _ cr =
|
|
uncurryV translateSHxy rpos (afoot & each . sfVs . each %~ Q.rotate r1)
|
|
<> ( afoot
|
|
& each . sfVs . each %~ Q.rotate r2
|
|
& each . sfVs . each +~ V3 0 2 5
|
|
)
|
|
<> uncurryV translateSHxy rpos' (afoot & each . sfVs . each %~ Q.rotate r1')
|
|
<> ( afoot
|
|
& each . sfVs . each %~ Q.rotate r2'
|
|
& each . sfVs . each +~ V3 0 2 5
|
|
)
|
|
<> uncurryV translateSHxy lpos (afoot & each . sfVs . each %~ Q.rotate l1)
|
|
<> ( afoot
|
|
& each . sfVs . each %~ Q.rotate l2
|
|
& each . sfVs . each +~ V3 0 (-2) 5
|
|
)
|
|
<> uncurryV translateSHxy lpos' (afoot & each . sfVs . each %~ Q.rotate l1')
|
|
<> ( afoot
|
|
& each . sfVs . each %~ Q.rotate l2'
|
|
& each . sfVs . each +~ V3 0 (-2) 5
|
|
)
|
|
where
|
|
rpos = rot (cr ^?! crType . rFootPos - cxy)
|
|
rot = rotateV cdir
|
|
lpos = rot (cr ^?! crType . lFootPos - cxy)
|
|
f p q = q + 2 *^ (p - q)
|
|
cdir = -cr ^. crDir
|
|
cxy = cr ^. crPos . _xy
|
|
afoot = upperPrismPolyHalfST 10 $ polyCirc 3 2
|
|
(r1, r2) = spiderJoint (0 & _xy .~ rpos) (V3 0 2 5)
|
|
rpos' = f (V2 0 10) rpos
|
|
(r1', r2') = spiderJoint (0 & _xy .~ rpos') (V3 0 2 5)
|
|
(l1, l2) = spiderJoint (0 & _xy .~ lpos) (V3 0 (-2) 5)
|
|
lpos' = f (V2 0 (-10)) lpos
|
|
(l1', l2') = spiderJoint (0 & _xy .~ lpos') (V3 0 (-2) 5)
|
|
|
|
spiderJoint :: Point3 -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float)
|
|
spiderJoint p q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a + b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
|
|
where
|
|
-- spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
|
|
|
|
a = angleThreeSides 10 (distance p q) 10
|
|
b = angleVV3 (q - p) (V3 0 0 (-1))
|
|
c = argV $ (p - q) ^. _xy
|
|
f x = Q.qz c * x
|
|
|
|
-- spiderJoint' :: Point3 -> Float -> Float -> Point3 -> (Q.Quaternion Float, Q.Quaternion Float)
|
|
-- spiderJoint' p l1 l2 q = (f $ Q.axisAngle (V3 0 (-1) 0) (pi - (a+b)), f . Q.axisAngle (V3 0 (-1) 0) $ a - b)
|
|
----spiderJoint p q = (Q.qz c, Q.axisAngle (V3 0 (-1) 0) $ a)
|
|
-- where
|
|
-- a = angleThreeSides 10 (distance p q) 10
|
|
-- b = angleVV3 (q-p) (V3 0 0 (-1))
|
|
-- c = argV $ (p-q) ^. _xy
|
|
-- f x = Q.qz c * x
|
|
|
|
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
|
|
BeeCrit{} -> noPic $ drawBeeCrit cr
|
|
_ ->
|
|
noPic
|
|
. scaleSH (V3 crsize crsize crsize)
|
|
$ mconcat
|
|
[ colorSH (_skinHead cskin) $ deadScalp cr
|
|
, colorSH (_skinUpper cskin) $ deadUpperBody w cr
|
|
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
|
|
]
|
|
where
|
|
cskin = crShape $ _crType cr -- this should be fixed
|
|
crsize = 0.1 * crRad (cr ^. crType)
|
|
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
|
|
|
chaseCorpse :: StdGen -> Creature -> Shape
|
|
chaseCorpse g cr =
|
|
mconcat
|
|
[ colorSH (_skinUpper cskin) . upperPrismPolyHalfMI 0 $
|
|
polyCirc 3 12
|
|
& each %~ vNormal
|
|
& each . _y *~ 0.6
|
|
, colorSH (_skinUpper cskin) . overPosSH (Q.apply neckq) $
|
|
upperPrismPolyHalfMI 3 ((+ V2 8 0) . vNormal <$> trapTBH 2 5 8)
|
|
, colorSH
|
|
(_skinHead cskin)
|
|
(overPosSH (Q.apply headq) (upperBox Medium Important 2 [V2 0 (-4), V2 9 0, V2 0 4]))
|
|
, rotmdir $ colorSH (_skinLower cskin) $ deadFeet cr
|
|
]
|
|
where
|
|
neckq = (V3 6 0 0, Q.qz a)
|
|
(a, g') = randomR (-2, 2) g
|
|
b = fst $ randomR (-2, 2) g'
|
|
cskin = crShape $ _crType cr -- this should be fixed
|
|
rotmdir = rotateSH (_crMvDir cr - _crDir cr)
|
|
headq = neckq `Q.comp` (V3 16 0 0, Q.qz b)
|
|
|
|
crabCorpse :: StdGen -> Creature -> Shape
|
|
crabCorpse g cr =
|
|
mconcat
|
|
[ colorSH (_skinUpper cskin) $
|
|
overPosSH
|
|
(Q.apply torsoq)
|
|
( upperPrismPolyHalfMI 5 $
|
|
polyCirc 4 10
|
|
& each . _x *~ 0.6
|
|
)
|
|
, colorSH (_skinUpper cskin) $
|
|
overPosSH (Q.apply lclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 20 0 (-2) 2)
|
|
<> overPosSH (Q.apply rclawq) (upperPrismPolyHalfMI 4 $ rectNSWE 0 (-20) (-2) 2)
|
|
, colorSH (cskin ^?! skinLower) $
|
|
foldMap (mkfoot 5) (take 2 ps)
|
|
<> foldMap (mkfoot (-5)) (take 2 $ drop 2 ps)
|
|
, colorSH
|
|
(_skinHead cskin)
|
|
(overPosSH (Q.apply headq) (upperPrismPolyHalfMI 1 $ square 2))
|
|
]
|
|
where
|
|
headq = torsoq `Q.comp` (V3 3 0 4, Q.qid)
|
|
torsoq = (V3 0 0 0, Q.qid)
|
|
lclawq = torsoq `Q.comp` (V3 2 8 1, Q.axisAngle (V3 1 0 0) (-0.1) * Q.qz la)
|
|
(la, g') = randomR (-2, 2) g
|
|
ra = fst $ randomR (-2, 2) g'
|
|
ps = evalState (replicateM 4 (randInCirc 9)) g
|
|
mkfoot y p =
|
|
let p' = 0 & _xy .~ p + V2 0 (3 * y)
|
|
(q1, q2) = spiderJoint (V3 0 y 0) p'
|
|
in (afoot & each . sfVs . each %~ Q.apply (V3 0 y 0, q1))
|
|
<> (afoot & each . sfVs . each %~ Q.apply (p', q2))
|
|
afoot = upperPrismPolyST 10 $ polyCirc 3 2
|
|
rclawq = torsoq `Q.comp` (V3 2 (-8) 1, Q.axisAngle (V3 1 0 0) 0.1 * Q.qz ra)
|
|
cskin = crShape $ _crType cr -- this should be fixed
|
|
|
|
deadFeet :: Creature -> Shape
|
|
{-# INLINE deadFeet #-}
|
|
deadFeet = feet
|
|
|
|
arms :: World -> Creature -> Shape
|
|
{-# INLINE arms #-}
|
|
arms w cr =
|
|
(^. _1) $
|
|
translateToRightHand w cr aHand
|
|
<> translateToLeftHand w cr aHand
|
|
where
|
|
aHand = noPic $ translateSHz (-2) . upperPrismPolyHalfST 2 $ polyCirc 3 4
|
|
|
|
deadScalp :: Creature -> Shape
|
|
-- deadScalp cr = deadRot cr . translateSHz 5 . scalp $ cr
|
|
-- deadScalp cr = deadRot cr . translateSHz (-5) . scalp $ cr
|
|
deadScalp _ = translateSH (V3 (-13) 0 0) scalp
|
|
|
|
deadRot :: Creature -> Shape -> Shape
|
|
deadRot cr = overPosSH (Q.rotateToZ d)
|
|
where
|
|
d =
|
|
maybe
|
|
(V3 1 0 0)
|
|
(addZ 0 . unitVectorAtAngle . subtract (_crDir cr + pi))
|
|
(damageDirection $ _crDamage cr)
|
|
|
|
scalp :: Shape
|
|
{-# INLINE scalp #-}
|
|
scalp =
|
|
(colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5)
|
|
& each . sfShadowImportance .~ Unimportant
|
|
|
|
torso :: World -> Creature -> Shape
|
|
{-# INLINE torso #-}
|
|
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 :: 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 :: World -> Creature -> Shape
|
|
{-# INLINE upperBody #-}
|
|
upperBody w cr = arms w cr <> torso w cr
|
|
|
|
drawEquipment :: World -> IM.IntMap Item -> Creature -> SPic
|
|
{-# INLINE drawEquipment #-}
|
|
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)
|
|
where
|
|
ps = polyCirc 3 10
|
|
|
|
lampCrSPic :: Float -> SPic
|
|
lampCrSPic h =
|
|
colorSH blue (upperBox Small Undesired h $ rectWH 5 5)
|
|
ST.:!: setLayer BloomLayer (setDepth h . color white $ circleSolid 3)
|