Refactor UI
This commit is contained in:
Sam Tay
parent
00548552a4
commit
fb853a61c7
2 changed files with 55 additions and 58 deletions
|
|
@ -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 TVisual = Normal | HardDrop
|
||||
data CellLocation
|
||||
= 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 =
|
||||
[ foldr (<+>) emptyWidget $ M.filterWithKey (inRow r) gmap
|
||||
| r <- [boardHeight, boardHeight - 1 .. 1]
|
||||
]
|
||||
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
|
||||
g = ui ^. game
|
||||
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
|
||||
where
|
||||
cws = [ ((V2 x y), ew) | x <- [1 .. boardWidth], y <- [1 .. boardHeight] ]
|
||||
ew = drawMCell Nothing InGrid Normal Nothing
|
||||
emptyCellMap =
|
||||
let ew = drawMCell Nothing InGrid Normal Nothing
|
||||
in M.fromList
|
||||
[ ((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]
|
||||
where
|
||||
mkRow y =
|
||||
hBox
|
||||
$ drawMCell Nothing InNextShape Normal
|
||||
. 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
|
||||
$ [0, -1]
|
||||
<&> \y ->
|
||||
hBox
|
||||
$ drawMCell Nothing InNextShape Normal
|
||||
<$> [ t <$ guard (V2 x y `elem` coords blk) | x <- [-2 .. 1] ]
|
||||
where blk = Block t (V2 0 0) (relCells t)
|
||||
|
||||
drawHelp :: Widget Name
|
||||
drawHelp =
|
||||
|
|
|
|||
|
|
@ -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]
|
||||
, appHandleEvent = handleEvent
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const theMap
|
||||
, appChooseCursor = neverShowCursor
|
||||
}
|
||||
app = App
|
||||
{ appDraw = const [ui]
|
||||
, appHandleEvent = handleEvent
|
||||
, appStartEvent = return
|
||||
, appAttrMap = const $ attrMap V.defAttr []
|
||||
, appChooseCursor = neverShowCursor
|
||||
}
|
||||
|
||||
ui :: Widget ()
|
||||
ui = padLeft (Pad 19) $ padRight (Pad 21)
|
||||
$ C.center
|
||||
$ vLimit 22
|
||||
$ hLimit 22
|
||||
$ withBorderStyle BS.unicodeBold
|
||||
$ B.borderWithLabel (str "Tetris")
|
||||
$ C.center
|
||||
$ str " Choose Level (0-9)"
|
||||
|
||||
theMap :: AttrMap
|
||||
theMap = attrMap V.defAttr []
|
||||
ui =
|
||||
padLeft (Pad 19)
|
||||
$ padRight (Pad 21)
|
||||
$ C.center
|
||||
$ vLimit 22
|
||||
$ hLimit 22
|
||||
$ withBorderStyle BS.unicodeBold
|
||||
$ B.borderWithLabel (str "Tetris")
|
||||
$ C.center
|
||||
$ str " Choose Level (0-9)"
|
||||
|
||||
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) [])) =
|
||||
if d `elem` ['0'..'9']
|
||||
then halt $ Just (read [d])
|
||||
else continue n
|
||||
handleEvent n _ = continue n
|
||||
handleEvent n (VtyEvent (V.EvKey (V.KChar d) [])) =
|
||||
if d `elem` ['0' .. '9']
|
||||
then halt $ Just (read [d])
|
||||
else continue n
|
||||
handleEvent n _ = continue n
|
||||
|
||||
pickLevel :: IO Int
|
||||
pickLevel =
|
||||
defaultMain app Nothing
|
||||
>>= maybe exitSuccess return
|
||||
pickLevel = defaultMain app Nothing >>= maybe exitSuccess return
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue