require --cheat flag to allow toggling creative mode with m key (#368)

Closes #360.

app/Main.hs

@@ -16,8 +16,11 @@ import Swarm.Language.Pipeline (processTerm)
 import System.Exit
 
 data CLI
-  = -- seed, challenge file, run file
-    Run (Maybe Int) (Maybe FilePath) (Maybe FilePath)
+  = Run
+      (Maybe Int) -- seed
+      (Maybe FilePath) -- scenario
+      (Maybe FilePath) -- file to run
+      Bool -- cheat mode
   | Format Input
   | LSP
 
@@ -27,7 +30,7 @@ cliParser =
     ( command "format" (info (format <**> helper) (progDesc "Format a file"))
         <> command "lsp" (info (pure LSP) (progDesc "Start the LSP"))
     )
-    <|> Run <$> seed <*> challenge <*> run
+    <|> Run <$> seed <*> scenario <*> run <*> cheat
  where
   format :: Parser CLI
   format =
@@ -35,10 +38,12 @@ cliParser =
       <|> (Format . File <$> strArgument (metavar "FILE"))
   seed :: Parser (Maybe Int)
   seed = optional $ option auto (long "seed" <> short 's' <> metavar "INT" <> help "Seed to use for world generation")
-  challenge :: Parser (Maybe String)
-  challenge = optional $ strOption (long "scenario" <> short 'c' <> metavar "FILE" <> help "Name of a scenario to load")
+  scenario :: Parser (Maybe String)
+  scenario = optional $ strOption (long "scenario" <> short 'c' <> metavar "FILE" <> help "Name of a scenario to load")
   run :: Parser (Maybe String)
   run = optional $ strOption (long "run" <> short 'r' <> metavar "FILE" <> help "Run the commands in a file at startup")
+  cheat :: Parser Bool
+  cheat = switch (long "cheat" <> short 'x' <> help "Enable cheat mode")
 
 cliInfo :: ParserInfo CLI
 cliInfo =
@@ -80,6 +85,6 @@ main :: IO ()
 main = do
   cli <- execParser cliInfo
   case cli of
-    Run seed challenge toRun -> appMain seed challenge toRun
+    Run seed scenario toRun cheat -> appMain seed scenario toRun cheat
     Format fo -> formatFile fo
     LSP -> lspMain

src/Swarm/App.hs

@@ -36,9 +36,9 @@ app =
 
 -- | The main @IO@ computation which initializes the state, sets up
 --   some communication channels, and runs the UI.
-appMain :: Maybe Seed -> Maybe String -> Maybe String -> IO ()
-appMain seed scenario toRun = do
-  res <- runExceptT $ initAppState seed scenario toRun
+appMain :: Maybe Seed -> Maybe String -> Maybe String -> Bool -> IO ()
+appMain seed scenario toRun cheat = do
+  res <- runExceptT $ initAppState seed scenario toRun cheat
   case res of
     Left errMsg -> T.putStrLn errMsg
     Right s -> do

src/Swarm/TUI/Controller.hs

@@ -188,6 +188,9 @@ handleMainEvent s = \case
   MetaKey 'e' -> setFocus s RobotPanel
   MetaKey 'r' -> setFocus s REPLPanel
   MetaKey 't' -> setFocus s InfoPanel
+  -- toggle creative mode if in "cheat mode"
+  ControlKey 'k'
+    | s ^. uiState . uiCheatMode -> continue (s & gameState . creativeMode %~ not)
   FKey 1 -> toggleModal s HelpModal >>= continue
   -- dispatch any other events to the focused panel handler
   ev ->
@@ -617,8 +620,6 @@ handleWorldEvent s = \case
   CharKey '.' -> continue $ adjustTPS (+) s
   -- show fps
   CharKey 'f' -> continue $ s & uiState . uiShowFPS %~ not
-  -- for testing only: toggle between classic & creative modes
-  CharKey 'm' -> continue (s & gameState . creativeMode %~ not)
   -- Fall-through case: don't do anything.
   _ -> continueWithoutRedraw s
 

src/Swarm/TUI/Model.hs

@@ -57,6 +57,7 @@ module Swarm.TUI.Model (
   -- ** UI Model
   UIState,
   uiMenu,
+  uiCheatMode,
   uiFocusRing,
   uiReplForm,
   uiReplType,
@@ -358,6 +359,7 @@ makePrisms ''InventoryListEntry
 -- see the lenses below.
 data UIState = UIState
   { _uiMenu :: Menu
+  , _uiCheatMode :: Bool
   , _uiFocusRing :: FocusRing Name
   , _uiReplForm :: Form Text AppEvent Name
   , _uiReplType :: Maybe Polytype
@@ -405,6 +407,9 @@ let exclude = ['_lgTicksPerSecond]
 -- | The current menu state.
 uiMenu :: Lens' UIState Menu
 
+-- | Cheat mode, i.e. are we allowed to turn creative mode on and off?
+uiCheatMode :: Lens' UIState Bool
+
 -- | The focus ring is the set of UI panels we can cycle among using
 --   the Tab key.
 uiFocusRing :: Lens' UIState (FocusRing Name)
@@ -565,8 +570,8 @@ initLgTicksPerSecond = 3 -- 2^3 = 8 ticks / second
 --   time, and loading text files from the data directory.  The @Bool@
 --   parameter indicates whether we should start off by showing the
 --   main menu.
-initUIState :: Bool -> ExceptT Text IO UIState
-initUIState showMainMenu = liftIO $ do
+initUIState :: Bool -> Bool -> ExceptT Text IO UIState
+initUIState showMainMenu cheatMode = liftIO $ do
   historyT <- readFileMayT =<< getSwarmHistoryPath False
   appDataMap <- readAppData
   let history = maybe [] (map REPLEntry . T.lines) historyT
@@ -574,6 +579,7 @@ initUIState showMainMenu = liftIO $ do
   return $
     UIState
       { _uiMenu = if showMainMenu then MainMenu (mainMenu NewGame) else NoMenu
+      , _uiCheatMode = cheatMode
       , _uiFocusRing = initFocusRing
       , _uiReplForm = initReplForm
       , _uiReplType = Nothing
@@ -656,7 +662,7 @@ populateInventoryList (Just r) = do
 ------------------------------------------------------------
 
 -- | Initialize the 'AppState'.
-initAppState :: Maybe Seed -> Maybe String -> Maybe String -> ExceptT Text IO AppState
-initAppState seed scenarioName toRun = do
+initAppState :: Maybe Seed -> Maybe String -> Maybe String -> Bool -> ExceptT Text IO AppState
+initAppState seed scenarioName toRun cheatMode = do
   let showMenu = isNothing scenarioName && isNothing toRun && isNothing seed
-  AppState <$> initGameState seed scenarioName toRun <*> initUIState showMenu
+  AppState <$> initGameState seed scenarioName toRun <*> initUIState showMenu cheatMode

src/Swarm/TUI/View.hs

@@ -358,6 +358,7 @@ drawKeyMenu s =
   isPaused = s ^. gameState . paused
   viewingBase = (s ^. gameState . viewCenterRule) == VCRobot 0
   creative = s ^. gameState . creativeMode
+  cheat = s ^. uiState . uiCheatMode
 
   gameModeWidget =
     padLeft Max . padLeftRight 1
@@ -370,6 +371,7 @@ drawKeyMenu s =
     [ ("F1", "help")
     , ("Tab", "cycle")
     ]
+      ++ [("^k", "creative") | cheat]
   keyCmdsFor (Just REPLPanel) =
     [ ("↓↑", "history")
     ]