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

Refactor light sources

Browse Source
This commit is contained in:
justin
2021-11-28 16:53:26 +00:00
parent 1d9dd3e4e0
commit 618653a86e
28 changed files with 169 additions and 155 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Button.hs
+13 -11
View File
@@ -1,5 +1,6 @@
module Dodge.Placement.Instance.Button where
import Dodge.Data
import Dodge.LightSource
import Color
import Geometry
import Geometry.Vector3D
@@ -30,10 +31,10 @@ triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const False))
$ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
(const Nothing)
where
thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75}
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
trigid tp = fromJust $ _plMID tp
eff lsid tid b c = (triggers . ix tid .~ const b)
. (lightSources . ix lsid . lsIntensity .~ c)
. (lightSources . ix lsid . lsParam . lsCol .~ c)
oneff lsid tid = eff lsid tid True (V3 0 0.5 0)
offeff lsid tid = eff lsid tid False (V3 0.5 0 0)
@@ -54,8 +55,8 @@ putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
where
p' = p -.- 30 *.* vNormal (unitVectorAtAngle a)
p'' = p +.+ 10 *.* vNormal (unitVectorAtAngle a)
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
ls = lsRadCol 75 (V3 0.5 0 0)
putLitButOnPos :: Color
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
@@ -66,10 +67,11 @@ putLitButOnPos col f subpl
in jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
subpl <&> plSpot .~ _plSpot plmnt
where
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
ls = lsRadCol 75 (V3 0.5 0 0)
thePS = PSPos f (const id) Nothing
-- creates a lit external trigger, passes the trigger placement forward
extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement
extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
@@ -83,10 +85,10 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
,_mdExternalID1 = lsid
,_mdExternalID2 = fromJust $ _plMID tp
,_mdUpdate = \md w -> if (_triggers w IM.! _mdExternalID2 md) w
then w & lightSources . ix (_mdExternalID1 md) . lsIntensity .~ V3 0 0.5 0
else w & lightSources . ix (_mdExternalID1 md) . lsIntensity .~ V3 0.5 0 0
then w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0 0.5 0
else w & lightSources . ix (_mdExternalID1 md) . lsParam . lsCol .~ V3 0.5 0 0
}
thels = defaultLS {_lsIntensity = V3 0.5 0 0, _lsPos = V3 0 0 78, _lsRad = 75}
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
putLitButOnPosExtTrig :: Color
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
@@ -101,6 +103,6 @@ putLitButOnPosExtTrig col f
where
trigid tp = fromJust $ _plMID tp
oneff tid = triggers . ix tid .~ const True
changeLight lsid = lightSources . ix lsid . lsIntensity .~ V3 0 0.5 0
ls = defaultLS { _lsRad = 75 , _lsIntensity = V3 0.5 0 0 }
changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
ls = lsRadCol 75 (V3 0.5 0 0)
thePS = PSPos f (const id) Nothing
src/Dodge/Placement/Instance/LightSource.hs
+4 -4
View File
@@ -21,7 +21,7 @@ mntLSOn
-> LightSource -> Point2 -> Point3 -> (Placement -> Maybe Placement) -> Placement
mntLSOn shapeF mcol ls wallp lsp@(V3 lx ly _)
= ps0jPushPS (PutShape . setCol $ shapeF wallp lsp)
. pt0 (PutLS $ ls {_lsPos = lsp'})
. pt0 (PutLS $ ls & lsParam . lsPos .~ lsp')
where
lsp' = lsp -.-.- V3 x y 1
-- hack! perturb the light position
@@ -105,7 +105,7 @@ unusedLnkToPS rp _ = case rp of
_ -> Nothing
spanLSLightI :: LightSource -> Float -> Point2 -> Point2 -> Placement
spanLSLightI ls h a b = ps0j (PutLS ls {_lsPos = V3 x y h})
spanLSLightI ls h a b = ps0j (PutLS $ ls & lsParam . lsPos .~ V3 x y h)
$ sps0 $ PutShape $ thinHighBar h a b
where
V2 x y = 0.5 *.* (a +.+ b)
@@ -114,11 +114,11 @@ spanLS :: LightSource -> Point2 -> Point2 -> Placement
spanLS ls a b = Placement (PS (V2 x y) 0) (PutLS ls) Nothing
$ const $ Just $ sps0 $ PutShape $ thinHighBar h a b
where
V3 _ _ h = _lsPos ls + 5
V3 _ _ h = _lsPos (_lsParam ls) + 5
V2 x y = 0.5 *.* (a +.+ b)
spanColLightI :: Point3 -> Float -> Point2 -> Point2 -> Placement
spanColLightI col h a b = ps0j (PutLS $ colorLightAt col (V3 x y (h-5)) 0)
spanColLightI col h a b = ps0j (PutLS $ lsColPos col (V3 x y (h-5)))
$ sps0 $ PutShape $ thinHighBar h a b
where
V2 x y = 0.5 *.* (a +.+ b)
src/Dodge/Placement/Instance/LightSource/Flicker.hs
+2 -2
View File
@@ -19,12 +19,12 @@ flickerMod pl = Just $ sps0 $ PutMod $ ModIDTimerPoint3Bool
flickerUpdate :: Modification -> World -> World
flickerUpdate md w
| _mdTimer md > 0 = w & modifications . ix mdid . mdTimer -~ 1
| otherwise = w & lightSources . ix lsid . lsIntensity .~ mdcol
| otherwise = w & lightSources . ix lsid . lsParam . lsCol .~ mdcol
& modifications . ix mdid
%~ ( (mdTimer .~ newtime) . (mdPoint3 .~ lscol) . (mdBool %~ not) )
where
mdcol = _mdPoint3 md
lscol = _lsIntensity $ _lightSources w IM.! lsid
lscol = _lsCol $ _lsParam $ _lightSources w IM.! lsid
lsid = _mdExternalID md
mdid = _mdID md
timerange
src/Dodge/Placement/Instance/Sensor.hs
+3 -2
View File
@@ -2,6 +2,7 @@ module Dodge.Placement.Instance.Sensor
( lightSensor
) where
import Color
import Dodge.LightSource
import Dodge.Data
import Dodge.LevelGen.Data
import Dodge.Default
@@ -24,7 +25,7 @@ damageSensor damF wdth upf ps = pContID ps ( PutLS theLS)
, _mcLSs = [lsid]
}
where
theLS = defaultLS { _lsPos = V3 0 0 30 , _lsIntensity = 0.1 }
theLS = lsPosCol (V3 0 0 30) (0.1)
lightSensor :: Float -> (Machine -> World -> World) -> PlacementSpot -> Placement
lightSensor = damageSensor senseLasering
@@ -46,7 +47,7 @@ sensorUpdate damF mc w = w & machines . ix mcid %~ upmc
(senseData,dam) = partitionEithers $ map damF $ _mcDamage mc
newSense = sum senseData
ni = fromIntegral x / 1000
upls = lsIntensity .~ V3 ni ni ni
upls = lsParam . lsCol .~ V3 ni ni ni
sensorSPic :: Float -> Machine -> SPic
sensorSPic wdth _ = ( colorSH yellow $ upperPrismPoly 25 (square wdth)