108 lines
4.5 KiB
Haskell
108 lines
4.5 KiB
Haskell
module Dodge.Placement.Instance.Button where
|
|
import Dodge.Data
|
|
import Dodge.LightSource
|
|
import Color
|
|
import Geometry
|
|
import Dodge.LevelGen.Data
|
|
--import Dodge.Default
|
|
import Dodge.LevelGen.Switch
|
|
import Dodge.Placement.Instance.LightSource
|
|
import Dodge.PlacementSpot
|
|
import ShapePicture
|
|
|
|
import Data.Maybe
|
|
import Control.Lens
|
|
import qualified Data.IntMap.Strict as IM
|
|
|
|
triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement
|
|
triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger (const False))
|
|
$ \tp -> Just $ pContID ps (PutButton (makeSwitchSPic sdraw (oneff $ trigid tp) (offeff $ trigid tp)))
|
|
(const Nothing)
|
|
where
|
|
trigid tp = fromJust $ _plMID tp
|
|
oneff tid = triggers . ix tid .~ const True
|
|
offeff tid = triggers . ix tid .~ const False
|
|
|
|
triggerSwitchSPicLight :: (Button -> SPic) -> PlacementSpot -> Placement
|
|
triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const 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
|
|
eff lsid tid b c = (triggers . ix tid .~ const b)
|
|
. (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)
|
|
|
|
triggerSwitch :: Color -> PlacementSpot -> Placement
|
|
triggerSwitch col ps = psPtCont ps (PutTrigger (const False))
|
|
$ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (oneff $ trigid tp) (offeff $ trigid tp)))
|
|
(const Nothing)
|
|
where
|
|
trigid tp = fromJust $ _plMID tp
|
|
oneff tid = triggers . ix tid .~ const True
|
|
offeff tid = triggers . ix tid .~ const False
|
|
|
|
putLitButtonID :: Color -> Point2 -> Float -> (Int -> Maybe Placement) -> Placement
|
|
putLitButtonID col p a subpl = mntLSOn aShape (Just col) ls p'' (addZ 40 p')
|
|
$ contToIDCont
|
|
$ \lsid -> jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = p, _btRot = a})
|
|
subpl
|
|
where
|
|
p' = p -.- 30 *.* vNormal (unitVectorAtAngle a)
|
|
p'' = p +.+ 10 *.* vNormal (unitVectorAtAngle a)
|
|
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))
|
|
-> (Int -> Maybe Placement) -> Placement
|
|
putLitButOnPos col f subpl
|
|
= plSpot .~ thePS $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
|
|
$ \plmnt -> let lsid = fromJust $ _plMID plmnt
|
|
in jps0 (PutButton (makeButton col (changeLight lsid)) {_btPos = V2 0 (-1), _btRot = pi})
|
|
subpl <&> plSpot .~ _plSpot plmnt
|
|
where
|
|
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))
|
|
$ \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 (_triggers w IM.! _mdExternalID2 md) w
|
|
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
|
|
-> (RoomPos -> Room -> Maybe (PlacementSpot,RoomPos))
|
|
-> Placement
|
|
putLitButOnPosExtTrig col f
|
|
= psPtCont thePS (PutTrigger (const False))
|
|
$ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
|
|
$ \plmnt -> let lsid = fromJust $ _plMID plmnt
|
|
in jps0 (PutButton (makeButton col (changeLight lsid . oneff (trigid tp)))
|
|
{_btPos = V2 0 (-1), _btRot = pi})
|
|
(const Nothing) <&> plSpot .~ _plSpot plmnt
|
|
where
|
|
trigid tp = fromJust $ _plMID tp
|
|
oneff tid = triggers . ix tid .~ const True
|
|
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
|