Add available recipes help

Author: TristanCacqueray

src/Swarm/Game/Recipe.hs

@@ -33,6 +33,7 @@ module Swarm.Game.Recipe (
   inRecipeMap,
 
   -- * Looking up recipes
+  missingIngredientsFor,
   recipesFor,
   make,
   make',

src/Swarm/Game/State.hs

@@ -39,6 +39,7 @@ module Swarm.Game.State (
   robotMap,
   robotsByLocation,
   activeRobots,
+  availableRecipes,
   gensym,
   randGen,
   adjList,
@@ -186,6 +187,7 @@ data GameState = GameState
     -- append to a list than to a Set.
     _waitingRobots :: Map Integer [RID]
   , _robotsByLocation :: Map (V2 Int64) IntSet
+  , _availableRecipes :: (Int, [Recipe Entity])
   , _gensym :: Int
   , _randGen :: StdGen
   , _adjList :: Array Int Text
@@ -248,6 +250,9 @@ robotMap :: Lens' GameState (IntMap Robot)
 --   happen.
 robotsByLocation :: Lens' GameState (Map (V2 Int64) IntSet)
 
+-- | The list of available recipes, with the position of the last known item.
+availableRecipes :: Lens' GameState (Int, [Recipe Entity])
+
 -- | The names of the robots that are currently not sleeping.
 activeRobots :: Getter GameState IntSet
 activeRobots = internalActiveRobots
@@ -440,6 +445,7 @@ initGameState cmdlineSeed scenarioToLoad toRun = do
           , _runStatus = Running
           , _robotMap = IM.empty
           , _robotsByLocation = M.empty
+          , _availableRecipes = (0, mempty)
           , _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
@@ -367,6 +368,7 @@ stepCESK cesk = case cesk of
       Left exn -> return $ Up exn s k
       Right wo -> do
         robotInventory %= robotUpdateInventory rf
+        updateSelfAllAvailableRecipes
         world .= wo
         needsRedraw .= True
         stepCESK (Out v s k)
@@ -752,6 +754,7 @@ execConst c vs s k = do
         Just n -> fromMaybe e <$> uses entityMap (lookupEntityName n)
 
       robotInventory %= insert e'
+      updateSelfAvailableRecipes e'
 
       -- Return the name of the item grabbed.
       return $ Out (VString (e ^. entityName)) s k
@@ -813,6 +816,12 @@ execConst c vs s k = do
           robotMap . at otherID . _Just . robotInventory %= insert item
           robotInventory %= delete item
 
+          otherRobotm <- use $ robotMap . at otherID
+          case otherRobotm of
+            Just otherRobot ->
+              updateAvailableRecipes (otherRobot ^. robotInventory, otherRobot ^. installedDevices) item
+            Nothing -> pure ()
+
           -- Flag the UI for a redraw if we are currently showing either robot's inventory
           when (focusedID == myID || focusedID == otherID) flagRedraw
 
@@ -844,6 +853,7 @@ execConst c vs s k = do
               installedDevices %= insert item
               robotInventory %= delete item
 
+              updateSelfAllAvailableRecipes
               -- Flag the UI for a redraw if we are currently showing our inventory
               when (focusedID == myID) flagRedraw
           False -> do
@@ -891,6 +901,7 @@ execConst c vs s k = do
 
         -- take recipe inputs from inventory and add outputs after recipeTime
         robotInventory .= invTaken
+
         finishCookingRecipe recipe (WorldUpdate Right) (RobotUpdate changeInv)
       _ -> badConst
     Has -> case vs of
@@ -1075,6 +1086,8 @@ execConst c vs s k = do
             `isJustOrFail` ["I've never heard of", indefiniteQ name <> "."]
 
         robotInventory %= insert e
+        updateSelfAvailableRecipes e
+
         return $ Out VUnit s k
       _ -> badConst
     Ishere -> case vs of
@@ -1354,7 +1367,7 @@ execConst c vs s k = do
       [VBool b] -> return $ Out (VBool (not b)) s k
       _ -> badConst
     Neg -> case vs of
-      [VInt n] -> return $ Out (VInt (- n)) s k
+      [VInt n] -> return $ Out (VInt (-n)) s k
       _ -> badConst
     Eq -> returnEvalCmp
     Neq -> returnEvalCmp
@@ -1617,3 +1630,32 @@ safeExp :: Has (Throw Exn) sig m => Integer -> Integer -> m Integer
 safeExp a b
   | b < 0 = throwError $ CmdFailed Exp "Negative exponent"
   | otherwise = return $ a ^ b
+
+-- | Check if any new recipes is available from the given entity
+updateSelfAvailableRecipes :: (Has (State GameState) sig m, Has (State Robot) sig m) => Entity -> m ()
+updateSelfAvailableRecipes e = do
+  inventory <- use robotInventory
+  devices <- use installedDevices
+  updateAvailableRecipes (inventory, devices) e
+
+-- | Check if any new recipes is available from all the inventory
+updateSelfAllAvailableRecipes :: (Has (State GameState) sig m, Has (State Robot) sig m) => m ()
+updateSelfAllAvailableRecipes = do
+  inventory <- use robotInventory
+  devices <- use installedDevices
+  traverse_ (updateAvailableRecipes (inventory, devices) . snd) (filter (\(c, _) -> c > 0) $ E.elems inventory)
+
+updateAvailableRecipes :: Has (State GameState) sig m => (Inventory, Inventory) -> Entity -> m ()
+updateAvailableRecipes invs e = do
+  allInRecipes <- use recipesIn
+  let entityRecipes = recipesFor allInRecipes e
+  let canMake recipe = case missingIngredientsFor invs recipe of
+        [] -> True
+        _ -> False
+  let usableRecipes = filter canMake entityRecipes
+  (knownLength, knownRecipes) <- use availableRecipes
+  let newRecipes = filter (`notElem` knownRecipes) usableRecipes
+      newLength = case newRecipes of
+        [] -> knownLength
+        _ -> length newRecipes
+  availableRecipes .= (newLength, newRecipes <> knownRecipes)

src/Swarm/TUI/Controller.hs

@@ -204,6 +204,9 @@ handleMainEvent s = \case
   ControlKey 'k'
     | s ^. uiState . uiCheatMode -> continue (s & gameState . creativeMode %~ not)
   FKey 1 -> toggleModal s HelpModal >>= continue
+  FKey 2 -> do
+    s' <- toggleModal s RecipesModal
+    continue (s' & gameState . availableRecipes %~ markAsKnown)
   -- dispatch any other events to the focused panel handler
   ev ->
     case focusGetCurrent (s ^. uiState . uiFocusRing) of
@@ -213,6 +216,9 @@ handleMainEvent s = \case
       Just InfoPanel -> handleInfoPanelEvent s ev
       _ -> continueWithoutRedraw s
 
+markAsKnown :: (Int, a) -> (Int, a)
+markAsKnown (_, xs) = (0, xs)
+
 setFocus :: AppState -> Name -> EventM Name (Next AppState)
 setFocus s name = continue $ s & uiState . uiFocusRing %~ focusSetCurrent name
 

src/Swarm/TUI/Model.hs

@@ -304,6 +304,7 @@ replIndexIsAtInput repl = repl ^. replIndex == replLength repl
 
 data ModalType
   = HelpModal
+  | RecipesModal
   | WinModal
   | QuitModal
   | DescriptionModal Entity

src/Swarm/TUI/View.hs

@@ -291,6 +291,12 @@ generateModal s mt = Modal mt (dialog (Just title) buttons (maxModalWindowWidth
   (title, widget, buttons, requiredWidth) =
     case mt of
       HelpModal -> (" Help ", helpWidget, Nothing, maxModalWindowWidth)
+      RecipesModal ->
+        ( "Available Recipes"
+        , helpRecipes (s ^. gameState . availableRecipes)
+        , Nothing
+        , 250
+        )
       WinModal ->
         let winMsg = "Congratulations!"
             continueMsg = "Keep playing"
@@ -322,6 +328,7 @@ helpWidget = (helpKeys <=> fill ' ') <+> (helpCommands <=> fill ' ')
   toWidgets (k, v) = [txt k, txt v]
   glKeyBindings =
     [ ("F1", "Help")
+    , ("F2", "Available recipes")
     , ("Ctrl-q", "quit the game")
     , ("Tab", "cycle panel focus")
     , ("Meta-w", "focus on the world map")
@@ -344,6 +351,9 @@ helpWidget = (helpKeys <=> fill ' ') <+> (helpCommands <=> fill ' ')
     , ("has \"<item>\"", "Check for an item in the inventory")
     ]
 
+helpRecipes :: (Int, [Recipe Entity]) -> Widget Name
+helpRecipes (_, xs) = vBox (map (drawRecipe Nothing Nothing) xs)
+
 descriptionTitle :: Entity -> String
 descriptionTitle e = " " ++ from @Text (e ^. entityName) ++ " "
 
@@ -372,6 +382,14 @@ drawKeyMenu s =
   creative = s ^. gameState . creativeMode
   cheat = s ^. uiState . uiCheatMode
 
+  availRecipes
+    | null (snd $ s ^. gameState . availableRecipes) = []
+    | otherwise = [("F2", knownMark (s ^. gameState . availableRecipes) <> "Recipes")]
+
+  knownMark (count, _)
+    | count > 0 = "*"
+    | otherwise = ""
+
   gameModeWidget =
     padLeft Max . padLeftRight 1
       . txt
@@ -380,10 +398,8 @@ drawKeyMenu s =
         False -> "Classic"
         True -> "Creative"
   globalKeyCmds =
-    [ ("F1", "help")
-    , ("Tab", "cycle")
-    ]
-      ++ [("^k", "creative") | cheat]
+    [("F1", "help")] <> availRecipes <> [("Tab", "cycle")] <> [("^k", "creative") | cheat]
+
   keyCmdsFor (Just REPLPanel) =
     [ ("↓↑", "history")
     ]
@@ -569,7 +585,7 @@ explainRecipes s e
       , padLeftRight 2 $
           hCenter $
             vBox $
-              map (hLimit widthLimit . padBottom (Pad 1) . drawRecipe e inv) recipes
+              map (hLimit widthLimit . padBottom (Pad 1) . drawRecipe (Just e) (Just inv)) recipes
       ]
  where
   recipes = recipesWith s e
@@ -594,8 +610,8 @@ recipesWith s e =
 
 -- | Draw an ASCII art representation of a recipe.  For now, the
 --   weight is not shown.
-drawRecipe :: Entity -> Inventory -> Recipe Entity -> Widget Name
-drawRecipe e inv (Recipe ins outs reqs time _weight) =
+drawRecipe :: Maybe Entity -> Maybe Inventory -> Recipe Entity -> Widget Name
+drawRecipe me minv (Recipe ins outs reqs time _weight) =
   vBox
     -- any requirements (e.g. furnace) go on top.
     [ hCenter $ drawReqs reqs
@@ -637,7 +653,9 @@ drawRecipe e inv (Recipe ins outs reqs time _weight) =
                 )
       ]
    where
-    missing = E.lookup ingr inv < n
+    missing = case minv of
+      Just inv -> E.lookup ingr inv < n
+      Nothing -> False
 
   drawOut i (n, ingr) =
     hBox
@@ -655,7 +673,7 @@ drawRecipe e inv (Recipe ins outs reqs time _weight) =
   -- If it's the focused entity, draw it highlighted.
   -- If the robot doesn't have any, draw it in red.
   fmtEntityName missing ingr
-    | ingr == e = withAttr deviceAttr $ txtLines nm
+    | Just ingr == me = withAttr deviceAttr $ txtLines nm
     | ingr == timeE = withAttr sandAttr $ txtLines nm
     | missing = withAttr invalidFormInputAttr $ txtLines nm
     | otherwise = txtLines nm