diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index 1cfa8e31a..43d993a1b 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -176,7 +176,7 @@ data World = World , _magnets :: IM.IntMap Magnet , _blocks :: IM.IntMap Block , _coordinates :: IM.IntMap Point2 - , _triggers :: IM.IntMap (World -> Bool) + , _triggers :: IM.IntMap Bool , _wlZoning :: Zoning IM.IntMap Wall , _floorItems :: IM.IntMap FloorItem , _floorTiles :: [(Point3,Point3)] @@ -847,7 +847,7 @@ data Terminal = Terminal } data TerminalToggle = TerminalToggle { _ttTriggerID :: Int - , _ttDeathEffect :: (World -> Bool) -> (World -> Bool) + , _ttDeathEffect :: Bool -> Bool } data Machine = Machine { _mcID :: Int @@ -1213,7 +1213,7 @@ data PSType = PutCrit {_unPutCrit :: Creature} | PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2] } | PutCoord Point2 | PutMod Modification - | PutTrigger (World -> Bool) + | PutTrigger Bool | PutLineBlock {_putWall :: Wall , _putWidth :: Float , _putStartPoint :: Point2, _putEndPoint :: Point2} | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } diff --git a/src/Dodge/Machine/Update.hs b/src/Dodge/Machine/Update.hs index c728ce86b..d82aaebec 100644 --- a/src/Dodge/Machine/Update.hs +++ b/src/Dodge/Machine/Update.hs @@ -103,7 +103,7 @@ mcSensorTriggerUpdate :: Machine -> World -> World mcSensorTriggerUpdate mc = fromMaybe id $ do trid <- mc ^? mcMounts . ix ObTrigger bval <- mcTriggerVal mc - return $ triggers . ix trid .~ const bval + return $ triggers . ix trid .~ bval mcTriggerVal :: Machine -> Maybe Bool mcTriggerVal mc = case mc ^. mcSensor of diff --git a/src/Dodge/Placement/Instance/Button.hs b/src/Dodge/Placement/Instance/Button.hs index 7c721b575..0c6c75f07 100644 --- a/src/Dodge/Placement/Instance/Button.hs +++ b/src/Dodge/Placement/Instance/Button.hs @@ -15,16 +15,16 @@ import Control.Lens import qualified Data.IntMap.Strict as IM triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement -triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger (const False)) +triggerSwitchSPic sdraw ps = psPtCont ps (PutTrigger 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 + oneff tid = triggers . ix tid .~ True + offeff tid = triggers . ix tid .~ False triggerSwitchSPicLight :: (Button -> SPic) -> PlacementSpot -> Placement -triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const False)) +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))) @@ -32,19 +32,19 @@ triggerSwitchSPicLight sdraw ps = psPtCont ps (PutTrigger (const False)) 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) + eff lsid tid b c = (triggers . ix tid .~ 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)) +triggerSwitch col ps = psPtCont ps (PutTrigger 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 + oneff tid = triggers . ix tid .~ True + offeff tid = triggers . ix tid .~ False putLitButOnPos :: Color -> PlacementSpot @@ -59,7 +59,7 @@ putLitButOnPos col theps subpl -- creates a lit external trigger, passes the trigger placement forward extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement -extTrigLitPos ps f = psPtCont ps (PutTrigger (const False)) +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) @@ -69,7 +69,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False)) {_mdID = 0 ,_mdExternalID1 = lsid ,_mdExternalID2 = fromJust $ _plMID tp - ,_mdUpdate = \md w -> if (_triggers w IM.! _mdExternalID2 md) w + ,_mdUpdate = \md w -> if (_triggers w IM.! _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 } @@ -83,7 +83,7 @@ putLitButOnPosExtTrig' :: Color -> (Placement -> Placement -> Placement -> Maybe Placement) -> Placement putLitButOnPosExtTrig' col thePS cnt - = psPtCont thePS (PutTrigger (const False)) + = psPtCont thePS (PutTrigger False) $ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40) $ \plmnt -> jps0' (PutButton (makeButton col (changeLight (fromJust $ _plMID plmnt) . oneff (trigid tp))) @@ -91,6 +91,6 @@ putLitButOnPosExtTrig' col thePS cnt (cnt tp plmnt) <&> plSpot .~ _plSpot plmnt where trigid tp = fromJust $ _plMID tp - oneff tid = triggers . ix tid .~ const True + oneff tid = triggers . ix tid .~ True changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0 ls = lsRadCol 75 (V3 0.5 0 0) diff --git a/src/Dodge/Room/Door.hs b/src/Dodge/Room/Door.hs index 3c286a5ee..2c3d88ef5 100644 --- a/src/Dodge/Room/Door.hs +++ b/src/Dodge/Room/Door.hs @@ -11,8 +11,7 @@ import Color import Data.Maybe import qualified Data.IntMap.Strict as IM ---import Dodge.LevelGen.Data -import Control.Lens +--import Control.Lens door :: Room door = defaultRoom @@ -42,4 +41,4 @@ triggerDoorRoom inplid = defaultRoom where f (pmnt:_) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2 f _ = error "tried to put a door using an empty placement list" - cond pmnt w = w & _triggers w IM.! fromJust (_plMID pmnt) + cond pmnt w = _triggers w IM.! fromJust (_plMID pmnt) diff --git a/src/Dodge/Room/Warning.hs b/src/Dodge/Room/Warning.hs index f8af3a6fe..f654575eb 100644 --- a/src/Dodge/Room/Warning.hs +++ b/src/Dodge/Room/Warning.hs @@ -44,7 +44,7 @@ addWarningTerminal str outplid = (rmName .++~ "warningTerm-") termMessages trpl = lineOutputTerminal (makeColorTermLine red "WARNING":makeTermPara str) & tmScrollCommands .:~ toggleCommand & tmToggles .~ M.fromList - [("DOOR",TerminalToggle (fromJust $ _plMID trpl) (const (const True)))] + [("DOOR",TerminalToggle (fromJust $ _plMID trpl) (const True))] moveToSideFirstOutLink :: RoomPos -> Room -> Maybe (Point2,Float) moveToSideFirstOutLink rp rm = case rp ^? rpLinkStatus . rplsChildNum of diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 03bdad502..726c7544f 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -78,7 +78,7 @@ toggleCommand = TerminalCommand togglesToEffects :: Terminal -> M.Map String [TerminalLine] togglesToEffects = fmap f . _tmToggles where - f tt = [TerminalLineEffect 0 $ \_ -> triggers . ix (_ttTriggerID tt) %~ fmap not] + f tt = [TerminalLineEffect 0 $ \_ -> triggers . ix (_ttTriggerID tt) %~ not] helpCommand :: TerminalCommand helpCommand = TerminalCommand @@ -251,7 +251,7 @@ doDeathTriggers tm w = w & triggers %~ flip (foldl' $ flip doDeathToggle) xs where xs = M.elems $ _tmToggles tm -doDeathToggle :: TerminalToggle -> IM.IntMap (World -> Bool) -> IM.IntMap (World -> Bool) +doDeathToggle :: TerminalToggle -> IM.IntMap Bool -> IM.IntMap Bool doDeathToggle (TerminalToggle trid f) = ix trid %~ f connectionBlurb :: [TerminalLine]