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

Allow shadow fidelity option, fix bug in rendering box shadows

Browse Source
This commit is contained in:
justin
2023-03-25 17:22:58 +00:00
parent cdc4a84d4b
commit d989acd6f2
26 changed files with 410 additions and 258 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Creature/Picture.hs
+27 -26
View File
@@ -68,35 +68,36 @@ feet cr = case cr ^? crStance . carriage of
]
where
aFoot :: Shape
aFoot = upperPrismPoly 10 $ polyCirc 3 4
aFoot = upperPrismPolyST 10 $ polyCirc 3 4
off = 5
sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
deadFeet :: Creature -> Shape
{-# INLINE deadFeet #-}
deadFeet cr = case cr ^? crStance . carriage of
Just (Walking sa LeftForward) ->
mconcat
[ translateSHxy (f sa) off aFoot
, translateSHxy (- f sa) (- off) aFoot
]
Just (Walking sa RightForward) ->
mconcat
[ translateSHxy (- f sa) off aFoot
, translateSHxy (f sa) (- off) aFoot
]
_ ->
mconcat
[ translateSHxy 0 off aFoot
, translateSHxy 0 (- off) aFoot
]
where
aFoot :: Shape
aFoot = upperPrismPoly 3 $ polyCirc 3 4
off = 5
sLen = _strideLength $ _crStance cr
f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
deadFeet = feet
--cr = case cr ^? crStance . carriage of
-- Just (Walking sa LeftForward) ->
-- mconcat
-- [ translateSHxy (f sa) off aFoot
-- , translateSHxy (- f sa) (- off) aFoot
-- ]
-- Just (Walking sa RightForward) ->
-- mconcat
-- [ translateSHxy (- f sa) off aFoot
-- , translateSHxy (f sa) (- off) aFoot
-- ]
-- _ ->
-- mconcat
-- [ translateSHxy 0 off aFoot
-- , translateSHxy 0 (- off) aFoot
-- ]
-- where
-- aFoot :: Shape
-- aFoot = upperPrismPolyT 3 $ polyCirc 3 4
-- off = 5
-- sLen = _strideLength $ _crStance cr
-- f i = 6 * fromIntegral (sLen - i) / fromIntegral sLen
arms :: Creature -> Shape
{-# INLINE arms #-}
@@ -105,7 +106,7 @@ arms cr =
translateToRightHand cr aHand
<> translateToLeftHand cr aHand
where
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalf 4 $ polyCirc 3 4
aHand = noPic $ translateSHz (-4) . upperPrismPolyHalfST 4 $ polyCirc 3 4
deadScalp :: Creature -> Shape
deadScalp cr = deadRot cr . translateSHz 10 . scalp $ cr
@@ -126,7 +127,7 @@ scalp cr
| oneH cr = rotateSH 0.5 $ translateSHxy 2.5 0 fhead
| otherwise = translateSHxy 2.5 0 fhead
where
fhead = colorSH (greyN 0.9) . upperPrismPolyHalf 5 $ polyCirc 3 5
fhead = colorSH (greyN 0.9) . upperPrismPolyHalfST 5 $ polyCirc 3 5
torso :: Creature -> Shape
{-# INLINE torso #-}
@@ -156,7 +157,7 @@ deadUpperBody cr = deadRot cr . translateSHz (negate 10) . upperBody $ cr
baseShoulder :: Shape
{-# INLINE baseShoulder #-}
baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalf 10 $ polyCirc 3 1
baseShoulder = translateSHz (-10) . scaleSH (V3 0.5 1 1) . upperPrismPolyHalfMI 10 $ polyCirc 3 1
upperBody :: Creature -> Shape
{-# INLINE upperBody #-}