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

Allow hiding preview cells - closes #6

Browse source
This commit is contained in:
Sam Tay 2019-03-14 19:09:50 -04:00
parent fe55e493f1
commit bac99ab3c8
2 changed files with 30 additions and 27 deletions
Download patch file Download diff file Expand all files Collapse all files

28
app/Main.hs
View file

@ -16,16 +16,16 @@ import UI.PickLevel (pickLevel)
import UI.Game (playGame) import UI.Game (playGame)
data Opts = Opts data Opts = Opts
{ hardDrop :: Maybe HardDropOpt { hardDrop :: HardDropOpt
, level :: Maybe Int , level :: Maybe Int
, score :: Bool , score :: Bool
} }
data HardDropOpt = AsciiOnly | CustomChars String data HardDropOpt = None | AsciiOnly | CustomChars String
opts :: Parser Opts opts :: Parser Opts
opts = Opts opts = Opts
<$> optional hardDropOpt <$> hardDropOpt
<*> optional (option auto <*> optional (option auto
( long "level" ( long "level"
<> short 'l' <> short 'l'
@ -36,17 +36,23 @@ opts = Opts
<> help "Print high score and exit" ) <> help "Print high score and exit" )
hardDropOpt :: Parser HardDropOpt hardDropOpt :: Parser HardDropOpt
hardDropOpt = asciiOpt <|> custOpt hardDropOpt = noneOpt <|> asciiOpt <|> custOpt
where where
noneOpt = flag' None
( long "no-preview"
<> short 'n'
<> help "Don't show preview cell" )
asciiOpt = flag' AsciiOnly asciiOpt = flag' AsciiOnly
( long "ascii-only" ( long "ascii-only"
<> short 'a' <> short 'a'
<> help "Use '[]' as hard drop preview cell instead of '◤◢'" ) <> help "Use '[]' as hard drop preview cell" )
custOpt = CustomChars <$> option twoChar custOpt = CustomChars <$> option twoChar
( long "preview-chars" ( long "preview-chars"
<> short 'p' <> short 'p'
<> metavar "CHARS" <> metavar "CHARS"
<> help "Custom two character preview cell" ) <> value "◤◢"
<> showDefaultWith (const "◤◢")
<> help "Customize two character preview cell" )
fullopts :: ParserInfo Opts fullopts :: ParserInfo Opts
fullopts = info (helper <*> opts) fullopts = info (helper <*> opts)
@ -60,17 +66,17 @@ twoChar = do
then readerError "Preview must be two characters long" then readerError "Preview must be two characters long"
else return cs else return cs
hdOptStr :: HardDropOpt -> String hdOptStr :: HardDropOpt -> Maybe String
hdOptStr AsciiOnly = "[]" hdOptStr None = Nothing
hdOptStr (CustomChars s) = s hdOptStr AsciiOnly = Just "[]"
hdOptStr (CustomChars s) = Just s
main :: IO () main :: IO ()
main = do main = do
(Opts hd ml hs) <- execParser fullopts -- get CLI opts/args (Opts hd ml hs) <- execParser fullopts -- get CLI opts/args
let mp = hdOptStr <$> hd -- determine hard drop preview cell
when hs (getHighScore >>= printM >> exitSuccess) -- show high score and exit when hs (getHighScore >>= printM >> exitSuccess) -- show high score and exit
l <- fromMaybe pickLevel (return <$> ml) -- pick level prompt if necessary l <- fromMaybe pickLevel (return <$> ml) -- pick level prompt if necessary
g <- playGame l mp -- play game g <- playGame l (hdOptStr hd) -- play game
handleEndGame (_score g) -- save & print score handleEndGame (_score g) -- save & print score
handleEndGame :: Int -> IO () handleEndGame :: Int -> IO ()

29
src/UI/Game.hs
View file

@ -59,7 +59,10 @@ app = App
, appAttrMap = const theMap , appAttrMap = const theMap
} }
playGame :: Int -> Maybe String -> IO Game playGame
:: Int -- ^ Starting level
-> Maybe String -- ^ Preview cell (Nothing == no preview)
-> IO Game
playGame lvl mp = do playGame lvl mp = do
let delay = levelToDelay lvl let delay = levelToDelay lvl
chan <- newBChan 10 chan <- newBChan 10
@ -169,26 +172,23 @@ drawGrid ui =
] ]
where where
g = ui ^. game g = ui ^. game
draw = drawMCell (ui ^. preview) InGrid draw = drawCell (ui ^. preview) InGrid
blockMap b v = blockMap b v =
M.fromList $ [ (c, draw v . Just $ b ^. shape) | c <- coords b ] M.fromList $ [ (c, draw v . Just $ b ^. shape) | c <- coords b ]
emptyCellMap :: Map Coord (Widget Name) emptyCellMap :: Map Coord (Widget Name)
emptyCellMap = emptyCellMap =
let ew = drawMCell Nothing InGrid Normal Nothing let ew = drawCell Nothing InGrid Normal Nothing
in M.fromList in M.fromList
[ ((V2 x y), ew) | x <- [1 .. boardWidth], y <- [1 .. boardHeight] ] [ ((V2 x y), ew) | x <- [1 .. boardWidth], y <- [1 .. boardHeight] ]
drawMCell drawCell
:: Maybe String -> CellLocation -> TVisual -> Maybe Tetrimino -> Widget Name :: Maybe String -> CellLocation -> TVisual -> Maybe Tetrimino -> Widget Name
drawMCell _ InGrid _ Nothing = withAttr emptyAttr cw drawCell _ InGrid _ Nothing = withAttr emptyAttr cw
drawMCell _ InNextShape _ Nothing = withAttr emptyAttr ecw drawCell _ InNextShape _ Nothing = withAttr emptyAttr ecw
drawMCell mp _ v (Just t) = drawCell mp t v drawCell Nothing _ HardDrop (Just _) = withAttr emptyAttr cw
drawCell (Just p) _ HardDrop (Just t) = withAttr (tToAttrH t) (str p)
drawCell :: Maybe String -> Tetrimino -> TVisual -> Widget Name drawCell _ _ Normal (Just t) = withAttr (tToAttr t) cw
drawCell _ t Normal = withAttr (tToAttr t) cw
drawCell Nothing t HardDrop = withAttr (tToAttrH t) hcw
drawCell (Just p) t HardDrop = withAttr (tToAttrH t) (str p)
tToAttr :: Tetrimino -> AttrName tToAttr :: Tetrimino -> AttrName
tToAttr I = iAttr tToAttr I = iAttr
@ -214,9 +214,6 @@ cw = str " ."
ecw :: Widget Name ecw :: Widget Name
ecw = str " " ecw = str " "
hcw :: Widget Name
hcw = str "◤◢"
drawStats :: Game -> Widget Name drawStats :: Game -> Widget Name
drawStats g = drawStats g =
hLimit 22 hLimit 22
@ -253,7 +250,7 @@ drawNextShape t =
$ [0, -1] $ [0, -1]
<&> \y -> <&> \y ->
hBox hBox
$ drawMCell Nothing InNextShape Normal $ drawCell Nothing InNextShape Normal
<$> [ t <$ guard (V2 x y `elem` coords blk) | x <- [-2 .. 1] ] <$> [ t <$ guard (V2 x y `elem` coords blk) | x <- [-2 .. 1] ]
where blk = Block t (V2 0 0) (relCells t) where blk = Block t (V2 0 0) (relCells t)