Cleanup console input slightly

src/Dodge/Data.hs

@@ -173,7 +173,10 @@ data ScreenLayer
         , _scDefaultEff :: Universe -> IO (Maybe Universe)
         , _scOptionFlag :: OptionScreenFlag
         }
-    | ColumnsScreen String [(String,String)]
+    | ColumnsScreen 
+        { _scTitle  :: Universe -> String 
+        , _scColumns :: [(String,String)]
+        }
     | InputScreen 
         { _scInput  :: String 
         , _scFooter :: String
@@ -1031,3 +1034,4 @@ makeLenses ''SubInventory
 makeLenses ''TerminalParams
 makeLenses ''TerminalLine
 makeLenses ''ItemValue
+makeLenses ''ScreenLayer

src/Dodge/Debug/Terminal.hs

@@ -87,12 +87,7 @@ getSplitString str = case break (==' ') str of
     (a, _) -> (a, "")
 
 isValidCommand :: String -> String -> Bool
-isValidCommand arg1 arg2
-    | arg2 `elem` v = True
-    | otherwise = False
-    where
-        v = validTerminalCommands arg1
-
+isValidCommand arg1 arg2 = arg2 `elem` validTerminalCommands arg1
 
 validTerminalCommands :: String -> [String]
 validTerminalCommands "set" = ["hp", "invcap", "invsel", "mass", "mvspeed"]

src/Dodge/Event/Keyboard.hs

@@ -27,7 +27,7 @@ handleTextInputEvent tev = handleTextInput text
     text = unpack $ textInputEventText tev
 
 handleTextInput :: String -> Universe -> IO (Maybe Universe)
-handleTextInput text w  
+handleTextInput text w
     | null (_menuLayers w) = return $ Just w
     | otherwise = handleTextInMenu (head $ _menuLayers w) text w
 

src/Dodge/Event/Menu.hs

@@ -9,23 +9,18 @@ import Dodge.Debug.Terminal
 import Dodge.Menu.PushPop
 
 import Data.Maybe
-import Control.Monad
---import Control.Lens
+--import Control.Monad
+import Control.Lens
 import SDL
-import Control.Lens ((%~))
 --import qualified Debug.Trace
 
-
 handleTextInMenu :: ScreenLayer -> [Char] -> Universe -> IO (Maybe Universe)
-handleTextInMenu mState text = case mState of
-    InputScreen s help -> return . (popScreen' >=> pushScreen' (InputScreen new_text help))
-        where
-            new_text
-                -- Text events occur after key events so ignore the first
-                -- (key that opened the terminal menu)
-                | s == "" = ">"
-                | otherwise = s ++ text
-    _ -> return . Just
+handleTextInMenu mState text = return . Just . case mState of
+    InputScreen {}  -> menuLayers . ix 0 . scInput %~ updateText
+    _               -> id
+  where
+    updateText "" = ">"
+    updateText s = s ++ text
 
 handlePressedKeyInMenu :: ScreenLayer -> Scancode -> Universe -> IO (Maybe Universe)
 handlePressedKeyInMenu mState scode = case mState of
@@ -35,23 +30,22 @@ handlePressedKeyInMenu mState scode = case mState of
     ColumnsScreen {}    -> popScreen
     WaitScreen {}       -> return . Just
     InputScreen s help  -> case scode of
-        ScancodeEscape  -> popScreen
-        -- Remove the menu layer (we readd it in applyTerminalString if the commmand fails)
-        ScancodeReturn  -> return. Just . applyTerminalString (tail s) . (menuLayers %~ tail)
-        ScancodeTab  -> autoCompleteTerminal s help
-        ScancodeBackspace
-            -> return . (popScreen' >=> pushScreen' (InputScreen (dropLast s) "Enter command"))
-            -- Ignore (text input now handled by handleText)
-        _   -> return . (popScreen' >=> pushScreen' (InputScreen s help))
+        ScancodeEscape      -> popScreen
+        ScancodeReturn      -> popScreen . applyTerminalString (tail s)
+        ScancodeTab         -> autoCompleteTerminal s help
+        ScancodeBackspace   -> return . Just . (menuLayers . ix 0 . scInput %~ doBackspace)
+        -- text input handled by handleText
+        _                   -> return . Just
   where
-    dropLast [_] = ['>']
-    dropLast (x:xs) = init (x:xs)
-    dropLast _      = ['>']
+    doBackspace [_]     = ['>']
+    doBackspace (x:xs)  = init (x:xs)
+    doBackspace _       = ['>']
 
 optionListToEffects :: [MenuOption] -> (Universe -> IO (Maybe Universe)) -> Scancode
     -> Universe -> IO (Maybe Universe)
-optionListToEffects mos defaulteff sc = fromMaybe defaulteff .
-    lookup sc $ concatMap menuOptionToEffects mos
+optionListToEffects mos defaulteff sc = fromMaybe defaulteff 
+    . lookup sc 
+    $ concatMap menuOptionToEffects mos
 
 menuOptionToEffects :: MenuOption -> [(Scancode,Universe -> IO (Maybe Universe))]
 menuOptionToEffects Toggle          {_moKey = k, _moEff = eff} = [(k,eff)]

src/Dodge/Menu.hs

@@ -151,7 +151,7 @@ unpause :: Universe -> Maybe Universe
 unpause w = Just . resumeSound $ w & menuLayers .~ []
 
 displayControls :: ScreenLayer
-displayControls = ColumnsScreen "CONTROLS" listControls
+displayControls = ColumnsScreen (const "CONTROLS") listControls
 
 listControls :: [(String,String)]
 listControls =

src/Dodge/Render/MenuScreen.hs

@@ -15,7 +15,7 @@ menuScreen w screen = case screen of
     (WaitScreen sf _)       -> drawOptions w (sf w) [] ""
     (InputScreen inputstr help)    -> drawOptions w inputstr [] help
     (DisplayScreen sd )     -> sd w
-    (ColumnsScreen title pairs) -> drawTwoColumnsScreen (_config w) title pairs
+    (ColumnsScreen titf pairs) -> drawTwoColumnsScreen (_config w) (titf w) pairs
 
 --displayStringList :: World -> [String] -> Picture
 --displayStringList w ss = pictures
@@ -37,8 +37,7 @@ drawTwoColumnsScreen cfig title lps = pictures
 drawTwoColumns :: Configuration -> [(String,String)] -> Picture
 drawTwoColumns cfig lps = pictures $ zipWith f [hh-100,hh-130..] lps
   where
-    f y (s1,s2) = translate (50-hw) y $ sc $ rightPad ln '.' s1 ++ s2
-    sc = scale 0.15 0.15 . color white . text
+    f y (s1,s2) = placeString (50-hw) y 0.15 $ rightPad ln '.' s1 ++ s2
     hh = halfHeight cfig
     hw = halfWidth  cfig
     ln = maximum (map (length . fst) lps) + 3
@@ -61,7 +60,6 @@ drawOptions u title ops footer = pictures $
     ops' = filter notInvisible ops
     notInvisible InvisibleToggle {} = False
     notInvisible _ = True
-    placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
     hh = halfHeight cfig
     hw = halfWidth  cfig
     cfig = _config u
@@ -72,12 +70,19 @@ darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
 drawTitle :: Configuration -> String -> Picture
 drawTitle cfig = placeString (-hw + 30) (hh - 50) 0.4
   where
-    placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
     hh = halfHeight cfig
     hw = halfWidth  cfig
 
+placeString 
+    :: Float -- | x distance from center
+    -> Float -- | y distance from center
+    -> Float -- | scale
+    -> String
+    -> Picture
+placeString x y sc = color white . translate x y . scale sc sc . text
+
 drawFooterText :: Configuration -> Color -> String -> Picture
-drawFooterText cfig col = translate (-hw + 30) (-hh+10) . scale 0.1 0.1 . color col . text
+drawFooterText cfig col = color col . placeString (-hw + 30) (-hh+10) 0.1
   where
     hh = halfHeight cfig
     hw = halfWidth cfig