Menu.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

module Swarm.TUI.Model.Menu where

import Brick.Widgets.Dialog (Dialog)
import Brick.Widgets.List qualified as BL
import Control.Lens hiding (from, (<.>))
import Data.List.NonEmpty (NonEmpty (..))
import Data.List.NonEmpty qualified as NE
import Data.Map qualified as M
import Data.Text (Text)
import Data.Vector qualified as V
import Swarm.Game.Entity as E
import Swarm.Game.ScenarioInfo (
  ScenarioCollection,
  ScenarioInfo (..),
  ScenarioInfoPair,
  ScenarioItem (..),
  scMap,
  scenarioCollectionToList,
 )
import Swarm.Game.State
import Swarm.TUI.Model.Achievement.Definitions
import Swarm.TUI.Model.Name
import Swarm.Util
import System.FilePath (dropTrailingPathSeparator, splitPath, takeFileName)
import Witch (into)

------------------------------------------------------------
-- Menus and dialogs
------------------------------------------------------------

data ModalType
  = HelpModal
  | RecipesModal
  | CommandsModal
  | MessagesModal
  | RobotsModal
  | WinModal
  | LoseModal
  | QuitModal
  | KeepPlayingModal
  | DescriptionModal Entity
  | GoalModal
  deriving (Show)

data ButtonAction
  = Cancel
  | KeepPlaying
  | StartOver Seed ScenarioInfoPair
  | QuitAction
  | Next ScenarioInfoPair

data Modal = Modal
  { _modalType :: ModalType
  , _modalDialog :: Dialog ButtonAction Name
  }

makeLenses ''Modal

data MainMenuEntry
  = NewGame
  | Tutorial
  | Achievements
  | Messages
  | About
  | Quit
  deriving (Eq, Ord, Show, Read, Bounded, Enum)

data Menu
  = NoMenu -- We started playing directly from command line, no menu to show
  | MainMenu (BL.List Name MainMenuEntry)
  | -- Stack of scenario item lists. INVARIANT: the currently selected
    -- menu item is ALWAYS the same as the scenario currently being played.
    -- See https://github.com/swarm-game/swarm/issues/1064 and
    -- https://github.com/swarm-game/swarm/pull/1065.
    NewGameMenu (NonEmpty (BL.List Name ScenarioItem))
  | AchievementsMenu (BL.List Name CategorizedAchievement)
  | MessagesMenu
  | AboutMenu

mainMenu :: MainMenuEntry -> BL.List Name MainMenuEntry
mainMenu e = BL.list MenuList (V.fromList listEnums) 1 & BL.listMoveToElement e

makePrisms ''Menu

-- | Create a brick 'BL.List' of scenario items from a 'ScenarioCollection'.
mkScenarioList :: Bool -> ScenarioCollection -> BL.List Name ScenarioItem
mkScenarioList cheat = flip (BL.list ScenarioList) 1 . V.fromList . filterTest . scenarioCollectionToList
 where
  filterTest = if cheat then id else filter (\case SICollection n _ -> n /= "Testing"; _ -> True)

-- | Given a 'ScenarioCollection' and a 'FilePath' which is the canonical
--   path to some folder or scenario, construct a 'NewGameMenu' stack
--   focused on the given item, if possible.
mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
mkNewGameMenu cheat sc path = NewGameMenu . NE.fromList <$> go (Just sc) (splitPath path) []
 where
  go :: Maybe ScenarioCollection -> [FilePath] -> [BL.List Name ScenarioItem] -> Maybe [BL.List Name ScenarioItem]
  go _ [] stk = Just stk
  go Nothing _ _ = Nothing
  go (Just curSC) (thing : rest) stk = go nextSC rest (lst : stk)
   where
    hasName :: ScenarioItem -> Bool
    hasName (SISingle (_, ScenarioInfo pth _ _ _)) = takeFileName pth == thing
    hasName (SICollection nm _) = nm == into @Text (dropTrailingPathSeparator thing)

    lst = BL.listFindBy hasName (mkScenarioList cheat curSC)

    nextSC = case M.lookup (dropTrailingPathSeparator thing) (scMap curSC) of
      Just (SICollection _ c) -> Just c
      _ -> Nothing

------------------------------------------------------------
-- Inventory list entries
------------------------------------------------------------

-- | An entry in the inventory list displayed in the info panel.  We
--   can either have an entity with a count in the robot's inventory,
--   an entity equipped on the robot, or a labelled separator.  The
--   purpose of the separators is to show a clear distinction between
--   the robot's /inventory/ and its /equipped devices/.
data InventoryListEntry
  = Separator Text
  | InventoryEntry Count Entity
  | EquippedEntry Entity
  deriving (Eq)

makePrisms ''InventoryListEntry