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

Prop reification/splitting

Browse Source
This commit is contained in:
justin
2022-07-24 13:45:05 +01:00
parent 5a2f529182
commit ac069d08f6
31 changed files with 585 additions and 458 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/LightSource/Cover.hs
+14 -64
View File
@@ -1,85 +1,35 @@
module Dodge.Placement.Instance.LightSource.Cover where
import Dodge.Data
import Dodge.Base
import Geometry.Data
import ShapePicture
import Shape
import Geometry
import Dodge.Default.Prop
import Control.Lens
lampCover :: Float -> Prop
lampCover h = ShapeProp
{ _prPos = V2 0 0
, _pjID = 0
, _pjRot = 0
, _pjUpdate = rotateProp 0.15
, _prDraw = drawLampCover h
, _prID = 0
, _prRot = 0
, _prUpdate = PropRotate 0.15
, _prDraw = PropLampCover h
, _prToggle = True
}
lampCoverWhen :: (World -> Bool) -> Point2 -> Float -> Prop
lampCoverWhen cond pos h = defaultShapeProp
lampCoverWhen :: WdBl -> Point2 -> Float -> Prop
lampCoverWhen cond pos h = defaultProp
{ _prPos = pos
, _pjUpdate = setToggle cond `dbArgChain` rotateProp 0.15
, _prDraw = drawLampCover h
, _prUpdate = PropSetToggleAnd cond (PropRotate 0.15)
, _prDraw = PropLampCover h
, _prToggle = True
}
doubleLampCover :: Float -> Prop
doubleLampCover h = defaultShapeProp
doubleLampCover h = defaultProp
{ _prPos = V2 0 0
, _pjUpdate = rotateProp 0.15
, _prDraw = drawDoubleLampCover h
, _prUpdate = PropRotate 0.15
, _prDraw = PropDoubleLampCover h
}
-- on the current (27/9/21) version of shadow stencilling, this glitches
-- slightly when the shadow rotates towards the screen
verticalLampCover :: Float -> Prop
verticalLampCover h = defaultShapeProp
{ _pjUpdate = rotateProp 0.15
, _prDraw = drawVerticalLampCover h
verticalLampCover h = defaultProp
{ _prUpdate = PropRotate 0.15
, _prDraw = PropVerticalLampCover h
}
rotateProp :: Float -> Prop -> World -> World
rotateProp rotAmount pr w = w
& props . ix (_pjID pr) . pjRot +~ rotAmount
setToggle :: (World -> Bool) -> Prop -> World -> World
setToggle cond pr w = w & props . ix (_pjID pr) . prToggle .~ cond w
drawLampCover :: Float -> Prop -> SPic
drawLampCover h pr
| not (_prToggle pr) = mempty
| otherwise = ( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH (_pjRot 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
)
drawDoubleLampCover :: Float -> Prop -> SPic
drawDoubleLampCover h pr =
( translateSHz (h-2.5) . uncurryV translateSHf (_prPos pr)
$ rotateSH (_pjRot 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
)
drawVerticalLampCover :: Float -> Prop -> SPic
drawVerticalLampCover h pr =
( translateSHz h . uncurryV translateSHf (_prPos pr)
$ rotateSHx (_pjRot pr) $ mconcat
[
translateSHz (-3) . upperPrismPoly 1 $ reverse $ rectNSWE 2 (-2) (-5) 5
]
, mempty
)