Allow for items to cast shadows
This commit is contained in:
@@ -37,10 +37,8 @@ basicCrPict
|
||||
-> SPic
|
||||
basicCrPict col cr w = SPic (basicCrShape col cr w) $ pictures $
|
||||
targetingPic ++
|
||||
[ tr . dm . rotdir $ upperBody col cr
|
||||
, tr . dm . rotmdir $ feet cr
|
||||
, tr . rotdir $ drawEquipment cr
|
||||
, creatureDisplayText w cr
|
||||
[ creatureDisplayText w cr
|
||||
, tr . rotdir $ _spPicture $ drawEquipment cr
|
||||
]
|
||||
where
|
||||
dm = damageMod cr
|
||||
@@ -58,7 +56,10 @@ basicCrShape
|
||||
-> World
|
||||
-> Shape
|
||||
basicCrShape col cr w = mconcat
|
||||
[ tr . translateSHz 25 . dm . rotdir $ scalp cr
|
||||
[ tr . rotdir $ _spShape $ drawEquipment cr
|
||||
, tr . translateSHz 25 . dm . rotdir $ scalp cr
|
||||
, tr . dm . rotmdir $ feet cr
|
||||
, tr . dm . rotdir $ upperBody col cr
|
||||
]
|
||||
where
|
||||
dm = damageModSH cr
|
||||
@@ -66,9 +67,8 @@ basicCrShape col cr w = mconcat
|
||||
f invid it = fmap ((\g -> g invid it cr w) . snd) (it ^? itTargeting . _Just)
|
||||
tr = uncurryV translateSHf (_crPos cr)
|
||||
rotdir = rotateSH (_crDir cr)
|
||||
rotmdir = rotate (_crMvDir cr)
|
||||
. setDepth 1
|
||||
. color (greyN 0.3)
|
||||
rotmdir = rotateSH (_crMvDir cr)
|
||||
. colorSH (greyN 0.3)
|
||||
|
||||
creatureDisplayText :: World -> Creature -> Picture
|
||||
creatureDisplayText w cr
|
||||
@@ -131,39 +131,41 @@ damageMod cr pic = piercingMod $ bluntScale pic
|
||||
damageModSH :: Creature -> Shape -> Shape
|
||||
damageModSH cr = id
|
||||
|
||||
feet :: Creature -> Picture
|
||||
feet :: Creature -> Shape
|
||||
feet cr = case cr ^? crStance . carriage of
|
||||
Just (Walking sa LeftForward) -> pictures
|
||||
[ translate ( f sa) off aFoot
|
||||
, translate (-f sa) (-off) aFoot
|
||||
Just (Walking sa LeftForward) -> mconcat
|
||||
[ translateSHf ( f sa) off aFoot
|
||||
, translateSHf (-f sa) (-off) aFoot
|
||||
]
|
||||
Just (Walking sa RightForward) -> pictures
|
||||
[ translate (-f sa) off aFoot
|
||||
, translate ( f sa) (-off) aFoot
|
||||
Just (Walking sa RightForward) -> mconcat
|
||||
[ translateSHf (-f sa) off aFoot
|
||||
, translateSHf ( f sa) (-off) aFoot
|
||||
]
|
||||
_ -> pictures
|
||||
[ translate 0 off aFoot
|
||||
, translate 0 (-off) aFoot
|
||||
_ -> mconcat
|
||||
[ translateSHf 0 off aFoot
|
||||
, translateSHf 0 (-off) aFoot
|
||||
]
|
||||
where
|
||||
aFoot = circleSolid 4
|
||||
aFoot :: Shape
|
||||
aFoot = prismPoly 10 $ polyCirc 3 4
|
||||
off = 5
|
||||
sLen = _strideLength $ _crStance cr
|
||||
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
|
||||
|
||||
arms :: Creature -> Picture
|
||||
arms :: Creature -> Shape
|
||||
arms cr
|
||||
| oneH cr = shoulderH . translate 11 (-3) . rotate (-0.5) $ scale 1 1.5 aHand
|
||||
| twists cr = shoulderH . translate 0 (0.5* crad) . rotate (-1) $ pictures
|
||||
[ translate 12 4 aHand
|
||||
, translate 4 (-10) aHand
|
||||
| oneH cr = shoulderSH . translateSHf 11 (-3) . rotateSH (-0.5) $ scaleSH (V3 1 1.5 1) aHand
|
||||
| twists cr = shoulderSH . translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat
|
||||
[ translateSHf 12 4 aHand
|
||||
, translateSHf 4 (-10) aHand
|
||||
]
|
||||
| otherwise = case cr ^? crStance . carriage of
|
||||
Just (Walking sa LeftForward) -> waistH $ translate (-f sa) (-off) aHand
|
||||
Just (Walking sa RightForward) -> waistH $ translate (-f sa) off aHand
|
||||
_ -> blank
|
||||
Just (Walking sa LeftForward) -> waistSH $ translateSHf (-f sa) (-off) aHand
|
||||
Just (Walking sa RightForward) -> waistSH $ translateSHf (-f sa) off aHand
|
||||
_ -> emptySH
|
||||
where
|
||||
aHand = circleSolid 4
|
||||
aHand :: Shape
|
||||
aHand = translateSHz (-4) . prismPoly 4 $ polyCirc 3 4
|
||||
crad = _crRad cr
|
||||
off = 8
|
||||
sLen = _strideLength $ _crStance cr
|
||||
@@ -176,7 +178,7 @@ scalp cr
|
||||
| otherwise = translateSHf (0.25 * crad) 0 fhead
|
||||
|
||||
where
|
||||
fhead = colorSH (greyN 0.9) . prismPoly 5 . polyCirc $ crad * 0.5
|
||||
fhead = colorSH (greyN 0.9) . prismPoly 5 . polyCirc 3 $ crad * 0.5
|
||||
crad = _crRad cr
|
||||
|
||||
oneH :: Creature -> Bool
|
||||
@@ -189,28 +191,28 @@ twists cr = crIsAiming' cr && crIt ^? itAimStance == Just TwoHandTwist
|
||||
where
|
||||
crIt = _crInv cr IM.! _crInvSel cr
|
||||
|
||||
torso :: Creature -> Picture
|
||||
torso :: Creature -> Shape
|
||||
torso cr
|
||||
| oneH cr = rotate 0.5 $ pictures
|
||||
[ translate 0 3 . rotate (negate 0.2) $ aShoulder
|
||||
, translate 0 (negate 3) . rotate 0.2 $ aShoulder
|
||||
| oneH cr = rotateSH 0.5 $ mconcat
|
||||
[ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
|
||||
, translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
|
||||
]
|
||||
| twists cr = translate 0 (0.5* crad) . rotate (-1) $ pictures
|
||||
[ rotate (negate 0.2) . translate 2 3 . rotate (negate 0.4) $ aShoulder
|
||||
, rotate (negate 0.2) . translate 0 (negate 3) . rotate 0.2 $ aShoulder
|
||||
| twists cr = translateSHf 0 (0.5* crad) . rotateSH (-1) $ mconcat
|
||||
[ rotateSH (negate 0.2) . translateSHf 2 3 . rotateSH (negate 0.4) $ aShoulder
|
||||
, rotateSH (negate 0.2) . translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
|
||||
]
|
||||
| otherwise = pictures
|
||||
[ translate 0 3 . rotate (negate 0.2) $ aShoulder
|
||||
, translate 0 (negate 3) . rotate 0.2 $ aShoulder
|
||||
| otherwise = mconcat
|
||||
[ translateSHf 0 3 . rotateSH (negate 0.2) $ aShoulder
|
||||
, translateSHf 0 (negate 3) . rotateSH 0.2 $ aShoulder
|
||||
]
|
||||
where
|
||||
aShoulder = scale 0.5 1 $ circleSolid crad
|
||||
aShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . prismPoly 10 $ polyCirc 3 crad
|
||||
crad = _crRad cr
|
||||
|
||||
upperBody :: Color -> Creature -> Picture
|
||||
upperBody col cr = color (light4 col) $ pictures
|
||||
upperBody :: Color -> Creature -> Shape
|
||||
upperBody col cr = colorSH (light4 col) $ mconcat
|
||||
[ arms cr
|
||||
, shoulderH $ torso cr
|
||||
, shoulderSH $ torso cr
|
||||
]
|
||||
|
||||
--naked :: Color -> Creature -> Picture
|
||||
@@ -229,6 +231,11 @@ shoulderH = setDepth 20
|
||||
waistH :: Picture -> Picture
|
||||
waistH = setDepth 10
|
||||
|
||||
shoulderSH :: Shape -> Shape
|
||||
shoulderSH = translateSHz 20
|
||||
waistSH :: Shape -> Shape
|
||||
waistSH = translateSHz 10
|
||||
|
||||
light4 :: Color -> Color
|
||||
light4 = light . light . light . light
|
||||
|
||||
@@ -243,20 +250,20 @@ light4 = light . light . light . light
|
||||
|
||||
drawEquipment
|
||||
:: Creature
|
||||
-> Picture
|
||||
drawEquipment cr = pictures $ map f $ IM.toList (_crInv cr)
|
||||
-> SPic
|
||||
drawEquipment cr = mconcat $ map f $ IM.toList (_crInv cr)
|
||||
where
|
||||
f (i,it) = case it ^? itEquipPict of
|
||||
Just g -> g cr i
|
||||
_ -> blank
|
||||
_ -> emptyBlank
|
||||
|
||||
circLine :: Float -> Picture
|
||||
circLine x = line [V2 0 0,V2 x 0]
|
||||
|
||||
picAtCrPos :: Picture -> Creature -> World -> SPic
|
||||
--{-# INLINE picAtCrPos #-}
|
||||
picAtCrPos thePic cr _ = SPic empty $ tranRot (_crPos cr) (_crDir cr) thePic
|
||||
picAtCrPos thePic cr _ = SPic emptySH $ tranRot (_crPos cr) (_crDir cr) thePic
|
||||
|
||||
picAtCrPosNoRot :: Picture -> Creature -> World -> SPic
|
||||
--{-# INLINE picAtCrPos #-}
|
||||
picAtCrPosNoRot thePic cr _ = SPic empty $ uncurryV translate (_crPos cr) thePic
|
||||
picAtCrPosNoRot thePic cr _ = SPic emptySH $ uncurryV translate (_crPos cr) thePic
|
||||
|
||||
Reference in New Issue
Block a user