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

-- |
-- SPDX-License-Identifier: BSD-3-Clause
module Swarm.TUI.Model.UI (
  UIState (..),
  UIGameplay (..),
  UITiming (..),
  UIInventory (..),
  GoalDisplay (..),
  uiGameplay,
  uiPopups,
  uiTiming,
  uiInventory,
  uiMenu,
  uiPlaying,
  uiCheatMode,
  uiFocusRing,
  uiLaunchConfig,
  uiWorldCursor,
  uiWorldEditor,
  uiREPL,
  uiInventoryList,
  uiInventorySort,
  uiInventorySearch,
  uiScrollToEnd,
  uiModal,
  uiGoal,
  uiStructure,
  uiHideGoals,
  uiAchievements,
  lgTicksPerSecond,
  lastFrameTime,
  accumulatedTime,
  tickCount,
  frameCount,
  frameTickCount,
  lastInfoTime,
  uiShowFPS,
  uiShowREPL,
  uiShowZero,
  uiShowDebug,
  uiShowRobots,
  uiHideRobotsUntil,
  uiInventoryShouldUpdate,
  uiTPF,
  uiFPS,
  uiAttrMap,
  scenarioRef,

  -- ** Initialization
  initFocusRing,
  defaultInitLgTicksPerSecond,
  initUIState,
) where

import Brick (AttrMap)
import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Arrow ((&&&))
import Control.Effect.Accum
import Control.Effect.Lift
import Control.Lens hiding (from, (<.>))
import Data.Bits (FiniteBits (finiteBitSize))
import Data.List.Extra (enumerate)
import Data.Map (Map)
import Data.Map qualified as M
import Data.Sequence (Seq)
import Data.Text (Text)
import Data.Text qualified as T
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Achievement.Persistence
import Swarm.Game.Failure (SystemFailure)
import Swarm.Game.ResourceLoading (getSwarmHistoryPath)
import Swarm.Game.ScenarioInfo (
  ScenarioInfoPair,
 )
import Swarm.Game.Universe
import Swarm.Game.World.Coords
import Swarm.TUI.Editor.Model
import Swarm.TUI.Inventory.Sorting
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep
import Swarm.TUI.Model.Goal
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Popup
import Swarm.TUI.Model.Repl
import Swarm.TUI.Model.Structure
import Swarm.TUI.View.Attribute.Attr (swarmAttrMap)
import Swarm.Util
import Swarm.Util.Lens (makeLensesExcluding, makeLensesNoSigs)
import System.Clock

data UITiming = UITiming
  { UITiming -> Bool
_uiShowFPS :: Bool
  , UITiming -> Double
_uiTPF :: Double
  , UITiming -> Double
_uiFPS :: Double
  , UITiming -> Int
_lgTicksPerSecond :: Int
  , UITiming -> Int
_tickCount :: Int
  , UITiming -> Int
_frameCount :: Int
  , UITiming -> Int
_frameTickCount :: Int
  , UITiming -> TimeSpec
_lastFrameTime :: TimeSpec
  , UITiming -> TimeSpec
_accumulatedTime :: TimeSpec
  , UITiming -> TimeSpec
_lastInfoTime :: TimeSpec
  }

-- * Lenses for UITiming

makeLensesExcluding ['_lgTicksPerSecond] ''UITiming

-- | A toggle to show the FPS by pressing @f@
uiShowFPS :: Lens' UITiming Bool

-- | Computed ticks per milliseconds
uiTPF :: Lens' UITiming Double

-- | Computed frames per milliseconds
uiFPS :: Lens' UITiming Double

-- | The base-2 logarithm of the current game speed in ticks/second.
--   Note that we cap this value to the range of +/- log2 INTMAX.
lgTicksPerSecond :: Lens' UITiming Int
lgTicksPerSecond :: Lens' UITiming Int
lgTicksPerSecond = (UITiming -> Int)
-> (UITiming -> Int -> UITiming) -> Lens' UITiming Int
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UITiming -> Int
_lgTicksPerSecond UITiming -> Int -> UITiming
safeSetLgTicks
 where
  maxLog :: Int
maxLog = Int -> Int
forall b. FiniteBits b => b -> Int
finiteBitSize (Int
forall a. Bounded a => a
maxBound :: Int)
  maxTicks :: Int
maxTicks = Int
maxLog Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
  minTicks :: Int
minTicks = Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
maxLog
  safeSetLgTicks :: UITiming -> Int -> UITiming
safeSetLgTicks UITiming
ui Int
lTicks
    | Int
lTicks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
minTicks = UITiming -> Int -> UITiming
setLgTicks UITiming
ui Int
minTicks
    | Int
lTicks Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxTicks = UITiming -> Int -> UITiming
setLgTicks UITiming
ui Int
maxTicks
    | Bool
otherwise = UITiming -> Int -> UITiming
setLgTicks UITiming
ui Int
lTicks
  setLgTicks :: UITiming -> Int -> UITiming
setLgTicks UITiming
ui Int
lTicks = UITiming
ui {_lgTicksPerSecond = lTicks}

-- | A counter used to track how many ticks have happened since the
--   last time we updated the ticks/frame statistics.
tickCount :: Lens' UITiming Int

-- | A counter used to track how many frames have been rendered since the
--   last time we updated the ticks/frame statistics.
frameCount :: Lens' UITiming Int

-- | A counter used to track how many ticks have happened in the
--   current frame, so we can stop when we get to the tick cap.
frameTickCount :: Lens' UITiming Int

-- | The time of the last info widget update
lastInfoTime :: Lens' UITiming TimeSpec

-- | The time of the last 'Swarm.TUI.Model.Frame' event.
lastFrameTime :: Lens' UITiming TimeSpec

-- | The amount of accumulated real time.  Every time we get a 'Swarm.TUI.Model.Frame'
--   event, we accumulate the amount of real time that happened since
--   the last frame, then attempt to take an appropriate number of
--   ticks to "catch up", based on the target tick rate.
--
--   See https://gafferongames.com/post/fix_your_timestep/ .
accumulatedTime :: Lens' UITiming TimeSpec

data UIInventory = UIInventory
  { UIInventory -> Maybe (Int, List Name InventoryListEntry)
_uiInventoryList :: Maybe (Int, BL.List Name InventoryListEntry)
  , UIInventory -> InventorySortOptions
_uiInventorySort :: InventorySortOptions
  , UIInventory -> Maybe Text
_uiInventorySearch :: Maybe Text
  , UIInventory -> Bool
_uiShowZero :: Bool
  , UIInventory -> Bool
_uiInventoryShouldUpdate :: Bool
  }

-- * Lenses for UIInventory

makeLensesNoSigs ''UIInventory

-- | The order and direction of sorting inventory list.
uiInventorySort :: Lens' UIInventory InventorySortOptions

-- | The current search string used to narrow the inventory view.
uiInventorySearch :: Lens' UIInventory (Maybe Text)

-- | The hash value of the focused robot entity (so we can tell if its
--   inventory changed) along with a list of the items in the
--   focused robot's inventory.
uiInventoryList :: Lens' UIInventory (Maybe (Int, BL.List Name InventoryListEntry))

-- | A toggle to show or hide inventory items with count 0 by pressing @0@
uiShowZero :: Lens' UIInventory Bool

-- | Whether the Inventory ui panel should update
uiInventoryShouldUpdate :: Lens' UIInventory Bool

-- | The main record holding the gameplay UI state.  For access to the fields,
-- see the lenses below.
data UIGameplay = UIGameplay
  { UIGameplay -> FocusRing Name
_uiFocusRing :: FocusRing Name
  , UIGameplay -> Maybe (Cosmic Coords)
_uiWorldCursor :: Maybe (Cosmic Coords)
  , UIGameplay -> WorldEditor Name
_uiWorldEditor :: WorldEditor Name
  , UIGameplay -> REPLState
_uiREPL :: REPLState
  , UIGameplay -> UIInventory
_uiInventory :: UIInventory
  , UIGameplay -> Bool
_uiScrollToEnd :: Bool
  , UIGameplay -> Maybe Modal
_uiModal :: Maybe Modal
  , UIGameplay -> GoalDisplay
_uiGoal :: GoalDisplay
  , UIGameplay -> StructureDisplay
_uiStructure :: StructureDisplay
  , UIGameplay -> Bool
_uiHideGoals :: Bool
  , UIGameplay -> Bool
_uiShowREPL :: Bool
  , UIGameplay -> Bool
_uiShowDebug :: Bool
  , UIGameplay -> TimeSpec
_uiHideRobotsUntil :: TimeSpec
  , UIGameplay -> UITiming
_uiTiming :: UITiming
  , UIGameplay -> Maybe ScenarioInfoPair
_scenarioRef :: Maybe ScenarioInfoPair
  }

-- * Lenses for UIGameplay

makeLensesNoSigs ''UIGameplay

-- | Temporal information for gameplay UI
uiTiming :: Lens' UIGameplay UITiming

-- | Inventory information for gameplay UI
uiInventory :: Lens' UIGameplay UIInventory

-- | The focus ring is the set of UI panels we can cycle among using
--   the @Tab@ key.
uiFocusRing :: Lens' UIGameplay (FocusRing Name)

-- | The last clicked position on the world view.
uiWorldCursor :: Lens' UIGameplay (Maybe (Cosmic Coords))

-- | State of all World Editor widgets
uiWorldEditor :: Lens' UIGameplay (WorldEditor Name)

-- | The state of REPL panel.
uiREPL :: Lens' UIGameplay REPLState

-- | A flag telling the UI to scroll the info panel to the very end
--   (used when a new log message is appended).
uiScrollToEnd :: Lens' UIGameplay Bool

-- | When this is 'Just', it represents a modal to be displayed on
--   top of the UI, e.g. for the Help screen.
uiModal :: Lens' UIGameplay (Maybe Modal)

-- | Status of the scenario goal: whether there is one, and whether it
--   has been displayed to the user initially.
uiGoal :: Lens' UIGameplay GoalDisplay

-- | Definition and status of a recognizable structure
uiStructure :: Lens' UIGameplay StructureDisplay

-- | When running with @--autoplay@, suppress the goal dialogs.
--
-- For development, the @--cheat@ flag shows goals again.
uiHideGoals :: Lens' UIGameplay Bool

-- | A toggle to expand or collapse the REPL by pressing @Ctrl-k@
uiShowREPL :: Lens' UIGameplay Bool

-- | A toggle to show debug.
--
-- TODO: #1112 use record for selection of debug features?
uiShowDebug :: Lens' UIGameplay Bool

-- | Hide robots on the world map.
uiHideRobotsUntil :: Lens' UIGameplay TimeSpec

-- | Whether to show or hide robots on the world map.
uiShowRobots :: Getter UIGameplay Bool
uiShowRobots :: Getter UIGameplay Bool
uiShowRobots = (UIGameplay -> Bool)
-> (Bool -> f Bool) -> UIGameplay -> f UIGameplay
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (\UIGameplay
ui -> UIGameplay
ui UIGameplay -> Getting TimeSpec UIGameplay TimeSpec -> TimeSpec
forall s a. s -> Getting a s a -> a
^. (UITiming -> Const TimeSpec UITiming)
-> UIGameplay -> Const TimeSpec UIGameplay
Lens' UIGameplay UITiming
uiTiming ((UITiming -> Const TimeSpec UITiming)
 -> UIGameplay -> Const TimeSpec UIGameplay)
-> ((TimeSpec -> Const TimeSpec TimeSpec)
    -> UITiming -> Const TimeSpec UITiming)
-> Getting TimeSpec UIGameplay TimeSpec
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TimeSpec -> Const TimeSpec TimeSpec)
-> UITiming -> Const TimeSpec UITiming
Lens' UITiming TimeSpec
lastFrameTime TimeSpec -> TimeSpec -> Bool
forall a. Ord a => a -> a -> Bool
> UIGameplay
ui UIGameplay -> Getting TimeSpec UIGameplay TimeSpec -> TimeSpec
forall s a. s -> Getting a s a -> a
^. Getting TimeSpec UIGameplay TimeSpec
Lens' UIGameplay TimeSpec
uiHideRobotsUntil)

-- | The currently active Scenario description, useful for starting over.
scenarioRef :: Lens' UIGameplay (Maybe ScenarioInfoPair)

-- * Toplevel UIState definition

data UIState = UIState
  { UIState -> Menu
_uiMenu :: Menu
  , UIState -> Bool
_uiPlaying :: Bool
  , UIState -> Bool
_uiCheatMode :: Bool
  , UIState -> LaunchOptions
_uiLaunchConfig :: LaunchOptions
  , UIState -> Map CategorizedAchievement Attainment
_uiAchievements :: Map CategorizedAchievement Attainment
  , UIState -> AttrMap
_uiAttrMap :: AttrMap
  , UIState -> UIGameplay
_uiGameplay :: UIGameplay
  , UIState -> PopupState
_uiPopups :: PopupState
  }

-- * Lenses for UIState

makeLensesNoSigs ''UIState

-- | The current menu state.
uiMenu :: Lens' UIState Menu

-- | Are we currently playing the game?
--
-- * 'True' = we are playing, and
--   should thus display a world, REPL, etc.
-- * False = we should
--   display the current menu.
uiPlaying :: Lens' UIState Bool

-- | Cheat mode, i.e. are we allowed to turn creative mode on and off?
uiCheatMode :: Lens' UIState Bool

-- | Configuration modal when launching a scenario
uiLaunchConfig :: Lens' UIState LaunchOptions

-- | Map of achievements that were attained
uiAchievements :: Lens' UIState (Map CategorizedAchievement Attainment)

-- | Attribute map
uiAttrMap :: Lens' UIState AttrMap

-- | UI active during live gameplay
uiGameplay :: Lens' UIState UIGameplay

-- | Queue of popups to display
uiPopups :: Lens' UIState PopupState

-- * UIState initialization

-- | The initial state of the focus ring.
-- NOTE: Normally, the Tab key might cycle through the members of the
-- focus ring. However, the REPL already uses Tab. So, to is not used
-- at all right now for navigating the toplevel focus ring.
initFocusRing :: FocusRing Name
initFocusRing :: FocusRing Name
initFocusRing = [Name] -> FocusRing Name
forall n. [n] -> FocusRing n
focusRing ([Name] -> FocusRing Name) -> [Name] -> FocusRing Name
forall a b. (a -> b) -> a -> b
$ (FocusablePanel -> Name) -> [FocusablePanel] -> [Name]
forall a b. (a -> b) -> [a] -> [b]
map FocusablePanel -> Name
FocusablePanel [FocusablePanel]
forall a. (Enum a, Bounded a) => [a]
enumerate

-- | The initial tick speed.
defaultInitLgTicksPerSecond :: Int
defaultInitLgTicksPerSecond :: Int
defaultInitLgTicksPerSecond = Int
4 -- 2^4 = 16 ticks / second

-- | Initialize the UI state.  This needs to be in the IO monad since
--   it involves reading a REPL history file, getting the current
--   time, and loading text files from the data directory.  The @Bool@
--   parameter indicates whether we should start off by showing the
--   main menu.
initUIState ::
  ( Has (Accum (Seq SystemFailure)) sig m
  , Has (Lift IO) sig m
  ) =>
  Int ->
  Bool ->
  Bool ->
  m UIState
initUIState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
Int -> Bool -> Bool -> m UIState
initUIState Int
speedFactor Bool
showMainMenu Bool
cheatMode = do
  Maybe Text
historyT <- IO (Maybe Text) -> m (Maybe Text)
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO (Maybe Text) -> m (Maybe Text))
-> IO (Maybe Text) -> m (Maybe Text)
forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe Text)
readFileMayT (FilePath -> IO (Maybe Text)) -> IO FilePath -> IO (Maybe Text)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO FilePath
getSwarmHistoryPath Bool
False
  let history :: [REPLHistItem]
history = [REPLHistItem]
-> (Text -> [REPLHistItem]) -> Maybe Text -> [REPLHistItem]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] ((Text -> REPLHistItem) -> [Text] -> [REPLHistItem]
forall a b. (a -> b) -> [a] -> [b]
map Text -> REPLHistItem
mkREPLSubmission ([Text] -> [REPLHistItem])
-> (Text -> [Text]) -> Text -> [REPLHistItem]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) Maybe Text
historyT
  TimeSpec
startTime <- IO TimeSpec -> m TimeSpec
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO (IO TimeSpec -> m TimeSpec) -> IO TimeSpec -> m TimeSpec
forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  [Attainment]
achievements <- m [Attainment]
forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m [Attainment]
loadAchievementsInfo
  LaunchOptions
launchConfigPanel <- IO LaunchOptions -> m LaunchOptions
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO LaunchOptions
initConfigPanel
  let out :: UIState
out =
        UIState
          { _uiMenu :: Menu
_uiMenu = if Bool
showMainMenu then List Name MainMenuEntry -> Menu
MainMenu (MainMenuEntry -> List Name MainMenuEntry
mainMenu MainMenuEntry
NewGame) else Menu
NoMenu
          , _uiPlaying :: Bool
_uiPlaying = Bool -> Bool
not Bool
showMainMenu
          , _uiCheatMode :: Bool
_uiCheatMode = Bool
cheatMode
          , _uiLaunchConfig :: LaunchOptions
_uiLaunchConfig = LaunchOptions
launchConfigPanel
          , _uiAchievements :: Map CategorizedAchievement Attainment
_uiAchievements = [(CategorizedAchievement, Attainment)]
-> Map CategorizedAchievement Attainment
forall k a. Ord k => [(k, a)] -> Map k a
M.fromList ([(CategorizedAchievement, Attainment)]
 -> Map CategorizedAchievement Attainment)
-> [(CategorizedAchievement, Attainment)]
-> Map CategorizedAchievement Attainment
forall a b. (a -> b) -> a -> b
$ (Attainment -> (CategorizedAchievement, Attainment))
-> [Attainment] -> [(CategorizedAchievement, Attainment)]
forall a b. (a -> b) -> [a] -> [b]
map (Getting CategorizedAchievement Attainment CategorizedAchievement
-> Attainment -> CategorizedAchievement
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting CategorizedAchievement Attainment CategorizedAchievement
Lens' Attainment CategorizedAchievement
achievement (Attainment -> CategorizedAchievement)
-> (Attainment -> Attainment)
-> Attainment
-> (CategorizedAchievement, Attainment)
forall b c c'. (b -> c) -> (b -> c') -> b -> (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& Attainment -> Attainment
forall a. a -> a
id) [Attainment]
achievements
          , _uiAttrMap :: AttrMap
_uiAttrMap = AttrMap
swarmAttrMap
          , _uiPopups :: PopupState
_uiPopups = PopupState
initPopupState
          , _uiGameplay :: UIGameplay
_uiGameplay =
              UIGameplay
                { _uiFocusRing :: FocusRing Name
_uiFocusRing = FocusRing Name
initFocusRing
                , _uiWorldCursor :: Maybe (Cosmic Coords)
_uiWorldCursor = Maybe (Cosmic Coords)
forall a. Maybe a
Nothing
                , _uiWorldEditor :: WorldEditor Name
_uiWorldEditor = TimeSpec -> WorldEditor Name
initialWorldEditor TimeSpec
startTime
                , _uiREPL :: REPLState
_uiREPL = REPLHistory -> REPLState
initREPLState (REPLHistory -> REPLState) -> REPLHistory -> REPLState
forall a b. (a -> b) -> a -> b
$ [REPLHistItem] -> REPLHistory
newREPLHistory [REPLHistItem]
history
                , _uiInventory :: UIInventory
_uiInventory =
                    UIInventory
                      { _uiInventoryList :: Maybe (Int, List Name InventoryListEntry)
_uiInventoryList = Maybe (Int, List Name InventoryListEntry)
forall a. Maybe a
Nothing
                      , _uiInventorySort :: InventorySortOptions
_uiInventorySort = InventorySortOptions
defaultSortOptions
                      , _uiInventorySearch :: Maybe Text
_uiInventorySearch = Maybe Text
forall a. Maybe a
Nothing
                      , _uiShowZero :: Bool
_uiShowZero = Bool
True
                      , _uiInventoryShouldUpdate :: Bool
_uiInventoryShouldUpdate = Bool
False
                      }
                , _uiScrollToEnd :: Bool
_uiScrollToEnd = Bool
False
                , _uiModal :: Maybe Modal
_uiModal = Maybe Modal
forall a. Maybe a
Nothing
                , _uiGoal :: GoalDisplay
_uiGoal = GoalDisplay
emptyGoalDisplay
                , _uiStructure :: StructureDisplay
_uiStructure = StructureDisplay
emptyStructureDisplay
                , _uiHideGoals :: Bool
_uiHideGoals = Bool
False
                , _uiTiming :: UITiming
_uiTiming =
                    UITiming
                      { _uiShowFPS :: Bool
_uiShowFPS = Bool
False
                      , _uiTPF :: Double
_uiTPF = Double
0
                      , _uiFPS :: Double
_uiFPS = Double
0
                      , _lgTicksPerSecond :: Int
_lgTicksPerSecond = Int
speedFactor
                      , _lastFrameTime :: TimeSpec
_lastFrameTime = TimeSpec
startTime
                      , _accumulatedTime :: TimeSpec
_accumulatedTime = TimeSpec
0
                      , _lastInfoTime :: TimeSpec
_lastInfoTime = TimeSpec
0
                      , _tickCount :: Int
_tickCount = Int
0
                      , _frameCount :: Int
_frameCount = Int
0
                      , _frameTickCount :: Int
_frameTickCount = Int
0
                      }
                , _uiShowREPL :: Bool
_uiShowREPL = Bool
True
                , _uiShowDebug :: Bool
_uiShowDebug = Bool
False
                , _uiHideRobotsUntil :: TimeSpec
_uiHideRobotsUntil = TimeSpec
startTime TimeSpec -> TimeSpec -> TimeSpec
forall a. Num a => a -> a -> a
- TimeSpec
1
                , _scenarioRef :: Maybe ScenarioInfoPair
_scenarioRef = Maybe ScenarioInfoPair
forall a. Maybe a
Nothing
                }
          }
  UIState -> m UIState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return UIState
out