diff --git a/src/Dodge/Data.hs b/src/Dodge/Data.hs index b31bc01c4..fd4e23521 100644 --- a/src/Dodge/Data.hs +++ b/src/Dodge/Data.hs @@ -943,6 +943,7 @@ data TerminalStatus = Connected | Disconnected data TerminalInput = TerminalInput { _tiText :: T.Text , _tiFocus :: Bool + , _tiSel :: (Int,Int) } data Terminal = Terminal { _tmID :: Int @@ -954,7 +955,6 @@ data Terminal = Terminal , _tmFutureLines :: [TerminalLine] , _tmMaxLines :: Int , _tmTitle :: String - , _tmSel :: Maybe (Int,Int) , _tmInput :: Maybe TerminalInput , _tmScrollCommands :: [TerminalCommand] , _tmWriteCommands :: [TerminalCommand] diff --git a/src/Dodge/Default.hs b/src/Dodge/Default.hs index 97386800a..0d8a4577b 100644 --- a/src/Dodge/Default.hs +++ b/src/Dodge/Default.hs @@ -208,7 +208,7 @@ defaultMachine = Machine { _mcID = 0 , _mcWallIDs = mempty , _mcUpdate = defaultMachineUpdate - , _mcDeath = \_ -> id + , _mcDeath = const id , _mcApplyDamage = \_ _ -> id , _mcDraw = const mempty , _mcColor = white @@ -244,7 +244,7 @@ defaultDrawButton col bt = defaultTerminal :: Terminal defaultTerminal = Terminal { _tmID = 0 - , _tmProgram = (\_ _ -> []) + , _tmProgram = \_ _ -> [] , _tmButtonID = 0 , _tmMachineID = 0 , _tmName = "TESTTERMINAL" @@ -252,7 +252,6 @@ defaultTerminal = Terminal , _tmFutureLines = [] , _tmMaxLines = 14 , _tmTitle = "TERMINAL IN LOCATION" - , _tmSel = Nothing , _tmInput = Nothing , _tmScrollCommands = [] , _tmWriteCommands = [] diff --git a/src/Dodge/Event.hs b/src/Dodge/Event.hs index fe9b4b382..e431284ed 100644 --- a/src/Dodge/Event.hs +++ b/src/Dodge/Event.hs @@ -100,10 +100,6 @@ handlePressedMouseButton but w = case (_hudElement (_hud w), but) of | otherwise -> w & terminals . ix tmid . tmInput . _Just . tiFocus %~ const True ( DisplayInventory (CombineInventory mi) , ButtonLeft) -> maybe (hud . hudElement .~ DisplayInventory NoSubInventory) doCombine mi w --- -> fromMaybe (w & hud . hudElement .~ DisplayInventory NoSubInventory) --- $ do -- ugly --- i <- mi --- return $ doCombine i w _ -> w -- note "sort" on the inventory indices; otherwise @@ -154,17 +150,17 @@ wheelEvent y w = case _hudElement $ _hud w of & terminals . ix tmid %~ updatetermsel _ -> w where - updatetermsel tp = case _tmSel tp of - Nothing -> tp & tmSel ?~ (0,0) - & tmInput . _Just . tiText %~ replacewith tp 0 - Just (i,_) -> let newi = ((`mod` length (scrollCommands tp)) . subtract yi) i - in tp & tmSel . _Just .~ (newi,0) - & tmInput . _Just . tiText %~ replacewith tp newi - updatetermsubsel tp = case _tmSel tp of - Nothing -> tp - Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (scrollCommands tp !! i) tp w)) - in tp & tmSel . _Just .~ (i,newj) - & tmInput . _Just . tiText %~ replacewith' tp i newj w + updatetermsel tm = case tm ^? tmInput . _Just . tiSel of + Nothing -> tm & tmInput . _Just . tiSel .~ (0,0) + & tmInput . _Just . tiText %~ replacewith tm 0 + Just (i,_) -> let newi = ((`mod` length (scrollCommands tm)) . subtract yi) i + in tm & tmInput . _Just . tiSel .~ (newi,0) + & tmInput . _Just . tiText %~ replacewith tm newi + updatetermsubsel tm = case tm ^? tmInput . _Just . tiSel of + Nothing -> tm + Just (i,j) -> let newj = (j - yi) `mod` (1 + length (_tcArguments (scrollCommands tm !! i) tm w)) + in tm & tmInput . _Just . tiSel .~ (i,newj) + & tmInput . _Just . tiText %~ replacewith' tm i newj w replacewith tp newi _ = T.pack (_tcString (scrollCommands tp !! newi)) replacewith' tp i j w' _ = T.pack $ _tcString tc ++ " " ++ arg-- ++ ((_tcArguments tp) w !! j) where @@ -187,7 +183,7 @@ nullCommand = TerminalCommand , _tcHelp = "" , _tcArgumentType = Nothing , _tcArguments = const (const []) - , _tcEffect = const $ \_ w -> Right $ w + , _tcEffect = const $ \_ w -> Right w } scrollRBOption :: Float -> World -> World diff --git a/src/Dodge/Placement/Instance/Analyser.hs b/src/Dodge/Placement/Instance/Analyser.hs index afc941595..7b7ef0300 100644 --- a/src/Dodge/Placement/Instance/Analyser.hs +++ b/src/Dodge/Placement/Instance/Analyser.hs @@ -54,9 +54,7 @@ analyser starts sucs _ afters upf pslight psmc = extTrigLitPos pslight $ \tp -> where tparams = defaultTermParams & tmFutureLines ++.~ (map makeTermLine starts ++ [makeTermLine sucs] ++ map makeTermLine afters) - termupdate tp _ = - (\mc -> upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) - ) + termupdate tp _ mc = upf mc . (triggers . ix (fromJust $ _plMID tp) .~ const (_sensToggle $ _mcSensor mc)) analyserTest :: (World -> Bool) -> Machine -> World -> World analyserTest t mc w = case diff --git a/src/Dodge/Placement/Instance/Terminal.hs b/src/Dodge/Placement/Instance/Terminal.hs index 4327b04e8..c76081b26 100644 --- a/src/Dodge/Placement/Instance/Terminal.hs +++ b/src/Dodge/Placement/Instance/Terminal.hs @@ -28,7 +28,7 @@ putTerminal'' -> (Int -> Machine -> World -> World) -- | machine update, takes button id as input -> Placement putTerminal'' mc tm mcf = ps0PushPS (PutTerminal tm) $ \tmpl -> Just $ - ps0PushPS (PutButton $ termButton) + 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') diff --git a/src/Dodge/Render/HUD.hs b/src/Dodge/Render/HUD.hs index 2977f4da0..eb247c75a 100644 --- a/src/Dodge/Render/HUD.hs +++ b/src/Dodge/Render/HUD.hs @@ -126,7 +126,8 @@ subInventoryDisplay subinv cfig w = case subinv of where displayTermInput tp = case _tmInput tp of Nothing -> id - Just (TerminalInput s inputstatus) -> (++ [('>':T.unpack s++displayBlinkCursor inputstatus,white)]) + Just (TerminalInput s inputstatus _) + -> (++ [('>':T.unpack s++displayBlinkCursor inputstatus,white)]) displayBlinkCursor inputstatus | inputstatus = clockCycle 10 (V.fromList ["_",""]) w | otherwise = [] closeobjectcursor = case selectedCloseObject w of diff --git a/src/Dodge/Terminal.hs b/src/Dodge/Terminal.hs index 054f8d9bb..25124b6ef 100644 --- a/src/Dodge/Terminal.hs +++ b/src/Dodge/Terminal.hs @@ -73,7 +73,7 @@ getCommands tm w = do infoClearInput :: Terminal -> [TerminalLine] -> World -> World infoClearInput tm tls = terminals . ix (_tmID tm) %~ - ( (tmInput ?~ TerminalInput T.empty True) + ( (tmInput ?~ TerminalInput T.empty True (0,0)) . (tmFutureLines ++.~ tls ) ) @@ -156,7 +156,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do case _tcEffect command args tm w of Right w' -> return w' Left err -> return $ w & terminals . ix (_tmID tm) %~ - ( (tmInput ?~ TerminalInput T.empty True) + ( (tmInput ?~ TerminalInput T.empty True (0,0)) . (tmFutureLines ++.~ [makeColorTermLine red ("^ INVALID ARGUMENT: EXPECTS "++fromJust (_tcArgumentType command)++ err) @@ -165,7 +165,7 @@ doTerminalEffect' s tm w = fromMaybe (w & badinput) $ do ) where badinput = terminals . ix (_tmID tm) %~ - ( (tmInput ?~ TerminalInput T.empty True) + ( (tmInput ?~ TerminalInput T.empty True (0,0)) . (tmFutureLines ++.~ [makeColorTermLine red "^ INVALID INPUT" ] ) ) @@ -187,7 +187,6 @@ defaultTermParams = defaultTerminal ,_tmFutureLines = [] ,_tmMaxLines = 14 ,_tmTitle = "TERMINAL" - ,_tmSel = Nothing ,_tmInput = Nothing ,_tmScrollCommands = [] ,_tmWriteCommands = [] diff --git a/src/Dodge/Update.hs b/src/Dodge/Update.hs index 448b8c3ab..03219202c 100644 --- a/src/Dodge/Update.hs +++ b/src/Dodge/Update.hs @@ -116,7 +116,7 @@ tmUpdate tm w = case w ^? terminals . ix (_tmID tm) . tmFutureLines . ix 0 of Just (TerminalLineInput _) -> w & pointTermParams %~ ( ( tmFutureLines %~ tail ) - . ( tmInput ?~ TerminalInput T.empty True) ) + . ( tmInput ?~ TerminalInput T.empty True (0,0)) ) where pointTermParams = terminals . ix (_tmID tm)