Allow hiding preview cells - closes #6

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

View file

@ -16,16 +16,16 @@ import UI.PickLevel (pickLevel)
import UI.Game (playGame)
data Opts = Opts
{ hardDrop :: Maybe HardDropOpt
{ hardDrop :: HardDropOpt
, level :: Maybe Int
, score :: Bool
}
data HardDropOpt = AsciiOnly | CustomChars String
data HardDropOpt = None | AsciiOnly | CustomChars String
opts :: Parser Opts
opts = Opts
<$> optional hardDropOpt
<$> hardDropOpt
<*> optional (option auto
( long "level"
<> short 'l'
@ -36,17 +36,23 @@ opts = Opts
<> help "Print high score and exit" )
hardDropOpt :: Parser HardDropOpt
hardDropOpt = asciiOpt <|> custOpt
hardDropOpt = noneOpt <|> asciiOpt <|> custOpt
where
noneOpt = flag' None
( long "no-preview"
<> short 'n'
<> help "Don't show preview cell" )
asciiOpt = flag' AsciiOnly
( long "ascii-only"
<> short 'a'
<> help "Use '[]' as hard drop preview cell instead of '◤◢'" )
<> help "Use '[]' as hard drop preview cell" )
custOpt = CustomChars <$> option twoChar
( long "preview-chars"
<> short 'p'
<> metavar "CHARS"
<> help "Custom two character preview cell" )
<> value "◤◢"
<> showDefaultWith (const "◤◢")
<> help "Customize two character preview cell" )
fullopts :: ParserInfo Opts
fullopts = info (helper <*> opts)
@ -60,17 +66,17 @@ twoChar = do
then readerError "Preview must be two characters long"
else return cs
hdOptStr :: HardDropOpt -> String
hdOptStr AsciiOnly = "[]"
hdOptStr (CustomChars s) = s
hdOptStr :: HardDropOpt -> Maybe String
hdOptStr None = Nothing
hdOptStr AsciiOnly = Just "[]"
hdOptStr (CustomChars s) = Just s
main :: IO ()
main = do
(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
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 :: Int -> IO ()

View file

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