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/Prop/Draw.hs
+17 -14
View File
@@ -7,6 +7,7 @@ import Picture
import qualified Quaternion as Q
import Shape
import ShapePicture
import Control.Lens
drawProp' :: Prop -> SPic
drawProp' pr = drawProp (_prDraw pr) pr
@@ -29,12 +30,11 @@ drawGib x pr = flesh <> skin
where
flesh =
colorSH (dark $ dark red)
. translateSHz (negate x)
$ upperPrismPoly (2 * x) $ square x
$ translateSHz (negate x) (baseCube & each . sfShadowImportance .~ Superfluous)
skin =
colorSH (_prColor pr)
. translateSH (V3 1 1 (1 - x))
$ upperPrismPoly (2 * x) $ square x
$ translateSH (V3 1 1 (1 - x)) baseCube
baseCube = upperPrismPoly Small Typical (2 * x) $ square x
propDrawToggle :: PropDraw -> Prop -> SPic
propDrawToggle pd pr
@@ -46,21 +46,24 @@ drawLampCover h pr =
( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
rotateSH (_prRot pr) $
mconcat
[ translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 2 (-1) 3
, translateSHz 1 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2 3
, translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 2 (-1) 3
, translateSHz 2 . upperPrismPoly 1 . reverse $ rectNSWE 3 (-1) 2 3
, upperPrismPoly 1 [V2 2 2, V2 (-1) 2, V2 2 (-1)]
[ aface 1 2 (-1)
, aface 1 (-1) 2
, aface 2 2 (-1)
, aface 2 (-1) 2
, upperPrismPoly Small Essential 1 [V2 2 2, V2 (-1) 2, V2 2 (-1)]
]
, mempty
)
where
aface ztran s w = translateSHz ztran . upperPrismPoly Small Essential 1
. reverse $ rectNSWE 3 s w 3
drawVerticalLampCover :: Float -> Prop -> SPic
drawVerticalLampCover h pr =
( translateSHz h . uncurryV translateSHxy (_prPos pr) $
rotateSHx (_prRot pr) $
mconcat
[ translateSHz (-3) . upperPrismPoly 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
[ translateSHz (-3) . upperPrismPoly Small Essential 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
]
, mempty
)
@@ -85,10 +88,10 @@ drawDoubleLampCover h pr =
( translateSHz (h -2.5) . uncurryV translateSHxy (_prPos pr) $
rotateSH (_prRot pr) $
mconcat
[ upperPrismPoly 5 $ reverse $ rectNSWE 6 5 (-6) 6
, upperPrismPoly 5 $ reverse $ rectNSWE (-5) (-6) (-6) 6
, upperPrismPoly 1 [V2 0 (-1), V2 6 5, V2 (-6) 5]
, upperPrismPoly 1 [V2 0 1, V2 (-6) (-5), V2 6 (-5)]
[ upperPrismPoly Small Essential 5 $ reverse $ rectNSWE 6 5 (-6) 6
, upperPrismPoly Small Essential 5 $ reverse $ rectNSWE (-5) (-6) (-6) 6
, upperPrismPoly Small Essential 1 [V2 0 (-1), V2 6 5, V2 (-6) 5]
, upperPrismPoly Small Essential 1 [V2 0 1, V2 (-6) (-5), V2 6 (-5)]
]
, mempty
)