Added functionality to choose whether a user wants level progression …

…or not, and reflect that in the game window. (#39)

* Make level progression optional

Change level progression from mandatory to optional:
- Add progression flag to control automatic level increases
- Preserve fixed starting level option when progression is disabled 
- Add UI indicator showing current progression mode (ON/OFF)
- Pass progression setting through game restarts

This allows players to stay at their chosen difficulty level rather than being forced into increasingly faster speeds through automatic progression.

* feat: Add level progression option to level picker

- Introduce LevelConfig type to bundle level number and progression setting
- Add two-step menu system for selecting level and progression mode
- Implement UP/DOWN navigation and selection for progression options
- Add visual highlighting for selected menu options
- Update UI to show different screens for level and progression selection

* feat: Add optional level progression system

- Add progression flag to Game state
- Update initGame to accept progression parameter
- Modify levelFinished to respect progression setting
- Add progression lens to exposed interface
- Make level advancement conditional on progression flag

* refactor: Add progression toggle to level selection

Modify level selection flow to include progression mode choice:
- Update LevelConfig to include progression flag 
- Pass progression setting through to game initialization
- Default to fixed level (progression off) when level specified via CLI
- Keep high score and hard drop functionality unchanged

This connects the new progression toggle UI with the initial game setup, allowing the mode choice to be made during level selection.

* Update tetris.cabal

* Update Main.hs

* Update Tetris.hs

* Update Game.hs

* Update Game.hs

* Update Game.hs

* Update Game.hs

* Update PickLevel.hs

* Update Game.hs

* Update Game.hs

app/Main.hs

@@ -9,7 +9,7 @@ import qualified System.Directory as D
 import System.FilePath ((</>))
 
 import Tetris (Game(..))
-import UI.PickLevel (pickLevel)
+import UI.PickLevel (pickLevel, LevelConfig(..))
 import UI.Game (playGame)
 
 data Opts = Opts
@@ -70,11 +70,11 @@ hdOptStr (CustomChars s) = Just s
 
 main :: IO ()
 main = do
-  (Opts hd ml hs) <- execParser fullopts           -- get CLI opts/args
-  when hs (getHighScore >>= printM >> exitSuccess) -- show high score and exit
-  l <- maybe pickLevel return ml                   -- pick level prompt if necessary
-  g <- playGame l (hdOptStr hd)                    -- play game
-  handleEndGame (_score g)                         -- save & print score
+  (Opts hd ml hs) <- execParser fullopts
+  when hs (getHighScore >>= printM >> exitSuccess)                                  -- show high score and exit
+  levelConfig <- maybe pickLevel (\l -> return $ LevelConfig l False) ml            -- pick level prompt if necessary
+  g <- playGame (levelNumber levelConfig) (hdOptStr hd) (progression levelConfig)   -- play game
+  handleEndGame (_score g)                                                          -- save & print score
 
 handleEndGame :: Int -> IO ()
 handleEndGame s = do

src/Tetris.hs

@@ -25,7 +25,7 @@ module Tetris
   , Tetrimino(..)
   , Tetris
   -- Lenses
-  , block, board, level, nextShape, score, shape, linesCleared
+  , block, board, level, nextShape, score, shape, linesCleared, progression
   -- Constants
   , boardHeight, boardWidth, relCells
   ) where
@@ -82,6 +82,7 @@ data Game = Game
   , _linesCleared :: Int
   , _score        :: Int
   , _board        :: Board
+  , _progression  :: Bool
   } deriving (Eq)
 makeLenses ''Game
 
@@ -161,8 +162,8 @@ bagFourTetriminoEach Empty =
   bagFourTetriminoEach <=< shuffle . Seq.fromList . take 28 $ cycle [I ..]
 
 -- | Initialize a game with a given level
-initGame :: Int -> IO Game
-initGame lvl = do
+initGame :: Int -> Bool -> IO Game 
+initGame lvl prog = do
   (s1, bag1) <- bagFourTetriminoEach mempty
   (s2, bag2) <- bagFourTetriminoEach bag1
   pure $ Game
@@ -173,6 +174,7 @@ initGame lvl = do
     , _score        = 0
     , _linesCleared = 0
     , _board        = mempty
+    , _progression  = prog  
     }
 
 -- | Increment level
@@ -191,9 +193,12 @@ timeStep = do
     True -> do
       freezeBlock
       clearFullRows >>= updateScore
-      levelFinished >>= \case
-        True -> nextLevel
-        False -> nextBlock
+      prog <- use progression
+      when prog $ do
+        levelFinished >>= \case
+          True -> nextLevel
+          False -> pure ()
+      nextBlock
 
 -- | Gravitate current block, i.e. shift down
 gravitate :: MonadState Game m => m ()
@@ -235,9 +240,13 @@ updateScore lines = do
 -- | Using the fixed-goal system described here: https://tetris.wiki/Marathon
 levelFinished :: (MonadState Game m, MonadIO m) => m Bool
 levelFinished = do
-  lvl <- use level
-  lc <- use linesCleared
-  pure $ lvl < 15 && lc >= 10 * (lvl + 1)
+  prog <- use progression
+  if not prog
+    then pure False
+    else do
+      lvl <- use level
+      lc <- use linesCleared
+      pure $ lvl < 15 && lc >= 10 * (lvl + 1)
 
 -- | Handle counterclockwise block rotation (if possible)
 -- Allows wallkicks: http://tetris.wikia.com/wiki/TGM_rotation

src/UI/Game.hs

@@ -30,12 +30,12 @@ import Linear.V2 (V2(..))
 import Tetris
 
 data UI = UI
-  { _game      :: Game         -- ^ tetris game
-  , _initLevel :: Int          -- ^ initial level chosen
-  , _currLevel :: TVar Int     -- ^ current level
-  , _preview   :: Maybe String -- ^ hard drop preview cell
-  , _locked    :: Bool         -- ^ lock after hard drop before time step
-  , _paused    :: Bool         -- ^ game paused
+  { _game      :: Game
+  , _initLevel :: Int
+  , _currLevel :: TVar Int
+  , _preview   :: Maybe String
+  , _locked    :: Bool
+  , _paused    :: Bool
   }
 
 makeLenses ''UI
@@ -61,28 +61,27 @@ app = App
   , appAttrMap      = const theMap
   }
 
-playGame
-  :: Int -- ^ Starting level
-  -> Maybe String -- ^ Preview cell (Nothing == no preview)
-  -> IO Game
-playGame lvl mp = do
-  chan <- newBChan 10
-  -- share the current level with the thread so it can adjust speed
+playGame :: Int          -- ^ Starting level
+          -> Maybe String  -- ^ Preview cell (Nothing == no preview)
+          -> Bool         -- ^ Enable level progression
+          -> IO Game
+playGame lvl mp prog = do
+  chan <- newBChan 10   -- share the current level with the thread so it can adjust speed
   tv <- newTVarIO lvl
   void . forkIO $ forever $ do
     writeBChan chan Tick
     lvl <- readTVarIO tv
     threadDelay $ levelToDelay lvl
-  initialGame <- initGame lvl
+  initialGame <- initGame lvl prog  -- Pass the progression parameter
   let buildVty = Graphics.Vty.CrossPlatform.mkVty Graphics.Vty.Config.defaultConfig
   initialVty <- buildVty
   ui <- customMain initialVty buildVty (Just chan) app $ UI
-    { _game    = initialGame
+    { _game      = initialGame
     , _initLevel = lvl
     , _currLevel = tv
-    , _preview = mp
-    , _locked  = False
-    , _paused  = False
+    , _preview   = mp
+    , _locked    = False
+    , _paused    = False
     }
   return $ ui ^. game
 
@@ -129,8 +128,9 @@ exec = unlessM (orM [use paused, use locked, use (game . to isGameOver)]) . zoom
 -- | Restart game at the initially chosen level
 restart :: EventM Name UI ()
 restart = do
-  lvl <- use $ initLevel
-  g <- liftIO $ initGame lvl
+  lvl <- use initLevel
+  prog <- use (game . progression)  -- Get current progression setting
+  g <- liftIO $ initGame lvl prog   -- Use it when restarting
   assign game g
   assign locked False
 
@@ -214,9 +214,18 @@ drawStats g =
         [ drawStat "Score" $ g ^. score
         , padTop (Pad 1) $ drawStat "Lines" $ g ^. linesCleared
         , padTop (Pad 1) $ drawStat "Level" $ g ^. level
+        , padTop (Pad 1) $ drawProgression (g ^. progression)
         , drawLeaderBoard g
         ]
 
+drawProgression :: Bool -> Widget Name
+drawProgression True =
+    padLeftRight 1 $ str "Level Mode: " <+>
+    withAttr progressionAttr (padLeft Max $ str "ON")
+drawProgression False =
+    padLeftRight 1 $ str "Level Mode: " <+>
+    withAttr fixedAttr (padLeft Max $ str "Fixed")
+
 drawStat :: String -> Int -> Widget Name
 drawStat s n = padLeftRight 1 $ str s <+> padLeft Max (str $ show n)
 
@@ -278,21 +287,23 @@ drawGameOver g =
 theMap :: AttrMap
 theMap = attrMap
   V.defAttr
-  [ (iAttr       , tToColor I `on` tToColor I)
-  , (oAttr       , tToColor O `on` tToColor O)
-  , (tAttr       , tToColor T `on` tToColor T)
-  , (sAttr       , tToColor S `on` tToColor S)
-  , (zAttr       , tToColor Z `on` tToColor Z)
-  , (jAttr       , tToColor J `on` tToColor J)
-  , (lAttr       , tToColor L `on` tToColor L)
-  , (ihAttr      , fg $ tToColor I)
-  , (ohAttr      , fg $ tToColor O)
-  , (thAttr      , fg $ tToColor T)
-  , (shAttr      , fg $ tToColor S)
-  , (zhAttr      , fg $ tToColor Z)
-  , (jhAttr      , fg $ tToColor J)
-  , (lhAttr      , fg $ tToColor L)
-  , (gameOverAttr, fg V.red `V.withStyle` V.bold)
+  [ (iAttr          , tToColor I `on` tToColor I)
+  , (oAttr          , tToColor O `on` tToColor O)
+  , (tAttr          , tToColor T `on` tToColor T)
+  , (sAttr          , tToColor S `on` tToColor S)
+  , (zAttr          , tToColor Z `on` tToColor Z)
+  , (jAttr          , tToColor J `on` tToColor J)
+  , (lAttr          , tToColor L `on` tToColor L)
+  , (ihAttr         , fg $ tToColor I)
+  , (ohAttr         , fg $ tToColor O)
+  , (thAttr         , fg $ tToColor T)
+  , (shAttr         , fg $ tToColor S)
+  , (zhAttr         , fg $ tToColor Z)
+  , (jhAttr         , fg $ tToColor J)
+  , (lhAttr         , fg $ tToColor L)
+  , (gameOverAttr   , fg V.red `V.withStyle` V.bold)
+  , (progressionAttr, fg V.green `V.withStyle` V.bold)
+  , (fixedAttr      , fg V.blue `V.withStyle` V.bold)
   ]
 
 tToColor :: Tetrimino -> V.Color
@@ -327,3 +338,7 @@ emptyAttr = attrName "empty"
 
 gameOverAttr :: AttrName
 gameOverAttr = attrName "gameOver"
+
+progressionAttr, fixedAttr :: AttrName
+progressionAttr = attrName "progression"
+fixedAttr = attrName "fixed"

src/UI/PickLevel.hs

@@ -1,5 +1,6 @@
 module UI.PickLevel
   ( pickLevel
+  , LevelConfig(..)
   ) where
 
 import System.Exit (exitSuccess)
@@ -11,17 +12,39 @@ import qualified Brick.Widgets.Border.Style as BS
 import qualified Brick.Widgets.Center as C
 import qualified Graphics.Vty as V
 
-app :: App (Maybe Int) e ()
+data LevelConfig = LevelConfig
+  { levelNumber :: Int
+  , progression :: Bool
+  } deriving (Show, Eq)
+
+data MenuOption = YesOption | NoOption deriving (Eq)
+
+data PickState = PickState
+  { currentLevel :: Maybe Int
+  , showProgression :: Bool
+  , pickingLevel :: Bool
+  , selectedOption :: MenuOption
+  }
+
+app :: App PickState e ()
 app = App
-  { appDraw         = const [ui]
+  { appDraw         = drawUI
   , appHandleEvent  = handleEvent
   , appStartEvent   = pure ()
-  , appAttrMap      = const $ attrMap V.defAttr []
+  , appAttrMap      = const $ attrMap V.defAttr
+      [ (selectedAttr, V.black `on` V.white)
+      ]
   , appChooseCursor = neverShowCursor
   }
 
-ui :: Widget ()
-ui =
+selectedAttr :: AttrName
+selectedAttr = attrName "selected"
+
+drawUI :: PickState -> [Widget ()]
+drawUI ps = [ui ps]
+
+ui :: PickState -> Widget ()
+ui ps =
   padLeft (Pad 19)
     $ padRight (Pad 21)
     $ C.center
@@ -30,17 +53,69 @@ ui =
     $ withBorderStyle BS.unicodeBold
     $ B.borderWithLabel (str "Tetris")
     $ C.center
-    $ str " Choose Level (0-9)"
+    $ vBox
+    [ if pickingLevel ps
+        then str "Choose Level (0-9)"
+        else vBox
+          [ str "Level Progression?"
+          , str ""
+          , C.hCenter $ drawOption "YES" YesOption (selectedOption ps)
+          , C.hCenter $ drawOption "NO" NoOption (selectedOption ps)
+          , str ""
+          , C.hCenter $ str "Use ↑↓ or j/k"
+          , C.hCenter $ str "to Select."
+          , str ""
+          , C.hCenter $ str "Press Enter"
+          , C.hCenter $ str "to Continue."
+          ]
+    ]
+
+drawOption :: String -> MenuOption -> MenuOption -> Widget ()
+drawOption label opt current =
+  withAttr (if opt == current then selectedAttr else attrName "")
+    $ str $ "  " ++ label ++ "  "
 
-handleEvent :: BrickEvent () e -> EventM () (Maybe Int) ()
+handleEvent :: BrickEvent () e -> EventM () PickState ()
 handleEvent (VtyEvent (V.EvKey V.KEsc        _)) = halt
 handleEvent (VtyEvent (V.EvKey (V.KChar 'q') _)) = halt
 handleEvent (VtyEvent (V.EvKey (V.KChar 'Q') _)) = halt
 handleEvent (VtyEvent (V.EvKey (V.KChar d) [])) =
-  when (d `elem` ['0' .. '9']) $ do
-    put $ Just $ read [d]
-    halt
+  whenPickingLevel $ when (d `elem` ['0' .. '9']) $ do
+    modify $ \s -> s { currentLevel = Just $ read [d], pickingLevel = False }
+handleEvent (VtyEvent (V.EvKey V.KEnter [])) = do
+  s <- get
+  when (not $ pickingLevel s) $ do
+    case currentLevel s of
+      Just l -> do
+        put $ PickState (Just l) (selectedOption s == YesOption) True YesOption
+        halt
+      Nothing -> pure ()
+handleEvent (VtyEvent (V.EvKey V.KUp [])) =
+  whenNotPickingLevel $ modify $ \s -> s { selectedOption = YesOption }
+handleEvent (VtyEvent (V.EvKey V.KDown [])) =
+  whenNotPickingLevel $ modify $ \s -> s { selectedOption = NoOption }
+handleEvent (VtyEvent (V.EvKey (V.KChar 'j') [])) =
+  whenNotPickingLevel $ modify $ \s -> s { selectedOption = YesOption }
+handleEvent (VtyEvent (V.EvKey (V.KChar 'k') [])) =
+  whenNotPickingLevel $ modify $ \s -> s { selectedOption = NoOption }
 handleEvent _ = pure ()
 
-pickLevel :: IO Int
-pickLevel = defaultMain app Nothing >>= maybe exitSuccess return
+whenPickingLevel :: EventM () PickState () -> EventM () PickState ()
+whenPickingLevel action = do
+  picking <- gets pickingLevel
+  when picking action
+
+whenNotPickingLevel :: EventM () PickState () -> EventM () PickState ()
+whenNotPickingLevel action = do
+  picking <- gets pickingLevel
+  when (not picking) action
+
+initialState :: PickState
+initialState = PickState Nothing True True YesOption
+
+pickLevel :: IO LevelConfig
+pickLevel = do
+  result <- defaultMain app initialState
+  case currentLevel result of
+    Nothing -> exitSuccess
+    Just l -> return $ LevelConfig l (showProgression result)

tetris.cabal

@@ -1,5 +1,5 @@
 name:                tetris
-version:             0.1.5
+version:             0.1.6
 homepage:            https://github.com/samtay/tetris#readme
 license:             BSD3
 license-file:        LICENSE