Files
loop/src/Dodge/Placement/Instance/Button.hs
T
2026-03-30 09:29:50 +01:00

126 lines
4.5 KiB
Haskell

module Dodge.Placement.Instance.Button (
putLitButOnPos,
extTrigLitPos,
putLitButOnPosExtTrig,
) where
import Color
import Control.Lens
import Data.Maybe
import Dodge.Data.GenWorld
import Dodge.LevelGen.PlacementHelper
import Dodge.LevelGen.Switch
import Dodge.LightSource
import Dodge.Placement.Instance.LightSource
--import Dodge.PlacementSpot
import Geometry
import Shape
--triggerSwitchSPic :: Color -> Color -> PlacementSpot -> Placement
--triggerSwitchSPic c1 c2 ps = psPtCont ps (PutTrigger False) $
-- \tp ->
-- Just $
-- pContID
-- ps
-- ( PutButton
-- ( makeSwitch
-- c1
-- c2
-- (SetTrigger True $ trigid tp)
-- (SetTrigger False $ trigid tp)
-- )
-- )
-- (const Nothing)
-- where
-- trigid tp = fromJust $ _plMID tp
--
--triggerSwitchSPicLight :: Color -> Color -> PlacementSpot -> Placement
--triggerSwitchSPicLight c1 c2 ps = psPtCont ps (PutTrigger False) $
-- \tp -> Just $
-- pContID atFstLnkOut (PutLS thels) $
-- \lsid ->
-- Just $
-- pContID
-- ps
-- (PutButton (makeSwitch c1 c2 (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 shp ls 0 (V3 0 (-40) 40) $
\pmnt ->
jps0'
(PutButton (makeButton col (changeLight $ pmnt ^?! plMID . _Just) & btPos .~ V2 0 (-1) & btRot .~ pi))
subpl
<&> plSpot .~ _plSpot pmnt
where
shp = fmap (fmap $ colorSH col) aShape
changeLight = SetLSCol (V3 0 0.5 0)
ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50
-- 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 (_plSpot tp) (PutLS thels) $
\lsid ->
Just $
pContID (_plSpot tp) (PutMod $ themod lsid tp) $
const (f tp)
where
themod lsid tp =
ModIDID
{ _mdID = 0
, _mdExternalID1 = lsid
, _mdExternalID2 = fromJust $ _plMID tp
, _mdUpdate = MdTrigIf (MdSetLSCol (V3 0 0.5 0)) (MdSetLSCol (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 shp ls 0 (V3 0 (-40) 40) $
\plmnt ->
jps0'
( PutButton
(makeButton col (buteff (trigid tp) (fromJust $ _plMID plmnt)))
{ _btPos = V2 0 (-1)
, _btRot = pi
}
)
(cnt tp plmnt)
<&> plSpot
.~ _plSpot plmnt
where
buteff i = SetTriggerAndSetLSCol True i (V3 0 0.5 0)
shp = fmap (fmap $ colorSH col) aShape
trigid tp = fromJust $ _plMID tp
ls = lsColPosRad (V3 0.5 0 0) (V3 0 0 50) 50