Add help section and support vim bindings

src/Tetris.hs

@@ -21,8 +21,11 @@ import Data.Monoid (First(..))
 --   0. BUG in hard drop - if block is under an overhang then it gets sent above
 --   1. leaderboard saved to txt file (requires adding viewport for name entry)
 --      and probably wrapping game in a ui state
+--   2. Add ToDo: Custom RGB colors or find a good theme and steal it. See if attribute monoid is used for defaulting when color not displayable?
+--   2. Consider allow speeding up just like Conway (thus removing pickLevel and having one interface)
 --   2. consider adding hard drop preview like other games, but need another color
 --   3. USE linear V2 instead of tuples.. dummy
+--   3. Consider refactoring (Game -> a) with State or Reader abstraction
 --   4. README with gif
 --   5. release binaries for darwin and linux
 

src/UI/Game.hs

@@ -59,13 +59,16 @@ handleEvent g (AppEvent Tick)                       = handleTick g
 handleEvent g (VtyEvent (V.EvKey V.KRight []))      = continue $ shift Right g
 handleEvent g (VtyEvent (V.EvKey V.KLeft []))       = continue $ shift Left g
 handleEvent g (VtyEvent (V.EvKey V.KDown []))       = continue $ shift Down g
+handleEvent g (VtyEvent (V.EvKey (V.KChar 'l') [])) = continue $ shift Right g
+handleEvent g (VtyEvent (V.EvKey (V.KChar 'h') [])) = continue $ shift Left g
+handleEvent g (VtyEvent (V.EvKey (V.KChar 'j') [])) = continue $ shift Down g
 handleEvent g (VtyEvent (V.EvKey (V.KChar ' ') [])) = continue $ hardDrop g
 handleEvent g (VtyEvent (V.EvKey V.KUp []))         = continue $ rotate g
+handleEvent g (VtyEvent (V.EvKey (V.KChar 'k') [])) = continue $ rotate g
 handleEvent g (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt g
 handleEvent g (VtyEvent (V.EvKey V.KEsc []))        = halt g
 handleEvent g _                                     = continue g
 
-
 -- | Handles time steps, does nothing if game is over
 handleTick :: Game -> EventM Name (Next Game)
 handleTick g = if isGameOver g
@@ -76,9 +79,9 @@ handleTick g = if isGameOver g
 
 drawUI :: Game -> [Widget Name]
 drawUI g =
-  [ C.vCenter $ vLimit 22 $ hBox [ padLeft Max $ drawStats g
+  [ C.vCenter $ vLimit 22 $ hBox [ padLeft Max $ padRight (Pad 2) $ drawStats g
                                  , drawGrid g
-                                 , padRight Max $ drawNextShape (g ^. nextShape)
+                                 , padRight Max $ padLeft (Pad 2) $ drawInfo g
                                  ]
   ]
 
@@ -114,6 +117,8 @@ drawCell t = withAttr (tToAttr t) cw
         tToAttr J = jAttr
         tToAttr L = lAttr
 
+-- TODO • for hardDrop preview
+
 cw :: Widget Name
 cw = str " ."
 
@@ -121,28 +126,31 @@ ecw :: Widget Name
 ecw = str "  "
 
 drawStats :: Game -> Widget Name
-drawStats g = padRight (Pad 2)
-  $ hLimit 22
+drawStats g = hLimit 22
   $ withBorderStyle BS.unicodeBold
   $ B.borderWithLabel (str "Stats")
   $ vBox [ drawStat "Score" $ g ^. score
-         , drawStat "Level" $ g ^. level
+         , padTop (Pad 1) $ drawStat "Level" $ g ^. level
          , drawLeaderBoard g
          ]
 
 drawStat :: String -> Int -> Widget Name
-drawStat s n = padLeftRight 1 $ padTop (Pad 1)
+drawStat s n = padLeftRight 1
   $ str s <+> (padLeft Max $ str $ show n)
 
 drawLeaderBoard :: Game -> Widget Name
 drawLeaderBoard g = emptyWidget
 
+drawInfo :: Game -> Widget Name
+drawInfo g = hLimit 16 -- size of next piece box
+  $ vBox [ drawNextShape (g ^. nextShape)
+         , padTop (Pad 2) $ drawHelp
+         ]
+
 drawNextShape :: Tetrimino -> Widget Name
-drawNextShape t =
-  padLeft (Pad 2)
-  $ withBorderStyle BS.unicodeBold
-  $ B.borderWithLabel (str "Next Piece")
-  $ padTopBottom 1 $ padLeftRight 2
+drawNextShape t = withBorderStyle BS.unicodeBold
+  $ B.borderWithLabel (str "Next")
+  $ padTopBottom 1 $ padLeftRight 3
   $ vLimit 4
   $ vBox $ mkRow <$> [0,-1]
   where
@@ -151,6 +159,24 @@ drawNextShape t =
     blk = Block t (0,0) (relCells t)
     cs = blk ^. to coords
 
+drawHelp :: Widget Name
+drawHelp = withBorderStyle BS.unicodeBold
+  $ B.borderWithLabel (str "Help")
+  $ padTopBottom 1
+  $ vBox $ map (uncurry drawKeyInfo)
+  $ [ ("Left", "h, ←")
+    , ("Right", "l, →")
+    , ("Down", "j, ↓")
+    , ("Rotate", "k, ↑")
+    , ("Quit", "q")
+    ]
+
+drawKeyInfo :: String -> String -> Widget Name
+drawKeyInfo action keys =
+  (padRight Max $ padLeft (Pad 1) $ str (action ++ ":"))
+  <+> (padLeft Max $ padRight (Pad 1) $ str keys)
+
+
 theMap = attrMap V.defAttr
   [ (iAttr, on V.cyan V.cyan)
   , (oAttr, on V.yellow V.yellow)