Files
loop/src/Dodge/Placement/Instance/Button.hs
T
2022-07-21 18:26:48 +01:00

90 lines
3.6 KiB
Haskell

module Dodge.Placement.Instance.Button where
import Dodge.Data
import Dodge.LightSource
import Color
import Geometry
import Dodge.LevelGen.Data
import Dodge.LevelGen.Switch
import Dodge.Placement.Instance.LightSource
import Dodge.PlacementSpot
import Data.Maybe
import Control.Lens
triggerSwitchSPic :: ButtonDraw -> PlacementSpot -> Placement
triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger False)
$ \tp -> Just $ pContID ps (PutButton (makeSwitchSPic sdraw (SetTrigger True $ trigid tp)
(SetTrigger False $ trigid tp)))
(const Nothing)
where
trigid tp = fromJust $ _plMID tp
triggerSwitchSPicLight :: ButtonDraw -> PlacementSpot -> Placement
triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger False)
$ \tp -> Just $ pContID atFstLnkOut (PutLS thels)
$ \lsid -> Just
$ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp)))
(const Nothing)
where
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
trigid tp = fromJust $ _plMID tp
oneff lsid tid = WorldEffects [SetLSCol (V3 0 0.5 0) lsid, SetTrigger True tid]
offeff lsid tid = WorldEffects [SetLSCol (V3 0.5 0 0) lsid, SetTrigger False tid]
triggerSwitch :: Color -> PlacementSpot -> Placement
triggerSwitch col ps = psPtCont ps (PutTrigger False)
$ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (SetTrigger True $ trigid tp)
(SetTrigger False $ trigid tp)))
(const Nothing)
where
trigid tp = fromJust $ _plMID tp
putLitButOnPos :: Color
-> PlacementSpot
-> (Placement -> Maybe Placement) -> Placement
putLitButOnPos col theps subpl
= plSpot .~ theps $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
$ \plmnt -> jps0' (PutButton (makeButton col (changeLight . fromJust $ _plMID plmnt)) {_btPos = V2 0 (-1), _btRot = pi})
subpl <&> plSpot .~ _plSpot plmnt
where
changeLight lsid = SetLSCol (V3 0 0.5 0) lsid
ls = lsRadCol 75 (V3 0.5 0 0)
-- creates a lit external trigger, passes the trigger placement forward
extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement
extTrigLitPos ps f = psPtCont ps (PutTrigger False)
$ \tp -> Just $ pContID (ps' tp) (PutLS thels)
$ \lsid -> Just $ pContID (ps' tp) (PutMod $ themod lsid tp)
$ const (f tp)
where
ps' tp = _plSpot tp
themod lsid tp = ModIDID
{_mdID = 0
,_mdExternalID1 = lsid
,_mdExternalID2 = fromJust $ _plMID tp
,_mdUpdate = \md w -> if w ^?! triggers . ix (_mdExternalID2 md)
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 = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
putLitButOnPosExtTrig :: Color -> PlacementSpot -> Placement
putLitButOnPosExtTrig col thePS = putLitButOnPosExtTrig' col thePS (const . const . const Nothing)
putLitButOnPosExtTrig' :: Color
-> PlacementSpot
-> (Placement -> Placement -> Placement -> Maybe Placement)
-> Placement
putLitButOnPosExtTrig' col thePS cnt
= psPtCont thePS (PutTrigger False)
$ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
$ \plmnt -> jps0' (PutButton
(makeButton col (WorldEffects [changeLight (fromJust $ _plMID plmnt), oneff (trigid tp)]))
{_btPos = V2 0 (-1), _btRot = pi})
(cnt tp plmnt) <&> plSpot .~ _plSpot plmnt
where
trigid tp = fromJust $ _plMID tp
oneff tid = SetTrigger True tid
changeLight = SetLSCol (V3 0 0.5 0)
ls = lsRadCol 75 (V3 0.5 0 0)