Reorganisation of light source placements and fittings

2021-11-17 12:04:03 +00:00
parent 602d91d3a8
commit bcdf0e643c
8 changed files with 149 additions and 137 deletions
@@ -0,0 +1,102 @@
+module Dodge.Placement.Instance.LightSource.Cover where
+import Dodge.Data
+import Dodge.Base
+import Geometry.Data
+import ShapePicture
+import Shape
+import Geometry
+
+import Control.Lens
+
+lampCover :: Float -> Prop
+lampCover h = ShapeProp
+    { _pjPos = V2 0 0
+    , _pjID  = 0
+    , _pjRot = 0
+    , _pjUpdate = rotateProp 0.15
+    , _prDraw = drawLampCover h
+    , _prToggle = True
+    }
+lampCoverWhen :: (World -> Bool) -> Point2 -> Float -> Prop
+lampCoverWhen cond pos h = ShapeProp
+    { _pjPos = pos
+    , _pjID  = 0
+    , _pjRot = 0
+    , _pjUpdate = setToggle cond `dbArgChain` rotateProp 0.15
+    , _prDraw = drawLampCover h
+    , _prToggle = True
+    }
+
+doubleLampCover :: Float -> Prop
+doubleLampCover h = ShapeProp
+    { _pjPos = V2 0 0
+    , _pjID  = 0
+    , _pjRot = 0
+    , _pjUpdate = rotateProp 0.15
+    , _prDraw = drawDoubleLampCover h
+    , _prToggle = True
+    }
+
+-- 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 = ShapeProp
+    { _pjPos = V2 0 0
+    , _pjID  = 0
+    , _pjRot = 0
+    , _pjUpdate = rotateProp 0.15
+    , _prDraw = drawVerticalLampCover h
+    , _prToggle = True
+    }
+
+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 pos 
+        $ rotateSH a $ mconcat
+        [ translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 2    3 (-1)
+        , translateSHz 1 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
+        , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 2    3 (-1)
+        , translateSHz 2 . upperPrismPoly 1 $ rectNSEW 3 (-1) 3 2
+        , upperPrismPoly 1 [V2 2 2,V2 (-1) 2,V2 2 (-1)]
+        ]
+    , mempty
+    )
+  where
+    a = _pjRot pr
+    pos = _pjPos pr
+
+drawDoubleLampCover :: Float -> Prop -> SPic
+drawDoubleLampCover h pr =
+    ( translateSHz (h-2.5) . uncurryV translateSHf pos 
+        $ rotateSH a $ mconcat
+        [ upperPrismPoly 5 $ rectNSEW 6 5       6 (-6)
+        , upperPrismPoly 5 $ rectNSEW (-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
+    )
+  where
+    a = _pjRot pr
+    pos = _pjPos pr
+
+drawVerticalLampCover :: Float -> Prop -> SPic
+drawVerticalLampCover h pr =
+    ( translateSHz h . uncurryV translateSHf pos 
+        $ rotateSHx a $ mconcat
+        [ 
+        translateSHz (-3) . upperPrismPoly 1 $ rectNSEW 2 (-2) 5 (-5)
+        ]
+    , mempty
+    )
+  where
+    a = _pjRot pr
+    pos = _pjPos pr
@@ -0,0 +1,33 @@
+module Dodge.Placement.Instance.LightSource.Flicker where
+import Dodge.LevelGen.Data
+import Dodge.Data
+import qualified Data.IntMap.Strict as IM
+import Data.Maybe
+import Control.Lens
+import System.Random
+-- Supposes the orginal placement is a light source, adds a flicker
+flickerMod :: Placement -> Maybe Placement
+flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool
+    { _mdID = 0
+    , _mdExternalID = fromJust $ _plMID pl
+    , _mdUpdate = flickerUpdate
+    , _mdTimer  = 10
+    , _mdPoint3  = 0.8
+    , _mdBool = True
+    }
+
+flickerUpdate :: Modification -> World -> World
+flickerUpdate md w 
+    | _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1
+    | otherwise = w & lightSources . ix lsid . lsIntensity .~ mdcol
+        & modifications . ix mdid 
+            %~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) )
+  where
+    mdcol = _mdPoint3 md
+    lscol = _lsIntensity $ _lightSources w IM.! lsid
+    lsid = _mdExternalID md
+    mdid = _mdID md
+    timerange 
+        | _mdBool md = (2,10)
+        | otherwise  = (2,30)
+    (newtime,_) = randomR timerange $ _randGen w