{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.TUI.Model.UI (
UIState (..),
GoalDisplay (..),
uiMenu,
uiPlaying,
uiCheatMode,
uiFocusRing,
uiLaunchConfig,
uiWorldCursor,
uiWorldEditor,
uiREPL,
uiInventory,
uiInventorySort,
uiInventorySearch,
uiScrollToEnd,
uiModal,
uiGoal,
uiHideGoals,
uiAchievements,
lgTicksPerSecond,
lastFrameTime,
accumulatedTime,
tickCount,
frameCount,
frameTickCount,
lastInfoTime,
uiShowFPS,
uiShowREPL,
uiShowZero,
uiShowDebug,
uiShowRobots,
uiHideRobotsUntil,
uiInventoryShouldUpdate,
uiTPF,
uiFPS,
uiAttrMap,
scenarioRef,
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.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 qualified as W
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.Repl
import Swarm.TUI.View.Attribute.Attr (swarmAttrMap)
import Swarm.Util
import Swarm.Util.Lens (makeLensesExcluding)
import System.Clock
data UIState = UIState
{ :: Menu
, UIState -> Bool
_uiPlaying :: Bool
, UIState -> Bool
_uiCheatMode :: Bool
, UIState -> FocusRing Name
_uiFocusRing :: FocusRing Name
, UIState -> LaunchOptions
_uiLaunchConfig :: LaunchOptions
, UIState -> Maybe (Cosmic Coords)
_uiWorldCursor :: Maybe (Cosmic W.Coords)
, UIState -> WorldEditor Name
_uiWorldEditor :: WorldEditor Name
, UIState -> REPLState
_uiREPL :: REPLState
, UIState -> Maybe (Int, List Name InventoryListEntry)
_uiInventory :: Maybe (Int, BL.List Name InventoryListEntry)
, UIState -> InventorySortOptions
_uiInventorySort :: InventorySortOptions
, UIState -> Maybe Text
_uiInventorySearch :: Maybe Text
, UIState -> Bool
_uiScrollToEnd :: Bool
, UIState -> Maybe Modal
_uiModal :: Maybe Modal
, UIState -> GoalDisplay
_uiGoal :: GoalDisplay
, UIState -> Bool
_uiHideGoals :: Bool
, UIState -> Map CategorizedAchievement Attainment
_uiAchievements :: Map CategorizedAchievement Attainment
, UIState -> Bool
_uiShowFPS :: Bool
, UIState -> Bool
_uiShowREPL :: Bool
, UIState -> Bool
_uiShowZero :: Bool
, UIState -> Bool
_uiShowDebug :: 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 -> AttrMap
_uiAttrMap :: AttrMap
, UIState -> Maybe ScenarioInfoPair
_scenarioRef :: Maybe ScenarioInfoPair
}
uiMenu :: Lens' UIState Menu
uiPlaying :: Lens' UIState Bool
uiCheatMode :: Lens' UIState Bool
uiLaunchConfig :: Lens' UIState LaunchOptions
uiFocusRing :: Lens' UIState (FocusRing Name)
uiWorldCursor :: Lens' UIState (Maybe (Cosmic W.Coords))
uiWorldEditor :: Lens' UIState (WorldEditor Name)
uiREPL :: Lens' UIState REPLState
uiInventorySort :: Lens' UIState InventorySortOptions
uiInventorySearch :: Lens' UIState (Maybe Text)
uiInventory :: Lens' UIState (Maybe (Int, BL.List Name InventoryListEntry))
uiScrollToEnd :: Lens' UIState Bool
uiModal :: Lens' UIState (Maybe Modal)
uiGoal :: Lens' UIState GoalDisplay
uiHideGoals :: Lens' UIState Bool
uiAchievements :: Lens' UIState (Map CategorizedAchievement Attainment)
uiShowFPS :: Lens' UIState Bool
uiShowREPL :: Lens' UIState Bool
uiShowZero :: Lens' UIState Bool
uiShowDebug :: Lens' UIState Bool
uiHideRobotsUntil :: Lens' UIState TimeSpec
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)
uiInventoryShouldUpdate :: Lens' UIState Bool
uiTPF :: Lens' UIState Double
uiFPS :: Lens' UIState Double
uiAttrMap :: Lens' UIState AttrMap
scenarioRef :: Lens' UIState (Maybe ScenarioInfoPair)
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}
tickCount :: Lens' UIState Int
frameCount :: Lens' UIState Int
frameTickCount :: Lens' UIState Int
lastInfoTime :: Lens' UIState TimeSpec
lastFrameTime :: Lens' UIState TimeSpec
accumulatedTime :: Lens' UIState TimeSpec
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
defaultInitLgTicksPerSecond :: Int
defaultInitLgTicksPerSecond :: Int
defaultInitLgTicksPerSecond = Int
4
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 <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO 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
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 (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO forall a b. (a -> b) -> a -> b
$ Clock -> IO TimeSpec
getTime Clock
Monotonic
[Attainment]
achievements <- forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
m [Attainment]
loadAchievementsInfo
LaunchOptions
launchConfigPanel <- 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
, _uiFocusRing :: FocusRing Name
_uiFocusRing = FocusRing Name
initFocusRing
, _uiWorldCursor :: Maybe (Cosmic Coords)
_uiWorldCursor = forall a. Maybe a
Nothing
, _uiWorldEditor :: WorldEditor Name
_uiWorldEditor = TimeSpec -> WorldEditor Name
initialWorldEditor TimeSpec
startTime
, _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
, _uiInventorySearch :: Maybe Text
_uiInventorySearch = forall a. Maybe a
Nothing
, _uiScrollToEnd :: Bool
_uiScrollToEnd = Bool
False
, _uiModal :: Maybe Modal
_uiModal = forall a. Maybe a
Nothing
, _uiGoal :: GoalDisplay
_uiGoal = GoalDisplay
emptyGoalDisplay
, _uiHideGoals :: Bool
_uiHideGoals = Bool
False
, _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
, _uiShowREPL :: Bool
_uiShowREPL = Bool
True
, _uiShowZero :: Bool
_uiShowZero = Bool
True
, _uiShowDebug :: Bool
_uiShowDebug = Bool
False
, _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
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
, _uiAttrMap :: AttrMap
_uiAttrMap = AttrMap
swarmAttrMap
, _scenarioRef :: Maybe ScenarioInfoPair
_scenarioRef = forall a. Maybe a
Nothing
}
forall (m :: * -> *) a. Monad m => a -> m a
return UIState
out