add goal field to scenarios

If there is a goal, immediately pop up a dialog with the goal, then
allow showing it any time afterwards with ^G.

See #356.

Author: byorgey

src/Swarm/Game/Entity.hs

@@ -115,7 +115,7 @@ import Swarm.Util.Yaml
 import Swarm.Game.Display
 import Swarm.Language.Capability
 import Swarm.Language.Syntax (toDirection)
-import Swarm.Util (plural, (?))
+import Swarm.Util (plural, reflow, (?))
 
 import Paths_swarm
 
@@ -339,8 +339,6 @@ instance FromJSON Entity where
               <*> v .:? "capabilities" .!= []
               <*> pure empty
           )
-   where
-    reflow = T.unwords . T.words
 
 -- | If we have access to an 'EntityMap', we can parse the name of an
 --   'Entity' as a string and look it up in the map.

src/Swarm/Game/Scenario.hs

@@ -27,6 +27,7 @@ module Swarm.Game.Scenario (
   -- ** Fields
   scenarioName,
   scenarioDescription,
+  scenarioGoal,
   scenarioCreative,
   scenarioSeed,
   scenarioEntities,
@@ -78,13 +79,15 @@ import Swarm.Game.Terrain
 import Swarm.Game.World
 import Swarm.Game.WorldGen (Seed, findGoodOrigin, testWorld2FromArray)
 import Swarm.Language.Pipeline (ProcessedTerm)
+import Swarm.Util (reflow)
 import Swarm.Util.Yaml
 
 -- | A 'Scenario' contains all the information to describe a
 --   scenario.
 data Scenario = Scenario
   { _scenarioName :: Text
   , _scenarioDescription :: Text
+  , _scenarioGoal :: Maybe [Text]
   , _scenarioCreative :: Bool -- Maybe generalize this to a mode enumeration
   , _scenarioSeed :: Maybe Int
   , _scenarioEntities :: EntityMap
@@ -103,6 +106,7 @@ instance FromJSONE EntityMap Scenario where
     Scenario
       <$> liftE (v .: "name")
       <*> liftE (v .:? "description" .!= "")
+      <*> liftE ((fmap . fmap . map) reflow (v .:? "goal"))
       <*> liftE (v .:? "creative" .!= False)
       <*> liftE (v .:? "seed")
       <*> pure em
@@ -115,9 +119,14 @@ instance FromJSONE EntityMap Scenario where
 -- | The name of the scenario.
 scenarioName :: Lens' Scenario Text
 
--- | A description of the scenario.
+-- | A high-level description of the scenario, shown /e.g./ in the
+--   menu.
 scenarioDescription :: Lens' Scenario Text
 
+-- | An explanation of the goal of the scenario (if any), shown to the
+--   player during play.
+scenarioGoal :: Lens' Scenario (Maybe [Text])
+
 -- | Whether the scenario should start in creative mode.
 scenarioCreative :: Lens' Scenario Bool
 

src/Swarm/Game/State.hs

@@ -24,6 +24,9 @@ module Swarm.Game.State (
   _WinCondition,
   _Won,
   RunStatus (..),
+  GoalStatus (..),
+  goalNeedsDisplay,
+  markGoalRead,
   GameState,
   Seed,
   initGameState,
@@ -32,6 +35,7 @@ module Swarm.Game.State (
 
   -- ** GameState fields
   creativeMode,
+  gameGoal,
   winCondition,
   winSolution,
   runStatus,
@@ -162,11 +166,34 @@ data RunStatus
     AutoPause
   deriving (Eq, Show)
 
+-- | Status of the scenario goal: whether there is one, and whether it has been
+--   displayed to the user initially.
+data GoalStatus
+  = -- | There is no goal.
+    NoGoal
+  | -- | There is a goal, and we should display it to the user initially.
+    UnreadGoal [Text]
+  | -- | There is a goal, and we have already displayed it to the user.
+    --   It can be displayed again if the user chooses.
+    ReadGoal [Text]
+  deriving (Eq, Show)
+
+-- | Do we need to display the goal initially to the user?
+goalNeedsDisplay :: GoalStatus -> Maybe [Text]
+goalNeedsDisplay (UnreadGoal g) = Just g
+goalNeedsDisplay _ = Nothing
+
+-- | Mark the goal as having been read.
+markGoalRead :: GoalStatus -> GoalStatus
+markGoalRead (UnreadGoal g) = ReadGoal g
+markGoalRead gs = gs
+
 -- | The main record holding the state for the game itself (as
 --   distinct from the UI).  See the lenses below for access to its
 --   fields.
 data GameState = GameState
   { _creativeMode :: Bool
+  , _gameGoal :: GoalStatus
   , _winCondition :: WinCondition
   , _winSolution :: Maybe ProcessedTerm
   , _runStatus :: RunStatus
@@ -220,6 +247,10 @@ let exclude = ['_viewCenter, '_focusedRobotID, '_viewCenterRule, '_activeRobots,
 -- | Is the user in creative mode (i.e. able to do anything without restriction)?
 creativeMode :: Lens' GameState Bool
 
+-- | Status of the scenario goal: whether there is one, and whether it
+--   has been displayed to the user initially.
+gameGoal :: Lens' GameState GoalStatus
+
 -- | How to determine whether the player has won.
 winCondition :: Lens' GameState WinCondition
 
@@ -377,7 +408,7 @@ viewingRegion :: GameState -> (Int64, Int64) -> (W.Coords, W.Coords)
 viewingRegion g (w, h) = (W.Coords (rmin, cmin), W.Coords (rmax, cmax))
  where
   V2 cx cy = g ^. viewCenter
-  (rmin, rmax) = over both (+ (- cy - h `div` 2)) (0, h - 1)
+  (rmin, rmax) = over both (+ (-cy - h `div` 2)) (0, h - 1)
   (cmin, cmax) = over both (+ (cx - w `div` 2)) (0, w - 1)
 
 -- | Find out which robot is currently specified by the
@@ -435,6 +466,7 @@ initGameState cmdlineSeed scenarioToLoad toRun = do
   let initState =
         GameState
           { _creativeMode = False
+          , _gameGoal = NoGoal
           , _winCondition = NoWinCondition
           , _winSolution = Nothing
           , _runStatus = Running
@@ -485,6 +517,7 @@ playScenario em scenario userSeed toRun g = do
   return $
     g
       { _creativeMode = scenario ^. scenarioCreative
+      , _gameGoal = maybe NoGoal UnreadGoal (scenario ^. scenarioGoal)
       , _winCondition = theWinCondition
       , _winSolution = scenario ^. scenarioSolution
       , _runStatus = Running

src/Swarm/TUI/Controller.hs

@@ -193,6 +193,8 @@ handleMainEvent :: AppState -> BrickEvent Name AppEvent -> EventM Name (Next App
 handleMainEvent s = \case
   AppEvent Frame
     | s ^. gameState . paused -> continueWithoutRedraw s
+    | Just g <- s ^. gameState . gameGoal . to goalNeedsDisplay ->
+      toggleModal s (GoalModal g) <&> (gameState . gameGoal %~ markGoalRead) >>= runFrameUI
     | otherwise -> runFrameUI s
   VtyEvent (V.EvResize _ _) -> do
     invalidateCacheEntry WorldCache
@@ -213,6 +215,10 @@ handleMainEvent s = \case
   -- toggle creative mode if in "cheat mode"
   ControlKey 'k'
     | s ^. uiState . uiCheatMode -> continue (s & gameState . creativeMode %~ not)
+  ControlKey 'g' -> case s ^. gameState . gameGoal of
+    NoGoal -> continueWithoutRedraw s
+    UnreadGoal g -> toggleModal s (GoalModal g) >>= continue
+    ReadGoal g -> toggleModal s (GoalModal g) >>= continue
   FKey 1 -> toggleModal s HelpModal >>= continue
   MouseDown n _ _ mouseLoc ->
     case n of

src/Swarm/TUI/Model.hs

@@ -309,6 +309,7 @@ data ModalType
   | WinModal
   | QuitModal
   | DescriptionModal Entity
+  | GoalModal [Text]
   deriving (Eq, Show)
 
 data ButtonSelection = Cancel | Confirm

src/Swarm/TUI/View.hs

@@ -319,6 +319,7 @@ generateModal s mt = Modal mt (dialog (Just title) buttons (maxModalWindowWidth
             , Just (0, [("Keep playing", Cancel), (stopMsg, Confirm)])
             , T.length quitMsg + 4
             )
+      GoalModal g -> (" Goal ", padLeftRight 1 (displayParagraphs g), Nothing, 80)
 
 helpWidget :: Widget Name
 helpWidget = (helpKeys <=> fill ' ') <+> (helpCommands <=> fill ' ')
@@ -381,6 +382,7 @@ drawKeyMenu s =
   viewingBase = (s ^. gameState . viewCenterRule) == VCRobot 0
   creative = s ^. gameState . creativeMode
   cheat = s ^. uiState . uiCheatMode
+  goal = (s ^. gameState . gameGoal) /= NoGoal
 
   gameModeWidget =
     padLeft Max . padLeftRight 1
@@ -394,6 +396,7 @@ drawKeyMenu s =
     , ("Tab", "cycle")
     ]
       ++ [("^k", "creative") | cheat]
+      ++ [("^g", "goal") | goal]
   keyCmdsFor (Just REPLPanel) =
     [ ("↓↑", "history")
     ]
@@ -571,7 +574,7 @@ explainFocusedItem s = case focusedItem s of
 
 explainEntry :: AppState -> Entity -> Widget Name
 explainEntry s e =
-  vBox (map (padBottom (Pad 1) . txtWrap) (e ^. entityDescription))
+  displayParagraphs (e ^. entityDescription)
     <=> explainRecipes s e
 
 explainRecipes :: AppState -> Entity -> Widget Name
@@ -730,3 +733,12 @@ drawREPL s =
   histIdx = fromString $ show (history ^. replIndex)
   fmt (REPLEntry e) = txt replPrompt <+> txt e
   fmt (REPLOutput t) = txt t
+
+------------------------------------------------------------
+-- Utility
+------------------------------------------------------------
+
+-- | Display a list of text-wrapped paragraphs with one blank line after
+--   each.
+displayParagraphs :: [Text] -> Widget Name
+displayParagraphs = vBox . map (padBottom (Pad 1) . txtWrap)

src/Swarm/Util.hs

@@ -32,6 +32,7 @@ module Swarm.Util (
   readAppData,
 
   -- * English language utilities
+  reflow,
   quote,
   squote,
   commaList,
@@ -167,6 +168,10 @@ readAppData = do
 ------------------------------------------------------------
 -- Some language-y stuff
 
+-- | Reflow text by removing newlines and condensing whitespace.
+reflow :: Text -> Text
+reflow = T.unwords . T.words
+
 -- | Prepend a noun with the proper indefinite article (\"a\" or \"an\").
 indefinite :: Text -> Text
 indefinite w = MM.indefiniteDet w <+> w