justin/loop
1
0
Fork 0
Code Issues Pull Requests 1 Packages Projects Releases Wiki Activity

Make world booleans (triggers) non-functional

Browse Source
This commit is contained in:
justin
2022-07-19 21:21:32 +01:00
parent 6b398b4bb6
commit 0edc1cfe11
6 changed files with 21 additions and 22 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Data.hs
+3 -3
View File
@@ -176,7 +176,7 @@ data World = World
, _magnets :: IM.IntMap Magnet , _magnets :: IM.IntMap Magnet
, _blocks :: IM.IntMap Block , _blocks :: IM.IntMap Block
, _coordinates :: IM.IntMap Point2 , _coordinates :: IM.IntMap Point2
, _triggers :: IM.IntMap (World -> Bool) , _triggers :: IM.IntMap Bool
, _wlZoning :: Zoning IM.IntMap Wall , _wlZoning :: Zoning IM.IntMap Wall
, _floorItems :: IM.IntMap FloorItem , _floorItems :: IM.IntMap FloorItem
, _floorTiles :: [(Point3,Point3)] , _floorTiles :: [(Point3,Point3)]
@@ -847,7 +847,7 @@ data Terminal = Terminal
} }
data TerminalToggle = TerminalToggle data TerminalToggle = TerminalToggle
{ _ttTriggerID :: Int { _ttTriggerID :: Int
, _ttDeathEffect :: (World -> Bool) -> (World -> Bool) , _ttDeathEffect :: Bool -> Bool
} }
data Machine = Machine data Machine = Machine
{ _mcID :: Int { _mcID :: Int
@@ -1213,7 +1213,7 @@ data PSType = PutCrit {_unPutCrit :: Creature}
| PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2] } | PutBlock {_putBlock :: Block, _putWall :: Wall, _putPoly :: [Point2] }
| PutCoord Point2 | PutCoord Point2
| PutMod Modification | PutMod Modification
| PutTrigger (World -> Bool) | PutTrigger Bool
| PutLineBlock {_putWall :: Wall , _putWidth :: Float | PutLineBlock {_putWall :: Wall , _putWidth :: Float
, _putStartPoint :: Point2, _putEndPoint :: Point2} , _putStartPoint :: Point2, _putEndPoint :: Point2}
| PutWall { _pwPoly :: [Point2] , _pwWall :: Wall } | PutWall { _pwPoly :: [Point2] , _pwWall :: Wall }
src/Dodge/Machine/Update.hs
+1 -1
View File
@@ -103,7 +103,7 @@ mcSensorTriggerUpdate :: Machine -> World -> World
mcSensorTriggerUpdate mc = fromMaybe id $ do mcSensorTriggerUpdate mc = fromMaybe id $ do
trid <- mc ^? mcMounts . ix ObTrigger trid <- mc ^? mcMounts . ix ObTrigger
bval <- mcTriggerVal mc bval <- mcTriggerVal mc
return $ triggers . ix trid .~ const bval return $ triggers . ix trid .~ bval
mcTriggerVal :: Machine -> Maybe Bool mcTriggerVal :: Machine -> Maybe Bool
mcTriggerVal mc = case mc ^. mcSensor of mcTriggerVal mc = case mc ^. mcSensor of
src/Dodge/Placement/Instance/Button.hs
+12 -12
View File
@@ -15,16 +15,16 @@ import Control.Lens
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
triggerSwitchSPic :: (Button -> SPic) -> PlacementSpot -> Placement 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))) $ \tp -> Just $ pContID ps (PutButton (makeSwitchSPic sdraw (oneff $ trigid tp) (offeff $ trigid tp)))
(const Nothing) (const Nothing)
where where
trigid tp = fromJust $ _plMID tp trigid tp = fromJust $ _plMID tp
oneff tid = triggers . ix tid .~ const True oneff tid = triggers . ix tid .~ True
offeff tid = triggers . ix tid .~ const False offeff tid = triggers . ix tid .~ False
triggerSwitchSPicLight :: (Button -> SPic) -> PlacementSpot -> Placement 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) $ \tp -> Just $ pContID atFstLnkOut (PutLS thels)
$ \lsid -> Just $ \lsid -> Just
$ pContID ps (PutButton (makeSwitchSPic sdraw (oneff lsid $ trigid tp) (offeff lsid $ trigid tp))) $ 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 where
thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75 thels = lsColPosRad (V3 0.5 0 0) (V3 0 0 78) 75
trigid tp = fromJust $ _plMID tp 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) . (lightSources . ix lsid . lsParam . lsCol .~ c)
oneff lsid tid = eff lsid tid True (V3 0 0.5 0) oneff lsid tid = eff lsid tid True (V3 0 0.5 0)
offeff lsid tid = eff lsid tid False (V3 0.5 0 0) offeff lsid tid = eff lsid tid False (V3 0.5 0 0)
triggerSwitch :: Color -> PlacementSpot -> Placement 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))) $ \tp -> Just $ pContID ps (PutButton (makeSwitch col col (oneff $ trigid tp) (offeff $ trigid tp)))
(const Nothing) (const Nothing)
where where
trigid tp = fromJust $ _plMID tp trigid tp = fromJust $ _plMID tp
oneff tid = triggers . ix tid .~ const True oneff tid = triggers . ix tid .~ True
offeff tid = triggers . ix tid .~ const False offeff tid = triggers . ix tid .~ False
putLitButOnPos :: Color putLitButOnPos :: Color
-> PlacementSpot -> PlacementSpot
@@ -59,7 +59,7 @@ putLitButOnPos col theps subpl
-- creates a lit external trigger, passes the trigger placement forward -- creates a lit external trigger, passes the trigger placement forward
extTrigLitPos :: PlacementSpot -> (Placement -> Maybe Placement) -> Placement 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) $ \tp -> Just $ pContID (ps' tp) (PutLS thels)
$ \lsid -> Just $ pContID (ps' tp) (PutMod $ themod lsid tp) $ \lsid -> Just $ pContID (ps' tp) (PutMod $ themod lsid tp)
$ const (f tp) $ const (f tp)
@@ -69,7 +69,7 @@ extTrigLitPos ps f = psPtCont ps (PutTrigger (const False))
{_mdID = 0 {_mdID = 0
,_mdExternalID1 = lsid ,_mdExternalID1 = lsid
,_mdExternalID2 = fromJust $ _plMID tp ,_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 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 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 -> Placement -> Placement -> Maybe Placement)
-> Placement -> Placement
putLitButOnPosExtTrig' col thePS cnt 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) $ \tp -> Just $ plSpot .~ _plSpot tp $ mntLSOn aShape (Just col) ls 0 (V3 0 (-40) 40)
$ \plmnt -> jps0' (PutButton $ \plmnt -> jps0' (PutButton
(makeButton col (changeLight (fromJust $ _plMID plmnt) . oneff (trigid tp))) (makeButton col (changeLight (fromJust $ _plMID plmnt) . oneff (trigid tp)))
@@ -91,6 +91,6 @@ putLitButOnPosExtTrig' col thePS cnt
(cnt tp plmnt) <&> plSpot .~ _plSpot plmnt (cnt tp plmnt) <&> plSpot .~ _plSpot plmnt
where where
trigid tp = fromJust $ _plMID tp 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 changeLight lsid = lightSources . ix lsid . lsParam . lsCol .~ V3 0 0.5 0
ls = lsRadCol 75 (V3 0.5 0 0) ls = lsRadCol 75 (V3 0.5 0 0)
src/Dodge/Room/Door.hs
+2 -3
View File
@@ -11,8 +11,7 @@ import Color
import Data.Maybe import Data.Maybe
import qualified Data.IntMap.Strict as IM import qualified Data.IntMap.Strict as IM
--import Dodge.LevelGen.Data --import Control.Lens
import Control.Lens
door :: Room door :: Room
door = defaultRoom door = defaultRoom
@@ -42,4 +41,4 @@ triggerDoorRoom inplid = defaultRoom
where where
f (pmnt:_) = putDoubleDoor DoorObstacle (switchWallCol red) (cond pmnt) (V2 0 20) (V2 40 20) 2 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" 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)
src/Dodge/Room/Warning.hs
+1 -1
View File
@@ -44,7 +44,7 @@ addWarningTerminal str outplid = (rmName .++~ "warningTerm-")
termMessages trpl = lineOutputTerminal (makeColorTermLine red "WARNING":makeTermPara str) termMessages trpl = lineOutputTerminal (makeColorTermLine red "WARNING":makeTermPara str)
& tmScrollCommands .:~ toggleCommand & tmScrollCommands .:~ toggleCommand
& tmToggles .~ M.fromList & 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 :: RoomPos -> Room -> Maybe (Point2,Float)
moveToSideFirstOutLink rp rm = case rp ^? rpLinkStatus . rplsChildNum of moveToSideFirstOutLink rp rm = case rp ^? rpLinkStatus . rplsChildNum of
src/Dodge/Terminal.hs
+2 -2
View File
@@ -78,7 +78,7 @@ toggleCommand = TerminalCommand
togglesToEffects :: Terminal -> M.Map String [TerminalLine] togglesToEffects :: Terminal -> M.Map String [TerminalLine]
togglesToEffects = fmap f . _tmToggles togglesToEffects = fmap f . _tmToggles
where where
f tt = [TerminalLineEffect 0 $ \_ -> triggers . ix (_ttTriggerID tt) %~ fmap not] f tt = [TerminalLineEffect 0 $ \_ -> triggers . ix (_ttTriggerID tt) %~ not]
helpCommand :: TerminalCommand helpCommand :: TerminalCommand
helpCommand = TerminalCommand helpCommand = TerminalCommand
@@ -251,7 +251,7 @@ doDeathTriggers tm w = w
& triggers %~ flip (foldl' $ flip doDeathToggle) xs & triggers %~ flip (foldl' $ flip doDeathToggle) xs
where where
xs = M.elems $ _tmToggles tm 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 doDeathToggle (TerminalToggle trid f) = ix trid %~ f
connectionBlurb :: [TerminalLine] connectionBlurb :: [TerminalLine]