aadit/tetris-cli
1
0
Fork 0
Code Issues Pull requests Projects Releases Packages Wiki Activity Actions

Add restart option

Browse source
This commit is contained in:
Sam Tay 2017-07-03 00:43:32 -04:00
parent 6a3764fa9a
commit 4f9bcfca34
1 changed files with 13 additions and 4 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
src/UI/Game.hs
View file

@ -80,6 +80,7 @@ handleEvent ui (VtyEvent (V.EvKey V.KUp [])) = frozenGuard rotate ui
handleEvent ui (VtyEvent (V.EvKey (V.KChar 'k') [])) = frozenGuard rotate ui handleEvent ui (VtyEvent (V.EvKey (V.KChar 'k') [])) = frozenGuard rotate ui
handleEvent ui (VtyEvent (V.EvKey (V.KChar ' ') [])) = continue $ ui & game %~ hardDrop handleEvent ui (VtyEvent (V.EvKey (V.KChar ' ') [])) = continue $ ui & game %~ hardDrop
& frozen .~ True & frozen .~ True
handleEvent ui (VtyEvent (V.EvKey (V.KChar 'r') [])) = restart ui
handleEvent ui (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt ui handleEvent ui (VtyEvent (V.EvKey (V.KChar 'q') [])) = halt ui
handleEvent ui (VtyEvent (V.EvKey V.KEsc [])) = halt ui handleEvent ui (VtyEvent (V.EvKey V.KEsc [])) = halt ui
handleEvent ui _ = continue ui handleEvent ui _ = continue ui
@ -102,6 +103,13 @@ handleTick ui =
& frozen .~ False & frozen .~ False
where g = ui ^. game where g = ui ^. game
-- | Restart game at the same level
restart :: UI -> EventM Name (Next UI)
restart ui = do
let lvl = ui ^. game ^. level
g <- liftIO $ initGame lvl
continue $ ui & game .~ g
& frozen .~ False
-- Drawing -- Drawing
@ -189,16 +197,16 @@ drawLeaderBoard :: Game -> Widget Name
drawLeaderBoard g = emptyWidget drawLeaderBoard g = emptyWidget
drawInfo :: Game -> Widget Name drawInfo :: Game -> Widget Name
drawInfo g = hLimit 16 -- size of next piece box drawInfo g = hLimit 18 -- size of next piece box
$ vBox [ drawNextShape (g ^. nextShape) $ vBox [ drawNextShape (g ^. nextShape)
, padTop (Pad 2) $ drawHelp , padTop (Pad 2) $ drawHelp
, padTop (Pad 2) $ drawGameOver g , padTop (Pad 1) $ drawGameOver g
] ]
drawNextShape :: Tetrimino -> Widget Name drawNextShape :: Tetrimino -> Widget Name
drawNextShape t = withBorderStyle BS.unicodeBold drawNextShape t = withBorderStyle BS.unicodeBold
$ B.borderWithLabel (str "Next") $ B.borderWithLabel (str "Next")
$ padTopBottom 1 $ padLeftRight 3 $ padTopBottom 1 $ padLeftRight 4
$ vLimit 4 $ vLimit 4
$ vBox $ mkRow <$> [0,-1] $ vBox $ mkRow <$> [0,-1]
where where
@ -217,6 +225,7 @@ drawHelp = withBorderStyle BS.unicodeBold
, ("Down", "j, ↓") , ("Down", "j, ↓")
, ("Rotate", "k, ↑") , ("Rotate", "k, ↑")
, ("Drop", "space") , ("Drop", "space")
, ("Restart", "r")
, ("Quit", "q") , ("Quit", "q")
] ]
@ -227,7 +236,7 @@ drawKeyInfo action keys =
drawGameOver :: Game -> Widget Name drawGameOver :: Game -> Widget Name
drawGameOver g = if (isGameOver g) drawGameOver g = if (isGameOver g)
then padLeftRight 3 $ withAttr gameOverAttr $ str "GAME OVER" then padLeftRight 4 $ withAttr gameOverAttr $ str "GAME OVER"
else emptyWidget else emptyWidget
theMap :: AttrMap theMap :: AttrMap