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

Refactor, try to limit dependencies

Browse Source
This commit is contained in:
justin
2022-07-28 00:59:56 +01:00
parent 8aa5c17ab9
commit 160560af5f
418 changed files with 15104 additions and 13342 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Prop/Draw.hs
+50 -43
View File
@@ -1,12 +1,12 @@
module Dodge.Prop.Draw
where
import Geometry.Polygon
import Geometry.Data
module Dodge.Prop.Draw where
import Dodge.Data.Prop
import ShapePicture
import Shape
import Geometry.Data
import Geometry.Polygon
import Picture
import qualified Quaternion as Q
import Shape
import ShapePicture
drawProp' :: Prop -> SPic
drawProp' pr = drawProp (_prDraw pr) pr
@@ -21,18 +21,20 @@ drawProp pd = case pd of
PropLampCover h -> drawLampCover h
PropDrawToggle pd' -> propDrawToggle pd'
PropDrawGib x -> noPic . drawGib x
PropDrawFlatTranslate x -> \pr
-> uncurryV translateSPf (_prPos pr) $ rotateSP (_prRot pr) $ drawProp x pr
PropDrawFlatTranslate x -> \pr ->
uncurryV translateSPf (_prPos pr) $ rotateSP (_prRot pr) $ drawProp x pr
drawGib :: Float -> Prop -> Shape
drawGib x pr = flesh <> skin
where
flesh = colorSH (dark $ dark red)
. translateSHz (negate x)
$ upperPrismPoly (2*x) $ square x
skin = colorSH (_prColor pr)
. translateSH (V3 1 1 (1 - x))
$ upperPrismPoly (2*x) $ square x
flesh =
colorSH (dark $ dark red)
. translateSHz (negate x)
$ upperPrismPoly (2 * x) $ square x
skin =
colorSH (_prColor pr)
. translateSH (V3 1 1 (1 - x))
$ upperPrismPoly (2 * x) $ square x
propDrawToggle :: PropDraw -> Prop -> SPic
propDrawToggle pd pr
@@ -40,48 +42,53 @@ propDrawToggle pd pr
| otherwise = drawProp pd pr
drawLampCover :: Float -> Prop -> SPic
drawLampCover h pr = ( translateSHz (h-2.5) . uncurryV translateSHf (_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)]
]
drawLampCover h pr =
( translateSHz (h -2.5) . uncurryV translateSHf (_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)]
]
, mempty
)
drawVerticalLampCover :: Float -> Prop -> SPic
drawVerticalLampCover h pr =
( translateSHz h . uncurryV translateSHf (_prPos pr)
$ rotateSHx (_prRot pr) $ mconcat
[
translateSHz (-3) . upperPrismPoly 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
]
( translateSHz h . uncurryV translateSHf (_prPos pr) $
rotateSHx (_prRot pr) $
mconcat
[ translateSHz (-3) . upperPrismPoly 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
]
, mempty
)
drawMovingShape :: Prop -> Shape -> SPic
drawMovingShape pr = noPic
. translateSHz (_prPosZ pr)
. uncurryV translateSHf (_prPos pr)
. overPosSH (Q.rotate (_prQuat pr))
drawMovingShape pr =
noPic
. translateSHz (_prPosZ pr)
. uncurryV translateSHf (_prPos pr)
. overPosSH (Q.rotate (_prQuat pr))
drawMovingShapeCol :: Prop -> Shape -> SPic
drawMovingShapeCol pr = noPic
. translateSHz (_prPosZ pr)
. uncurryV translateSHf (_prPos pr)
. overPosSH (Q.rotate (_prQuat pr))
. colorSH (_prColor pr)
drawMovingShapeCol pr =
noPic
. translateSHz (_prPosZ pr)
. uncurryV translateSHf (_prPos pr)
. overPosSH (Q.rotate (_prQuat pr))
. colorSH (_prColor pr)
drawDoubleLampCover :: Float -> Prop -> SPic
drawDoubleLampCover h pr =
( translateSHz (h-2.5) . uncurryV translateSHf (_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)]
]
( translateSHz (h -2.5) . uncurryV translateSHf (_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)]
]
, mempty
)