Refactor, try to limit dependencies
This commit is contained in:
@@ -1,85 +1,129 @@
|
||||
module Dodge.Placement.Instance.Button where
|
||||
import Dodge.Data
|
||||
import Dodge.LightSource
|
||||
|
||||
import Color
|
||||
import Geometry
|
||||
import Control.Lens
|
||||
import Data.Maybe
|
||||
import Dodge.Data.GenWorld
|
||||
import Dodge.LevelGen.Data
|
||||
import Dodge.LevelGen.Switch
|
||||
import Dodge.LightSource
|
||||
import Dodge.Placement.Instance.LightSource
|
||||
import Dodge.PlacementSpot
|
||||
|
||||
import Data.Maybe
|
||||
import Control.Lens
|
||||
import Geometry
|
||||
|
||||
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)
|
||||
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)
|
||||
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]
|
||||
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)
|
||||
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
|
||||
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)
|
||||
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 = MdTrigIf (MdSetLSCol (V3 0 0.5 0)) (MdSetLSCol (V3 0.5 0 0))
|
||||
}
|
||||
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 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
|
||||
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
|
||||
|
||||
Reference in New Issue
Block a user