Refactor UI

src/UI/Game.hs

@@ -7,7 +7,7 @@ module UI.Game
   ) where
 
 import Control.Concurrent (threadDelay, forkIO)
-import Control.Monad (void, forever)
+import Control.Monad (guard, void, forever)
 import Control.Monad.IO.Class (liftIO)
 import Prelude hiding (Left, Right)
 
@@ -40,8 +40,13 @@ data Tick = Tick
 -- | Named resources
 type Name = ()
 
-data CellLocation = InGrid | InNextShape
+data CellLocation
-data TVisual = Normal | HardDrop
+  = InGrid
+  | InNextShape
+
+data TVisual
+  = Normal
+  | HardDrop
 
 -- App definition and execution
 
@@ -152,27 +157,27 @@ drawGrid ui =
     $ withBorderStyle BS.unicodeBold
     $ B.borderWithLabel (str "Tetris")
     $ case ui ^. paused of
-        False -> vBox rows
         True  -> C.center $ str "Paused"
+        False -> vBox $ [boardHeight, boardHeight - 1 .. 1] <&> \r ->
+          foldr (<+>) emptyWidget
+            . M.filterWithKey (\(V2 _ y) _ -> r == y)
+            $ mconcat
+                [ draw Normal . Just <$> g ^. board
+                , blockMap (g ^. block)                    Normal
+                , blockMap (evalTetris hardDroppedBlock g) HardDrop
+                , emptyCellMap
+                ]
  where
-  rows =
+  g    = ui ^. game
-    [ foldr (<+>) emptyWidget $ M.filterWithKey (inRow r) gmap
+  draw = drawMCell (ui ^. preview) InGrid
-    | r <- [boardHeight, boardHeight - 1 .. 1]
+  blockMap b v =
-    ]
+    M.fromList $ [ (c, draw v . Just $ b ^. shape) | c <- coords b ]
-  inRow r (V2 _ y) _ = r == y
-  gmap    = mconcat [brdMap, cBlkMap, hrdMap, emptyCellMap]
-  brdMap  = draw Normal . Just <$> g ^. board
-  hrdMap  = blkMap (evalTetris hardDroppedBlock g) HardDrop
-  cBlkMap = blkMap (g ^. block) Normal
-  draw    = drawMCell (ui ^. preview) InGrid
-  g       = ui ^. game
-  blkMap b v = M.fromList . map (, draw v . Just $ b ^. shape) $ coords b
 
 emptyCellMap :: Map Coord (Widget Name)
-emptyCellMap = M.fromList cws
+emptyCellMap =
- where
+  let ew = drawMCell Nothing InGrid Normal Nothing
-  cws = [ ((V2 x y), ew) | x <- [1 .. boardWidth], y <- [1 .. boardHeight] ]
+  in  M.fromList
-  ew  = drawMCell Nothing InGrid Normal Nothing
+        [ ((V2 x y), ew) | x <- [1 .. boardWidth], y <- [1 .. boardHeight] ]
 
 drawMCell
   :: Maybe String -> CellLocation -> TVisual -> Maybe Tetrimino -> Widget Name
@@ -245,18 +250,12 @@ drawNextShape t =
     $   padLeftRight 4
     $   vLimit 4
     $   vBox
-    $   mkRow
+    $   [0, -1]
-    <$> [0, -1]
+    <&> \y ->
- where
+          hBox
-  mkRow y =
+            $   drawMCell Nothing InNextShape Normal
-    hBox
+            <$> [ t <$ guard (V2 x y `elem` coords blk) | x <- [-2 .. 1] ]
-      $   drawMCell Nothing InNextShape Normal
+  where blk = Block t (V2 0 0) (relCells t)
-      .   cellAt
-      .   (`V2` y)
-      <$> [-2 .. 1]
-  cellAt (V2 x y) = if (V2 x y) `elem` cs then Just t else Nothing
-  blk = Block t (V2 0 0) (relCells t)
-  cs  = blk ^. to coords
 
 drawHelp :: Widget Name
 drawHelp =

src/UI/PickLevel.hs

@@ -11,37 +11,35 @@ import qualified Brick.Widgets.Center as C
 import qualified Graphics.Vty as V
 
 app :: App (Maybe Int) e ()
-app = App { appDraw = const [ui]
+app = App
-          , appHandleEvent = handleEvent
+  { appDraw         = const [ui]
-          , appStartEvent = return
+  , appHandleEvent  = handleEvent
-          , appAttrMap = const theMap
+  , appStartEvent   = return
-          , appChooseCursor = neverShowCursor
+  , appAttrMap      = const $ attrMap V.defAttr []
-          }
+  , appChooseCursor = neverShowCursor
+  }
 
 ui :: Widget ()
-ui = padLeft (Pad 19) $ padRight (Pad 21)
+ui =
-  $ C.center
+  padLeft (Pad 19)
-  $ vLimit 22
+    $ padRight (Pad 21)
-  $ hLimit 22
+    $ C.center
-  $ withBorderStyle BS.unicodeBold
+    $ vLimit 22
-  $ B.borderWithLabel (str "Tetris")
+    $ hLimit 22
-  $ C.center
+    $ withBorderStyle BS.unicodeBold
-  $ str " Choose Level (0-9)"
+    $ B.borderWithLabel (str "Tetris")
-
+    $ C.center
-theMap :: AttrMap
+    $ str " Choose Level (0-9)"
-theMap = attrMap V.defAttr []
 
 handleEvent :: Maybe Int -> BrickEvent () e -> EventM () (Next (Maybe Int))
-handleEvent n (VtyEvent (V.EvKey V.KEsc _))        = halt n
+handleEvent n (VtyEvent (V.EvKey V.KEsc        _)) = halt n
 handleEvent n (VtyEvent (V.EvKey (V.KChar 'q') _)) = halt n
 handleEvent n (VtyEvent (V.EvKey (V.KChar 'Q') _)) = halt n
-handleEvent n (VtyEvent (V.EvKey (V.KChar d) []))  =
+handleEvent n (VtyEvent (V.EvKey (V.KChar d) [])) =
-  if d `elem` ['0'..'9']
+  if d `elem` ['0' .. '9']
-     then halt $ Just (read [d])
+  then halt $ Just (read [d])
-     else continue n
+  else continue n
-handleEvent n _                                    = continue n
+handleEvent n _ = continue n
 
 pickLevel :: IO Int
-pickLevel =
+pickLevel = defaultMain app Nothing >>= maybe exitSuccess return
-  defaultMain app Nothing
-    >>= maybe exitSuccess return