Cleanup

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]

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  = []

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

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 

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')

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

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 = []

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)