Add available recipes help (#441)

This change adds a new help panel with the list of recently acquired recipes.

Fixes #436

Author: TristanCacqueray

src/Swarm/Game/Recipe.hs

@@ -33,6 +33,7 @@ module Swarm.Game.Recipe (
   inRecipeMap,
 
   -- * Looking up recipes
+  knowsIngredientsFor,
   recipesFor,
   make,
   make',
@@ -186,6 +187,13 @@ missingIngredientsFor (inv, ins) (Recipe inps _ reqs _ _) =
   findLacking inven = filter ((> 0) . fst) . map (countNeeded inven)
   countNeeded inven (need, entity) = (need - E.lookup entity inven, entity)
 
+-- | Figure out if a recipe is available, but it can be lacking items.
+knowsIngredientsFor :: (Inventory, Inventory) -> Recipe Entity -> Bool
+knowsIngredientsFor (inv, ins) recipe =
+  knowsAll inv (recipe ^. recipeInputs) && knowsAll ins (recipe ^. recipeRequirements)
+ where
+  knowsAll xs = all (E.contains xs . snd)
+
 -- | Try to make a recipe, deleting the recipe's inputs from the
 --   inventory. Return either a description of which items are
 --   lacking, if the inventory does not contain sufficient inputs,

src/Swarm/Game/State.hs

@@ -36,6 +36,9 @@ module Swarm.Game.State (
   robotMap,
   robotsByLocation,
   activeRobots,
+  availableRecipes,
+  availableRecipesNewCount,
+  allDiscoveredEntities,
   gensym,
   randGen,
   adjList,
@@ -197,6 +200,9 @@ data GameState = GameState
     -- append to a list than to a Set.
     _waitingRobots :: Map Integer [RID]
   , _robotsByLocation :: Map (V2 Int64) IntSet
+  , _allDiscoveredEntities :: Inventory
+  , _availableRecipes :: [Recipe Entity]
+  , _availableRecipesNewCount :: Int
   , _gensym :: Int
   , _randGen :: StdGen
   , _adjList :: Array Int Text
@@ -263,6 +269,15 @@ robotMap :: Lens' GameState (IntMap Robot)
 --   happen.
 robotsByLocation :: Lens' GameState (Map (V2 Int64) IntSet)
 
+-- | The list of entities that have been discovered.
+allDiscoveredEntities :: Lens' GameState Inventory
+
+-- | The list of available recipes.
+availableRecipes :: Lens' GameState [Recipe Entity]
+
+-- | The number of new recipes (reset to 0 when the player open the recipes view).
+availableRecipesNewCount :: Lens' GameState Int
+
 -- | The names of the robots that are currently not sleeping.
 activeRobots :: Getter GameState IntSet
 activeRobots = internalActiveRobots
@@ -512,6 +527,9 @@ initGameState = do
       , _runStatus = Running
       , _robotMap = IM.empty
       , _robotsByLocation = M.empty
+      , _availableRecipes = mempty
+      , _availableRecipesNewCount = 0
+      , _allDiscoveredEntities = empty
       , _activeRobots = IS.empty
       , _waitingRobots = M.empty
       , _gensym = 0

src/Swarm/Game/Step.hs

@@ -25,6 +25,7 @@ import Control.Monad (forM_, guard, msum, unless, when)
 import Data.Array (bounds, (!))
 import Data.Bool (bool)
 import Data.Either (rights)
+import Data.Foldable (traverse_)
 import qualified Data.Functor.Const as F
 import Data.Int (Int64)
 import qualified Data.IntMap as IM
@@ -752,6 +753,7 @@ execConst c vs s k = do
         Just n -> fromMaybe e <$> uses entityMap (lookupEntityName n)
 
       robotInventory %= insert e'
+      updateDiscoveredEntities e'
 
       -- Return the name of the item obtained.
       return $ Out (VString (e' ^. entityName)) s k
@@ -891,6 +893,7 @@ execConst c vs s k = do
 
         -- take recipe inputs from inventory and add outputs after recipeTime
         robotInventory .= invTaken
+        traverse_ (updateDiscoveredEntities . snd) (recipe ^. recipeOutputs)
         finishCookingRecipe recipe (WorldUpdate Right) (RobotUpdate changeInv)
       _ -> badConst
     Has -> case vs of
@@ -964,6 +967,7 @@ execConst c vs s k = do
           Nothing -> return $ VInj False VUnit
           Just e -> do
             robotInventory %= insertCount 0 e
+            updateDiscoveredEntities e
             return $ VInj True (VString (e ^. entityName))
 
         return $ Out res s k
@@ -1085,6 +1089,8 @@ execConst c vs s k = do
             `isJustOrFail` ["I've never heard of", indefiniteQ name <> "."]
 
         robotInventory %= insert e
+        updateDiscoveredEntities e
+
         return $ Out VUnit s k
       _ -> badConst
     Ishere -> case vs of
@@ -1627,3 +1633,33 @@ safeExp :: Has (Throw Exn) sig m => Integer -> Integer -> m Integer
 safeExp a b
   | b < 0 = throwError $ CmdFailed Exp "Negative exponent"
   | otherwise = return $ a ^ b
+
+-- | Update the global list of discovered entities, and check for new recipes.
+updateDiscoveredEntities :: (Has (State GameState) sig m, Has (State Robot) sig m) => Entity -> m ()
+updateDiscoveredEntities e = do
+  allDiscovered <- use allDiscoveredEntities
+  if E.contains0plus e allDiscovered
+    then pure ()
+    else do
+      let newAllDiscovered = E.insertCount 1 e allDiscovered
+      updateAvailableRecipes (newAllDiscovered, newAllDiscovered) e
+      allDiscoveredEntities .= newAllDiscovered
+
+-- | Update the availableRecipes list.
+-- This implementation is not efficient:
+-- * Every time we discover a new entity, we iterate through the entire list of recipes to see which ones we can make.
+--   Trying to do something more clever seems like it would definitely be a case of premature optimization.
+--   One doesn't discover new entities all that often.
+-- * For each usable recipe, we do a linear search through the list of known recipes to see if we already know it.
+--   This is a little more troubling, since it's quadratic in the number of recipes.
+--   But it probably doesn't really make that much difference until we get up to thousands of recipes.
+updateAvailableRecipes :: Has (State GameState) sig m => (Inventory, Inventory) -> Entity -> m ()
+updateAvailableRecipes invs e = do
+  allInRecipes <- use recipesIn
+  let entityRecipes = recipesFor allInRecipes e
+      usableRecipes = filter (knowsIngredientsFor invs) entityRecipes
+  knownRecipes <- use availableRecipes
+  let newRecipes = filter (`notElem` knownRecipes) usableRecipes
+      newCount = length newRecipes
+  availableRecipes .= newRecipes <> knownRecipes
+  availableRecipesNewCount += newCount

src/Swarm/TUI/Attr.hs

@@ -47,6 +47,7 @@ swarmAttrMap =
     , (sandAttr, fg (V.rgbColor @Int 194 178 128))
     , (fireAttr, fg V.red `V.withStyle` V.bold)
     , (redAttr, fg V.red)
+    , (notifAttr, fg V.yellow `V.withStyle` V.bold)
     , (greenAttr, fg V.green)
     , (blueAttr, fg V.blue)
     , (deviceAttr, fg V.yellow `V.withStyle` V.bold)
@@ -85,6 +86,7 @@ robotAttr
   , baseAttr
   , fireAttr
   , redAttr
+  , notifAttr
   , greenAttr
   , blueAttr
   , woodAttr
@@ -119,13 +121,14 @@ snowAttr = "snow"
 sandAttr = "sand"
 fireAttr = "fire"
 redAttr = "red"
+highlightAttr = "highlight"
 greenAttr = "green"
 blueAttr = "blue"
 rockAttr = "rock"
 woodAttr = "wood"
 baseAttr = "base"
 deviceAttr = "device"
-highlightAttr = "highlight"
+notifAttr = "notif"
 sepAttr = "sep"
 infoAttr = "info"
 defAttr = "def"

src/Swarm/TUI/Controller.hs

@@ -191,6 +191,9 @@ handleMainEvent s = \case
     | isJust (s ^. uiState . uiError) -> continue $ s & uiState . uiError .~ Nothing
     | isJust (s ^. uiState . uiModal) -> maybeUnpause s >>= (continue . (uiState . uiModal .~ Nothing))
   FKey 1 -> toggleModal s HelpModal >>= continue
+  FKey 2 | not (null (s ^. gameState . availableRecipes)) -> do
+    s' <- toggleModal s RecipesModal
+    continue (s' & gameState . availableRecipesNewCount .~ 0)
   ControlKey 'g' -> case s ^. uiState . uiGoal of
     NoGoal -> continueWithoutRedraw s
     UnreadGoal g -> toggleModal s (GoalModal g) >>= continue
@@ -237,7 +240,7 @@ handleMainEvent s = \case
       Just REPLPanel -> handleREPLEvent s ev
       Just WorldPanel -> handleWorldEvent s ev
       Just RobotPanel -> handleRobotPanelEvent s ev
-      Just InfoPanel -> handleInfoPanelEvent s ev
+      Just InfoPanel -> handleInfoPanelEvent s infoScroll ev
       _ -> continueWithoutRedraw s
 
 mouseLocToWorldCoords :: GameState -> Brick.Location -> EventM Name (Maybe W.Coords)
@@ -289,7 +292,9 @@ handleModalEvent s = \case
       _ -> continue s'
   ev -> do
     s' <- s & uiState . uiModal . _Just . modalDialog %%~ handleDialogEvent ev
-    continue s'
+    case s ^? uiState . uiModal . _Just . modalType of
+      Just RecipesModal -> handleInfoPanelEvent s' recipesScroll (VtyEvent ev)
+      _ -> continue s'
 
 -- | Quit a game.  Currently all it does is write out the updated REPL
 --   history to a @.swarm_history@ file, and return to the previous menu.
@@ -792,14 +797,14 @@ descriptionModal s e =
 ------------------------------------------------------------
 
 -- | Handle user events in the info panel (just scrolling).
-handleInfoPanelEvent :: AppState -> BrickEvent Name AppEvent -> EventM Name (Next AppState)
-handleInfoPanelEvent s = \case
-  Key V.KDown -> vScrollBy infoScroll 1 >> continue s
-  Key V.KUp -> vScrollBy infoScroll (-1) >> continue s
-  CharKey 'k' -> vScrollBy infoScroll 1 >> continue s
-  CharKey 'j' -> vScrollBy infoScroll (-1) >> continue s
-  Key V.KPageDown -> vScrollPage infoScroll Brick.Down >> continue s
-  Key V.KPageUp -> vScrollPage infoScroll Brick.Up >> continue s
-  Key V.KHome -> vScrollToBeginning infoScroll >> continue s
-  Key V.KEnd -> vScrollToEnd infoScroll >> continue s
+handleInfoPanelEvent :: AppState -> ViewportScroll Name -> BrickEvent Name AppEvent -> EventM Name (Next AppState)
+handleInfoPanelEvent s vs = \case
+  Key V.KDown -> vScrollBy vs 1 >> continue s
+  Key V.KUp -> vScrollBy vs (-1) >> continue s
+  CharKey 'k' -> vScrollBy vs 1 >> continue s
+  CharKey 'j' -> vScrollBy vs (-1) >> continue s
+  Key V.KPageDown -> vScrollPage vs Brick.Down >> continue s
+  Key V.KPageUp -> vScrollPage vs Brick.Up >> continue s
+  Key V.KHome -> vScrollToBeginning vs >> continue s
+  Key V.KEnd -> vScrollToEnd vs >> continue s
   _ -> continueWithoutRedraw s

src/Swarm/TUI/Model.hs

@@ -114,6 +114,7 @@ module Swarm.TUI.Model (
   -- ** Updating
   populateInventoryList,
   infoScroll,
+  recipesScroll,
 
   -- * App state
   AppState,
@@ -205,11 +206,16 @@ data Name
     ScenarioList
   | -- | The scrollable viewport for the info panel.
     InfoViewport
+  | -- | The scrollable viewport for the recipe list.
+    RecipesViewport
   deriving (Eq, Ord, Show, Read)
 
 infoScroll :: ViewportScroll Name
 infoScroll = viewportScroll InfoViewport
 
+recipesScroll :: ViewportScroll Name
+recipesScroll = viewportScroll RecipesViewport
+
 ------------------------------------------------------------
 -- REPL History
 ------------------------------------------------------------
@@ -390,6 +396,7 @@ mkReplForm r = newForm [(replPromptAsWidget r <+>) @@= editTextField promptTextL
 
 data ModalType
   = HelpModal
+  | RecipesModal
   | WinModal
   | QuitModal
   | DescriptionModal Entity