Refactor control list display

src/Dodge/Data.hs

@@ -113,6 +113,7 @@ data ScreenLayer
         , _scDefaultEff :: World -> Maybe World
         , _scOptionFlag :: OptionScreenFlag
         }
+    | ColumnsScreen String [(String,String)]
     | InputScreen String
     | TerminalScreen Int [(Int,String)]
     | WaitScreen

src/Dodge/Event/Keyboard.hs

@@ -1,6 +1,4 @@
-{- |
+{- | Deals with keyboard events.  -}
-Deals with keyboard events.
--}
 module Dodge.Event.Keyboard
     ( handleKeyboardEvent
     )

src/Dodge/Event/Menu.hs

@@ -15,6 +15,7 @@ handlePressedKeyInMenu mState scode = case mState of
     OptionScreen { _scOptions = mos, _scDefaultEff = defeff} 
                         -> optionListToEffects mos defeff scode
     DisplayScreen {}    -> popScreen
+    ColumnsScreen {}    -> popScreen
     WaitScreen {}       -> Just
     TerminalScreen 0 _  -> popScreen
     TerminalScreen _ m  -> Just . ( menuLayers %~ ( (TerminalScreen 0 m : ) . tail) )

src/Dodge/Menu.hs

@@ -1,4 +1,10 @@
 module Dodge.Menu
+    ( scodeToChar
+    , popScreen
+    , pushScreen
+    , pauseMenu
+    , gameOverMenu
+    )
     where
 import Dodge.Data
 import Dodge.Save
@@ -12,7 +18,7 @@ import Dodge.Initialisation
 import Preload.Update
 import Dodge.Base.Window
 import Dodge.SoundLogic
-import Picture
+--import Picture
 
 import Control.Lens
 optionMenu :: ScreenLayer
@@ -28,12 +34,12 @@ optionsOptions =
     , Toggle ScancodeG (pushScreen graphicsMenu) (const "GRAPHICS")
     , Toggle ScancodeP (pushScreen gameplayOptionsMenu) (const "GAMEPLAY")
     ]
-levelMenuOptions :: [MenuOption]
+--levelMenuOptions :: [MenuOption]
-levelMenuOptions =
+--levelMenuOptions =
-    [  InvisibleToggle ScancodeEscape (const Nothing)
+--    [  InvisibleToggle ScancodeEscape (const Nothing)
-    ,  InvisibleToggle ScancodeO      (pushScreen optionMenu)
+--    ,  InvisibleToggle ScancodeO      (pushScreen optionMenu)
-    ,  InvisibleToggle ScancodeC      (pushScreen displayControls)
+--    ,  InvisibleToggle ScancodeC      (pushScreen displayControls)
-    ]
+--    ]
 gameplayOptionsMenu :: ScreenLayer
 gameplayOptionsMenu  = OptionScreen
     { _scTitle = const "OPTIONS:GAMEPLAY"
@@ -151,8 +157,8 @@ startNewGame w = Just $ w
 scodeToChar :: Scancode -> Char
 scodeToChar = toEnum . (+ 61) . fromIntegral . toNumber
 
-charToScode :: Char -> Scancode
+--charToScode :: Char -> Scancode
-charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
+--charToScode = Scancode . fromIntegral . (\x -> x - 61) . fromEnum
 
 updateFramebufferSize :: World -> World
 updateFramebufferSize w = w & sideEffects %~ up
@@ -164,43 +170,30 @@ updateFramebufferSize w = w & sideEffects %~ up
         pdata <- pdataResizeUpdate (x `div` divRes) (y `div` divRes) x y (_preloadData w')
         f $ w' & preloadData .~ pdata
     
-levelMenu :: Int -> ScreenLayer
+--levelMenu :: Int -> ScreenLayer
-levelMenu x = OptionScreen
+--levelMenu x = OptionScreen
-    { _scTitle = const $ "LEVEL "++ show x 
+--    { _scTitle = const $ "LEVEL "++ show x 
-    , _scOptions = levelMenuOptions
+--    , _scOptions = levelMenuOptions
-    , _scDefaultEff = unpause . storeLevel
+--    , _scDefaultEff = unpause . storeLevel
-    , _scOptionFlag = NormalOptions
+--    , _scOptionFlag = NormalOptions
-    }
+--    }
 unpause :: World -> Maybe World
 unpause w = Just . resumeSound $ w {_menuLayers = []}
 
 displayControls :: ScreenLayer
-displayControls = DisplayScreen
+displayControls = ColumnsScreen "CONTROLS" listControls
-    {_scDisplay = \w -> pictures 
-        [color (withAlpha 0.5 black) $ polygon $ screenBox w
-        ,tst (-100) 100 0.4 "CONTROLS"
-        ,controlsList
-        ]
-    }
-  where
-    tst x y sc t = translate x y $ scale sc sc $ color white $ text t
 
-controlsList :: Picture
+listControls :: [(String,String)]
-controlsList = pictures $ concat $ zipWith butAndEff
+listControls =
-    [("wasd",           "movement")
+    [("wasd",           "MOVEMENT")
-    ,("[rmb]",          "aim")
+    ,("[rmb]",          "AIM")
-    ,("[rmb+lmb]",      "shoot or use item")
+    ,("[rmb+lmb]",      "SHOOT OR USE ITEM")
-    ,("[wheelscroll]" , "select item"  )
+    ,("[wheelscroll]" , "SELECT ITEM"  )
-    ,("[space]" ,       "pickup item"  )
+    ,("[space]" ,       "PICKUP ITEM"  )
-    ,("m" ,             "display map"    )
+    ,("m" ,             "DISPLAY MAP"    )
-    ,("f" ,             "drop item"    )
+    ,("f" ,             "DROP ITEM"    )
-    ,("c[esc]" ,        "pause"        )
+    ,("c[esc]" ,        "PAUSE"        )
-    ,("qe" ,       "rotate camera")
+    ,("qe" ,            "ROTATE CAMERA")
+    ,("F5" ,            "QUICKSAVE")
+    ,("F9" ,            "QUICKLOAD")
     ]
-    [60,30..]
-  where
-    butAndEff (btext,etext) y = 
-        [translate (-250) y $ scale 0.15 0.15 $ color white $ text btext
-        ,translate     0  y $ scale 0.15 0.15 $ color white $ text etext
-        ]
-

src/Dodge/Render/MenuScreen.hs

@@ -11,6 +11,7 @@ import Dodge.Data
 import Dodge.Base.Window
 import Picture
 import Dodge.Menu
+import Padding
 
 menuScreen 
     :: World
@@ -23,6 +24,7 @@ menuScreen w screen = case screen of
     (InputScreen s)         -> drawOptions w ('>':s) []
     (TerminalScreen t xs )  -> displayStringList w $ map snd $ filter (( > t) . fst) xs
     (DisplayScreen sd )     -> sd w
+    (ColumnsScreen title pairs) -> drawTwoColumnsScreen w title pairs
 
 displayStringList :: World -> [String] -> Picture
 displayStringList w ss = pictures
@@ -33,6 +35,26 @@ displayStringList w ss = pictures
     hw = halfWidth  w
     ys = [0,22..]
     f y s = translate (10-hw) y . scale 0.15 0.15 $ text s
+
+drawTwoColumnsScreen
+    :: World 
+    -> String
+    -> [(String,String)]
+    -> Picture
+drawTwoColumnsScreen w title lps = pictures
+    [darkenBackground w
+    ,drawTitle w title
+    ,drawTwoColumns w lps
+    ]
+
+drawTwoColumns :: World -> [(String,String)] -> Picture
+drawTwoColumns w 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
+    hh = halfHeight w
+    hw = halfWidth w
+    ln = maximum (map (length . fst) lps) + 3
     
 drawOptions
     :: World
@@ -40,8 +62,8 @@ drawOptions
     -> [MenuOption] -- ^ Options
     -> Picture
 drawOptions w title ops = pictures $
-    [darkenBackground
+    [darkenBackground w
-    ,theTitle]
+    ,drawTitle w title]
     ++
     zipWith (\ s vpos -> placeString (-hw + 50) vpos 0.2 s) (map (menuOptionToString w) ops') [hh-100,hh-150 ..]
   where
@@ -49,8 +71,16 @@ drawOptions w title ops = pictures $
     notInvisible InvisibleToggle {} = False
     notInvisible _ = True
     placeString x y sc t = translate x y $ scale sc sc $ color white $ text t
-    darkenBackground = color (withAlpha 0.5 black) $ polygon $ screenBox w
+    hh = halfHeight w
-    theTitle = placeString (-hw + 30) (hh - 50) 0.4 title
+    hw = halfWidth w
+
+darkenBackground :: World -> Picture
+darkenBackground = color (withAlpha 0.5 black) . polygon . screenBox
+
+drawTitle :: World -> String -> Picture
+drawTitle w = 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 w
     hw = halfWidth w
 

src/Dodge/Save.hs

@@ -1,5 +1,9 @@
 module Dodge.Save
-    where
+    ( storeLevel
+    , loadStoredLevel
+    , doQuicksave
+    )
+  where
 import Dodge.Data
 
 import Data.Maybe
@@ -12,7 +16,7 @@ storeLevel w = case _storedLevel w of
     _       -> w
 
 loadStoredLevel :: World -> World
-loadStoredLevel w = fromMaybe w $ _storedLevel w
+loadStoredLevel w = fromMaybe w $ _storedLevel w <&> quicksaveLevel .~ _quicksaveLevel w
 
 doQuicksave :: World -> World
 doQuicksave w = w & quicksaveLevel ?~ clearKeys w