Allow hiding preview cells - closes #6

app/Main.hs

@@ -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 ()

src/UI/Game.hs

@@ -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)