Improve help modal (#633)

Improve the Help (F1) modal dialog.

- Get rid of the list of commands; they are now available in Commands modal
- Improve formatting of keybindings list, and add more global keybindings to the list
- Add some text with pointers to the wiki and IRC
- Display current seed (closes #359)
- Display current web API port

src/Swarm/App.hs

@@ -11,7 +11,7 @@ module Swarm.App where
 import Brick
 import Brick.BChan
 import Control.Concurrent (forkIO, threadDelay)
-import Control.Lens ((^.))
+import Control.Lens ((&), (.~), (^.))
 import Control.Monad.Except
 import Data.IORef (newIORef, writeIORef)
 import Data.Text.IO qualified as T
@@ -40,8 +40,8 @@ app eventHandler =
 -- | The main @IO@ computation which initializes the state, sets up
 --   some communication channels, and runs the UI.
 appMain :: Maybe Port -> Maybe Seed -> Maybe String -> Maybe String -> Bool -> IO ()
-appMain port seed scenario toRun cheat = do
-  res <- runExceptT $ initAppState seed scenario toRun cheat
+appMain port mseed scenario toRun cheat = do
+  res <- runExceptT $ initAppState mseed scenario toRun cheat
   case res of
     Left errMsg -> T.putStrLn errMsg
     Right s -> do
@@ -67,30 +67,33 @@ appMain port seed scenario toRun cheat = do
 
       -- Start the web service with a reference to the game state
       gsRef <- newIORef (s ^. gameState)
-      Swarm.Web.startWebThread port gsRef
+      mport <- Swarm.Web.startWebThread port gsRef
+
+      let s' = s & uiState . uiPort .~ mport
 
       -- Update the reference for every event
       let eventHandler e = do
-            s' <- get
-            liftIO $ writeIORef gsRef (s' ^. gameState)
+            curSt <- get
+            liftIO $ writeIORef gsRef (curSt ^. gameState)
             handleEvent e
 
       -- Run the app.
       let buildVty = V.mkVty V.defaultConfig
       initialVty <- buildVty
       V.setMode (V.outputIface initialVty) V.Mouse True
-      void $ customMain initialVty buildVty (Just chan) (app eventHandler) s
+      void $ customMain initialVty buildVty (Just chan) (app eventHandler) s'
 
 -- | A demo program to run the web service directly, without the terminal application.
 -- This is useful to live update the code using `ghcid -W --test "Swarm.App.demoWeb"`
 demoWeb :: IO ()
 demoWeb = do
+  let demoPort = 8080
   res <- runExceptT $ initAppState Nothing demoScenario Nothing True
   case res of
     Left errMsg -> T.putStrLn errMsg
     Right s -> do
       gsRef <- newIORef (s ^. gameState)
-      webMain Nothing 8080 gsRef
+      webMain Nothing demoPort gsRef
  where
   demoScenario = Just "./data/scenarios/Testing/475-wait-one.yaml"
 

src/Swarm/Game/State.hs

@@ -44,6 +44,7 @@ module Swarm.Game.State (
   messageNotifications,
   allDiscoveredEntities,
   gensym,
+  seed,
   randGen,
   adjList,
   nameList,
@@ -261,6 +262,7 @@ data GameState = GameState
   , _availableRecipes :: Notifications (Recipe Entity)
   , _availableCommands :: Notifications Const
   , _gensym :: Int
+  , _seed :: Seed
   , _randGen :: StdGen
   , _adjList :: Array Int Text
   , _nameList :: Array Int Text
@@ -371,6 +373,10 @@ waitingRobots = internalWaitingRobots
 -- | A counter used to generate globally unique IDs.
 gensym :: Lens' GameState Int
 
+-- | The initial seed that was used for the random number generator,
+--   and world generation.
+seed :: Lens' GameState Seed
+
 -- | Pseudorandom generator initialized at start.
 randGen :: Lens' GameState StdGen
 
@@ -660,6 +666,7 @@ initGameState = do
       , _activeRobots = IS.empty
       , _waitingRobots = M.empty
       , _gensym = 0
+      , _seed = 0
       , _randGen = mkStdGen 0
       , _adjList = listArray (0, length adjs - 1) adjs
       , _nameList = listArray (0, length names - 1) names
@@ -686,7 +693,7 @@ scenarioToGameState scenario userSeed toRun g = do
   --   1. seed value provided by the user
   --   2. seed value specified in the scenario description
   --   3. randomly chosen seed value
-  seed <- case userSeed <|> scenario ^. scenarioSeed of
+  theSeed <- case userSeed <|> scenario ^. scenarioSeed of
     Just s -> return s
     Nothing -> randomRIO (0, maxBound :: Int)
 
@@ -707,11 +714,12 @@ scenarioToGameState scenario userSeed toRun g = do
       , _availableCommands = Notifications 0 initialCommands
       , _waitingRobots = M.empty
       , _gensym = initGensym
-      , _randGen = mkStdGen seed
+      , _seed = theSeed
+      , _randGen = mkStdGen theSeed
       , _entityMap = em
       , _recipesOut = addRecipesWith outRecipeMap recipesOut
       , _recipesIn = addRecipesWith inRecipeMap recipesIn
-      , _world = theWorld seed
+      , _world = theWorld theSeed
       , _viewCenterRule = VCRobot baseID
       , _viewCenter = V2 0 0
       , _needsRedraw = False

src/Swarm/TUI/Model.hs

@@ -66,6 +66,7 @@ module Swarm.TUI.Model (
 
   -- ** UI Model
   UIState,
+  uiPort,
   uiMenu,
   uiPlaying,
   uiNextScenario,
@@ -147,6 +148,7 @@ import Data.Sequence qualified as Seq
 import Data.Text (Text)
 import Data.Text qualified as T
 import Data.Vector qualified as V
+import Network.Wai.Handler.Warp (Port)
 import Swarm.Game.Entity as E
 import Swarm.Game.Robot
 import Swarm.Game.Scenario (Scenario, ScenarioItem, loadScenario)
@@ -451,7 +453,8 @@ makePrisms ''InventoryListEntry
 -- | The main record holding the UI state.  For access to the fields,
 -- see the lenses below.
 data UIState = UIState
-  { _uiMenu :: Menu
+  { _uiPort :: Maybe Port
+  , _uiMenu :: Menu
   , _uiPlaying :: Bool
   , _uiNextScenario :: Maybe Scenario
   , _uiCheatMode :: Bool
@@ -501,6 +504,9 @@ let exclude = ['_lgTicksPerSecond]
       )
       ''UIState
 
+-- | The port on which the HTTP debug service is running.
+uiPort :: Lens' UIState (Maybe Port)
+
 -- | The current menu state.
 uiMenu :: Lens' UIState Menu
 
@@ -704,7 +710,8 @@ initUIState showMainMenu cheatMode = liftIO $ do
   startTime <- getTime Monotonic
   return $
     UIState
-      { _uiMenu = if showMainMenu then MainMenu (mainMenu NewGame) else NoMenu
+      { _uiPort = Nothing
+      , _uiMenu = if showMainMenu then MainMenu (mainMenu NewGame) else NoMenu
       , _uiPlaying = not showMainMenu
       , _uiNextScenario = Nothing
       , _uiCheatMode = cheatMode

src/Swarm/TUI/View.hs

@@ -66,6 +66,7 @@ import Data.Text (Text)
 import Data.Text qualified as T
 import Graphics.Vty qualified as V
 import Linear
+import Network.Wai.Handler.Warp (Port)
 import Swarm.Game.CESK (CESK (..))
 import Swarm.Game.Display
 import Swarm.Game.Entity as E
@@ -87,7 +88,7 @@ import Swarm.Util
 import System.Clock (TimeSpec (..))
 import Text.Printf
 import Text.Wrap
-import Witch (from)
+import Witch (from, into)
 
 -- | The main entry point for drawing the entire UI.  Figures out
 --   which menu screen we should show (if any), or just the game itself.
@@ -334,7 +335,7 @@ maybeScroll vpName contents =
 -- | Draw one of the various types of modal dialog.
 drawModal :: AppState -> ModalType -> Widget Name
 drawModal s = \case
-  HelpModal -> helpWidget
+  HelpModal -> helpWidget (s ^. gameState . seed) (s ^. uiState . uiPort)
   RobotsModal -> robotsListWidget s
   RecipesModal -> availableListWidget (s ^. gameState) RecipeList
   CommandsModal -> availableListWidget (s ^. gameState) CommandList
@@ -359,9 +360,10 @@ generateModal s mt = Modal mt (dialog (Just title) buttons (maxModalWindowWidth
     NoMenu -> Just "Quit"
     _ -> Nothing
   descriptionWidth = 100
+  helpWidth = 80
   (title, buttons, requiredWidth) =
     case mt of
-      HelpModal -> (" Help ", Nothing, maxModalWindowWidth)
+      HelpModal -> (" Help ", Nothing, helpWidth)
       RobotsModal -> ("Robots", Nothing, descriptionWidth)
       RecipesModal -> ("Available Recipes", Nothing, descriptionWidth)
       CommandsModal -> ("Available Commands", Nothing, descriptionWidth)
@@ -465,43 +467,56 @@ robotsListWidget s = hCenter table
   debugging = creative && cheat
   g = s ^. gameState
 
-helpWidget :: Widget Name
-helpWidget = helpKeys <+> helpCommands
+helpWidget :: Seed -> Maybe Port -> Widget Name
+helpWidget theSeed mport =
+  padTop (Pad 1) $
+    (hBox . map (padLeftRight 2) $ [helpKeys, info])
+      <=> padTop (Pad 1) (hCenter tips)
  where
+  tips =
+    vBox
+      [ txt "Have questions? Want some tips? Check out:"
+      , txt " "
+      , txt "  - The Swarm wiki, https://github.com/swarm-game/swarm/wiki"
+      , txt "  - The #swarm IRC channel on Libera.Chat"
+      ]
+  info =
+    vBox
+      [ txt "Configuration"
+      , txt " "
+      , txt ("Seed: " <> into @Text (show theSeed))
+      , txt ("Web server port: " <> maybe "none" (into @Text . show) mport)
+      ]
   helpKeys =
     vBox
-      [ hCenter $ txt "Global Keybindings"
-      , hCenter $ mkTable glKeyBindings
+      [ txt "Keybindings"
+      , txt " "
+      , mkTable glKeyBindings
       ]
-  mkTable = BT.renderTable . BT.table . map toWidgets
-  toWidgets (k, v) = [txt k, txt v]
+  mkTable =
+    BT.renderTable
+      . BT.surroundingBorder False
+      . BT.rowBorders False
+      . BT.table
+      . map toRow
+  toRow (k, v) = [padRight (Pad 1) $ txt k, padLeft (Pad 1) $ txt v]
   glKeyBindings =
     [ ("F1", "Help")
     , ("F2", "Robots list")
     , ("F3", "Available recipes")
     , ("F4", "Available commands")
     , ("F5", "Messages")
     , ("Ctrl-g", "show goal")
+    , ("Ctrl-p", "pause")
+    , ("Ctrl-o", "single step")
+    , ("Ctrl-z", "decrease speed")
+    , ("Ctrl-w", "increase speed")
     , ("Ctrl-q", "quit the game")
     , ("Meta-w", "focus on the world map")
     , ("Meta-e", "focus on the robot inventory")
     , ("Meta-r", "focus on the REPL")
     , ("Meta-t", "focus on the info panel")
     ]
-  helpCommands =
-    vBox
-      [ hCenter $ txt "Commands"
-      , hCenter $ mkTable baseCommands
-      ]
-  baseCommands =
-    [ ("build {<commands>}", "Create a robot")
-    , ("make \"<name>\"", "Craft an item")
-    , ("move", "Move one step in the current direction")
-    , ("turn <dir>", "Change the current direction")
-    , ("grab", "Grab whatver is available")
-    , ("give <robot> \"<item>\"", "Give an item to another robot")
-    , ("has \"<item>\"", "Check for an item in the inventory")
-    ]
 
 data NotificationList = RecipeList | CommandList | MessageList
 
@@ -592,8 +607,8 @@ drawModalMenu s = vLimit 1 . hBox $ map (padLeftRight 1 . drawKeyCmd) globalKeyC
 
   globalKeyCmds =
     catMaybes
-      [ Just (NoHighlight, "F1", "help")
-      , Just (NoHighlight, "F2", "robots")
+      [ Just (NoHighlight, "F1", "Help")
+      , Just (NoHighlight, "F2", "Robots")
       , notificationKey availableRecipes "F3" "Recipes"
       , notificationKey availableCommands "F4" "Commands"
       , notificationKey messageNotifications "F5" "Messages"

src/Swarm/Web.hs

@@ -26,6 +26,7 @@ import Control.Monad (void)
 import Control.Monad.IO.Class (liftIO)
 import Data.IORef (IORef, readIORef)
 import Data.IntMap qualified as IM
+import Data.Maybe (fromMaybe)
 import Network.Wai qualified
 import Network.Wai.Handler.Warp qualified as Warp
 import Servant
@@ -55,31 +56,30 @@ webMain baton port gsRef = do
   Warp.runSettings settings app
  where
   onReady = case baton of
-    Just mv -> Warp.setBeforeMainLoop $ do
-      putStrLn $ "Web interface listening on :" <> show port
-      putMVar mv ()
+    Just mv -> Warp.setBeforeMainLoop $ putMVar mv ()
     Nothing -> id
   app :: Network.Wai.Application
   app = Servant.serve (Proxy @SwarmApi) (mkApp gsRef)
 
 defaultPort :: Warp.Port
 defaultPort = 5357
 
-startWebThread :: Maybe Warp.Port -> IORef GameState -> IO ()
+-- | Attempt to start a web thread on the requested port, or a default
+--   one if none is requested (or don't start a web thread if the
+--   requested port is 0).  If an explicit port was requested, fail if
+--   startup doesn't work.  Otherwise, ignore the failure.  In any
+--   case, return a @Maybe Port@ value representing whether a web
+--   server is actually running, and if so, what port it is on.
+startWebThread :: Maybe Warp.Port -> IORef GameState -> IO (Maybe Warp.Port)
+-- User explicitly provided port '0': don't run the web server
+startWebThread (Just 0) _ = pure Nothing
 startWebThread portM gsRef = do
-  res <- go
-  case res of
-    Nothing -> fail "Fail to start the web api"
-    Just _ -> pure ()
- where
-  go = case portM of
-    Just 0 -> pure (Just ())
-    Just port -> do
-      -- The user provided a port, so we ensure the api does starts
-      baton <- newEmptyMVar
-      void $ forkIO $ webMain (Just baton) port gsRef
-      timeout 500_000 (takeMVar baton)
-    Nothing -> do
-      -- No port was given, the api may fail to start
-      void $ forkIO $ webMain Nothing defaultPort gsRef
-      pure (Just ())
+  baton <- newEmptyMVar
+  let port = fromMaybe defaultPort portM
+  void $ forkIO $ webMain (Just baton) port gsRef
+  res <- timeout 500_000 (takeMVar baton)
+  case (portM, res) of
+    -- User requested explicit port but server didn't start: fail
+    (Just _, Nothing) -> fail $ "Failed to start the web API  on :" <> show port
+    -- Otherwise, just report whether the server is running, and if so, on what port
+    _ -> return (port <$ res)