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

Commit before removing "un-input-able" terminals

Browse Source
This commit is contained in:
justin
2022-06-06 18:33:44 +01:00
parent 4e181b8273
commit b20502bc35
6 changed files with 77 additions and 56 deletions
Download Patch File Download Diff File Expand all files Collapse all files
src/Dodge/Placement/Instance/Terminal.hs
+11 -5
View File
@@ -27,13 +27,12 @@ putTerminal''
-> Terminal
-> (Int -> Machine -> World -> World) -- | machine update, takes button id as input
-> Placement
putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) $ \tmpl -> Just $
ps0PushPS (PutButton termButton)
putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm)
$ \tmpl -> Just $ ps0PushPS (PutButton termButton)
$ \btpl -> Just $ pt0 (PutMachine (reverse $ square 10)
(mc & mcUpdate .~ machineAddSound fridgeHumS (mcf (fromJust $ _plMID btpl))
& mcDeath %~ (\fd mc' -> (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
)
)
& mcDeath %~ (\fd mc' -> mcKillTerm mc . (buttons . at (fromJust (_plMID btpl)) .~ Nothing) . fd mc')
) )
$ \mcpl -> Just $ sps0 $ PutWorldUpdate (const $ setids tmpl btpl mcpl)
where
setids tmpl btpl mcpl w = w
@@ -46,6 +45,13 @@ putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) $ \tmpl -> Just $
btid = fromJust (_plMID btpl)
mcid = fromJust (_plMID mcpl)
mcKillTerm :: Machine -> World -> World
mcKillTerm mc w = fromMaybe w $ do
tmid <- _mcTermMID mc
tm <- w ^? terminals . ix tmid
return $ w
& _tmDeathEffect tm tm
putTerminal'
:: Color
-> Terminal