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"
- where
+        False -> vBox $ [boardHeight, boardHeight - 1 .. 1] <&> \r ->
-  rows =
+          foldr (<+>) emptyWidget
-    [ foldr (<+>) emptyWidget $ M.filterWithKey (inRow r) gmap
+            . M.filterWithKey (\(V2 _ y) _ -> r == y)
-    | r <- [boardHeight, boardHeight - 1 .. 1]
+            $ mconcat
+                [ draw Normal . Just <$> g ^. board
+                , blockMap (g ^. block)                    Normal
+                , blockMap (evalTetris hardDroppedBlock g) HardDrop
+                , emptyCellMap
                 ]
-  inRow r (V2 _ y) _ = r == y
+ where
-  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
+  draw = drawMCell (ui ^. preview) InGrid
+  blockMap b v =
+    M.fromList $ [ (c, draw v . Just $ b ^. shape) | c <- 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
-  mkRow y =
           hBox
             $   drawMCell Nothing InNextShape Normal
-      .   cellAt
+            <$> [ t <$ guard (V2 x y `elem` coords blk) | x <- [-2 .. 1] ]
-      .   (`V2` y)
+  where blk = Block t (V2 0 0) (relCells t)
-      <$> [-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,15 +11,18 @@ 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
+  { appDraw         = const [ui]
   , appHandleEvent  = handleEvent
   , appStartEvent   = return
-          , appAttrMap = const theMap
+  , appAttrMap      = const $ attrMap V.defAttr []
   , appChooseCursor = neverShowCursor
   }
 
 ui :: Widget ()
-ui = padLeft (Pad 19) $ padRight (Pad 21)
+ui =
+  padLeft (Pad 19)
+    $ padRight (Pad 21)
     $ C.center
     $ vLimit 22
     $ hLimit 22
@@ -28,20 +31,15 @@ ui = padLeft (Pad 19) $ padRight (Pad 21)
     $ C.center
     $ str " Choose Level (0-9)"
 
-theMap :: AttrMap
-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.KChar 'q') _)) = halt n
 handleEvent n (VtyEvent (V.EvKey (V.KChar 'Q') _)) = halt n
 handleEvent n (VtyEvent (V.EvKey (V.KChar d) [])) =
-  if d `elem` ['0'..'9']
+  if d `elem` ['0' .. '9']
   then halt $ Just (read [d])
   else continue n
 handleEvent n _ = continue n
 
 pickLevel :: IO Int
-pickLevel =
+pickLevel = defaultMain app Nothing >>= maybe exitSuccess return
-  defaultMain app Nothing
-    >>= maybe exitSuccess return