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

module Swarm.TUI.Model.UI (
  UIState (..),
  GoalDisplay (..),
  uiMenu,
  uiPlaying,
  uiCheatMode,
  uiFocusRing,
  uiWorldCursor,
  uiREPL,
  uiInventory,
  uiInventorySort,
  uiMoreInfoTop,
  uiMoreInfoBot,
  uiScrollToEnd,
  uiError,
  uiModal,
  uiGoal,
  uiAchievements,
  lgTicksPerSecond,
  lastFrameTime,
  accumulatedTime,
  tickCount,
  frameCount,
  frameTickCount,
  lastInfoTime,
  uiShowFPS,
  uiShowZero,
  uiShowRobots,
  uiHideRobotsUntil,
  uiInventoryShouldUpdate,
  uiTPF,
  uiFPS,
  uiAttrMap,
  scenarioRef,
  appData,

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

import Brick (AttrMap)
import Brick.Focus
import Brick.Widgets.List qualified as BL
import Control.Arrow ((&&&))
import Control.Lens hiding (from, (<.>))
import Control.Monad.Except
import Data.Bits (FiniteBits (finiteBitSize))
import Data.Map (Map)
import Data.Map qualified as M
import Data.Text (Text)
import Data.Text qualified as T
import Swarm.Game.Scenario.Objective.Presentation.Model
import Swarm.Game.ScenarioInfo (
  ScenarioInfoPair,
 )
import Swarm.Game.World qualified as W
import Swarm.TUI.Attr (swarmAttrMap)
import Swarm.TUI.Inventory.Sorting
import Swarm.TUI.Model.Achievement.Attainment
import Swarm.TUI.Model.Achievement.Definitions
import Swarm.TUI.Model.Achievement.Persistence
import Swarm.TUI.Model.Failure (SystemFailure)
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.Repl
import Swarm.Util
import System.Clock

------------------------------------------------------------
-- UI state
------------------------------------------------------------

-- | The main record holding the UI state.  For access to the fields,
-- see the lenses below.
data UIState = UIState
  { UIState -> Menu
_uiMenu :: Menu
  , UIState -> Bool
_uiPlaying :: Bool
  , UIState -> Bool
_uiCheatMode :: Bool
  , UIState -> FocusRing Name
_uiFocusRing :: FocusRing Name
  , UIState -> Maybe Coords
_uiWorldCursor :: Maybe W.Coords
  , UIState -> REPLState
_uiREPL :: REPLState
  , UIState -> Maybe (Int, List Name InventoryListEntry)
_uiInventory :: Maybe (Int, BL.List Name InventoryListEntry)
  , UIState -> InventorySortOptions
_uiInventorySort :: InventorySortOptions
  , UIState -> Bool
_uiMoreInfoTop :: Bool
  , UIState -> Bool
_uiMoreInfoBot :: Bool
  , UIState -> Bool
_uiScrollToEnd :: Bool
  , UIState -> Maybe Text
_uiError :: Maybe Text
  , UIState -> Maybe Modal
_uiModal :: Maybe Modal
  , UIState -> GoalDisplay
_uiGoal :: GoalDisplay
  , UIState -> Map CategorizedAchievement Attainment
_uiAchievements :: Map CategorizedAchievement Attainment
  , UIState -> Bool
_uiShowFPS :: Bool
  , UIState -> Bool
_uiShowZero :: Bool
  , UIState -> TimeSpec
_uiHideRobotsUntil :: TimeSpec
  , UIState -> Bool
_uiInventoryShouldUpdate :: Bool
  , UIState -> Double
_uiTPF :: Double
  , UIState -> Double
_uiFPS :: Double
  , UIState -> Int
_lgTicksPerSecond :: Int
  , UIState -> Int
_tickCount :: Int
  , UIState -> Int
_frameCount :: Int
  , UIState -> Int
_frameTickCount :: Int
  , UIState -> TimeSpec
_lastFrameTime :: TimeSpec
  , UIState -> TimeSpec
_accumulatedTime :: TimeSpec
  , UIState -> TimeSpec
_lastInfoTime :: TimeSpec
  , UIState -> Map Text Text
_appData :: Map Text Text
  , UIState -> AttrMap
_uiAttrMap :: AttrMap
  , UIState -> Maybe ScenarioInfoPair
_scenarioRef :: Maybe ScenarioInfoPair
  }

--------------------------------------------------
-- Lenses for UIState

let exclude = ['_lgTicksPerSecond]
 in makeLensesWith
      ( lensRules
          & generateSignatures .~ False
          & lensField . mapped . mapped %~ \fn n ->
            if n `elem` exclude then [] else fn n
      )
      ''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

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

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

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

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

-- | 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.
uiInventory :: Lens' UIState (Maybe (Int, BL.List Name InventoryListEntry))

-- | Does the info panel contain more content past the top of the panel?
uiMoreInfoTop :: Lens' UIState Bool

-- | Does the info panel contain more content past the bottom of the panel?
uiMoreInfoBot :: Lens' UIState Bool

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

-- | When this is @Just@, it represents a popup box containing an
--   error message that is shown on top of the rest of the UI.
uiError :: Lens' UIState (Maybe Text)

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

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

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

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

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

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

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

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

-- | Computed ticks per milli seconds
uiTPF :: Lens' UIState Double

-- | Computed frames per milli seconds
uiFPS :: Lens' UIState Double

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

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

-- | 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' UIState Int
lgTicksPerSecond :: Lens' UIState Int
lgTicksPerSecond = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens UIState -> Int
_lgTicksPerSecond UIState -> Int -> UIState
safeSetLgTicks
 where
  maxLog :: Int
maxLog = forall b. FiniteBits b => b -> Int
finiteBitSize (forall a. Bounded a => a
maxBound :: Int)
  maxTicks :: Int
maxTicks = Int
maxLog forall a. Num a => a -> a -> a
- Int
2
  minTicks :: Int
minTicks = Int
2 forall a. Num a => a -> a -> a
- Int
maxLog
  safeSetLgTicks :: UIState -> Int -> UIState
safeSetLgTicks UIState
ui Int
lTicks
    | Int
lTicks forall a. Ord a => a -> a -> Bool
< Int
minTicks = UIState -> Int -> UIState
setLgTicks UIState
ui Int
minTicks
    | Int
lTicks forall a. Ord a => a -> a -> Bool
> Int
maxTicks = UIState -> Int -> UIState
setLgTicks UIState
ui Int
maxTicks
    | Bool
otherwise = UIState -> Int -> UIState
setLgTicks UIState
ui Int
lTicks
  setLgTicks :: UIState -> Int -> UIState
setLgTicks UIState
ui Int
lTicks = UIState
ui {_lgTicksPerSecond :: Int
_lgTicksPerSecond = Int
lTicks}

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

-- | A counter used to track how many frames have been rendered since the
--   last time we updated the ticks/frame statistics.
frameCount :: Lens' UIState 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' UIState Int

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

-- | The time of the last 'Frame' event.
lastFrameTime :: Lens' UIState TimeSpec

-- | The amount of accumulated real time.  Every time we get a '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' UIState TimeSpec

-- | Free-form data loaded from the @data@ directory, for things like
--   the logo, about page, tutorial story, etc.
appData :: Lens' UIState (Map Text Text)

--------------------------------------------------
-- UIState initialization

-- | The initial state of the focus ring.
initFocusRing :: FocusRing Name
initFocusRing :: FocusRing Name
initFocusRing = forall n. [n] -> FocusRing n
focusRing forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map FocusablePanel -> Name
FocusablePanel forall e. (Enum e, Bounded e) => [e]
listEnums

-- | The initial tick speed.
initLgTicksPerSecond :: Int
initLgTicksPerSecond :: Int
initLgTicksPerSecond = 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 :: Bool -> Bool -> ExceptT Text IO ([SystemFailure], UIState)
initUIState :: Bool -> Bool -> ExceptT Text IO ([SystemFailure], UIState)
initUIState Bool
showMainMenu Bool
cheatMode = do
  Maybe Text
historyT <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO (Maybe Text)
readFileMayT forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Bool -> IO FilePath
getSwarmHistoryPath Bool
False
  Map Text Text
appDataMap <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO (Map Text Text)
readAppData
  let history :: [REPLHistItem]
history = forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (forall a b. (a -> b) -> [a] -> [b]
map Text -> REPLHistItem
REPLEntry forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text]
T.lines) Maybe Text
historyT
  TimeSpec
startTime <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
  ([SystemFailure]
warnings, [Attainment]
achievements) <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO IO ([SystemFailure], [Attainment])
loadAchievementsInfo
  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
          , _uiFocusRing :: FocusRing Name
_uiFocusRing = FocusRing Name
initFocusRing
          , _uiWorldCursor :: Maybe Coords
_uiWorldCursor = forall a. Maybe a
Nothing
          , _uiREPL :: REPLState
_uiREPL = REPLHistory -> REPLState
initREPLState forall a b. (a -> b) -> a -> b
$ [REPLHistItem] -> REPLHistory
newREPLHistory [REPLHistItem]
history
          , _uiInventory :: Maybe (Int, List Name InventoryListEntry)
_uiInventory = forall a. Maybe a
Nothing
          , _uiInventorySort :: InventorySortOptions
_uiInventorySort = InventorySortOptions
defaultSortOptions
          , _uiMoreInfoTop :: Bool
_uiMoreInfoTop = Bool
False
          , _uiMoreInfoBot :: Bool
_uiMoreInfoBot = Bool
False
          , _uiScrollToEnd :: Bool
_uiScrollToEnd = Bool
False
          , _uiError :: Maybe Text
_uiError = forall a. Maybe a
Nothing
          , _uiModal :: Maybe Modal
_uiModal = forall a. Maybe a
Nothing
          , _uiGoal :: GoalDisplay
_uiGoal = GoalDisplay
emptyGoalDisplay
          , _uiAchievements :: Map CategorizedAchievement Attainment
_uiAchievements = forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Lens' Attainment CategorizedAchievement
achievement forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& forall a. a -> a
id) [Attainment]
achievements
          , _uiShowFPS :: Bool
_uiShowFPS = Bool
False
          , _uiShowZero :: Bool
_uiShowZero = Bool
True
          , _uiHideRobotsUntil :: TimeSpec
_uiHideRobotsUntil = TimeSpec
startTime forall a. Num a => a -> a -> a
- TimeSpec
1
          , _uiInventoryShouldUpdate :: Bool
_uiInventoryShouldUpdate = Bool
False
          , _uiTPF :: Double
_uiTPF = Double
0
          , _uiFPS :: Double
_uiFPS = Double
0
          , _lgTicksPerSecond :: Int
_lgTicksPerSecond = Int
initLgTicksPerSecond
          , _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
          , _appData :: Map Text Text
_appData = Map Text Text
appDataMap
          , _uiAttrMap :: AttrMap
_uiAttrMap = AttrMap
swarmAttrMap
          , _scenarioRef :: Maybe ScenarioInfoPair
_scenarioRef = forall a. Maybe a
Nothing
          }
  forall (m :: * -> *) a. Monad m => a -> m a
return ([SystemFailure]
warnings, UIState
out)