{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}
module Swarm.TUI.Model.UI (
UIState (..),
uiMenu,
uiPlaying,
uiDebugOptions,
uiLaunchConfig,
uiAttrMap,
initFocusRing,
defaultInitLgTicksPerSecond,
initUIState,
UIInitOptions (..),
) where
import Brick (AttrMap)
import Brick.Focus
import Control.Effect.Accum
import Control.Effect.Lift
import Control.Lens hiding (from, (<.>))
import Data.List.Extra (enumerate)
import Data.Sequence (Seq)
import Data.Set (Set)
import Swarm.Failure (SystemFailure)
import Swarm.TUI.Launch.Model
import Swarm.TUI.Launch.Prep
import Swarm.TUI.Model.DebugOption (DebugOption)
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.View.Attribute.Attr (swarmAttrMap)
import Swarm.Util.Lens (makeLensesNoSigs)
data UIState = UIState
{ :: Menu
, UIState -> Bool
_uiPlaying :: Bool
, UIState -> Set DebugOption
_uiDebugOptions :: Set DebugOption
, UIState -> LaunchOptions
_uiLaunchConfig :: LaunchOptions
, UIState -> AttrMap
_uiAttrMap :: AttrMap
}
uiMenu :: Lens' UIState Menu
uiPlaying :: Lens' UIState Bool
uiDebugOptions :: Lens' UIState (Set DebugOption)
uiLaunchConfig :: Lens' UIState LaunchOptions
uiAttrMap :: Lens' UIState AttrMap
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
defaultInitLgTicksPerSecond :: Int
defaultInitLgTicksPerSecond :: Int
defaultInitLgTicksPerSecond = Int
4
data UIInitOptions = UIInitOptions
{ UIInitOptions -> Int
speed :: Int
, UIInitOptions -> Bool
showMainMenu :: Bool
, UIInitOptions -> Bool
autoShowObjectives :: Bool
, UIInitOptions -> Set DebugOption
debugOptions :: Set DebugOption
}
deriving (UIInitOptions -> UIInitOptions -> Bool
(UIInitOptions -> UIInitOptions -> Bool)
-> (UIInitOptions -> UIInitOptions -> Bool) -> Eq UIInitOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: UIInitOptions -> UIInitOptions -> Bool
== :: UIInitOptions -> UIInitOptions -> Bool
$c/= :: UIInitOptions -> UIInitOptions -> Bool
/= :: UIInitOptions -> UIInitOptions -> Bool
Eq, Int -> UIInitOptions -> ShowS
[UIInitOptions] -> ShowS
UIInitOptions -> String
(Int -> UIInitOptions -> ShowS)
-> (UIInitOptions -> String)
-> ([UIInitOptions] -> ShowS)
-> Show UIInitOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> UIInitOptions -> ShowS
showsPrec :: Int -> UIInitOptions -> ShowS
$cshow :: UIInitOptions -> String
show :: UIInitOptions -> String
$cshowList :: [UIInitOptions] -> ShowS
showList :: [UIInitOptions] -> ShowS
Show)
initUIState ::
( Has (Accum (Seq SystemFailure)) sig m
, Has (Lift IO) sig m
) =>
UIInitOptions ->
m UIState
initUIState :: forall (sig :: (* -> *) -> * -> *) (m :: * -> *).
(Has (Accum (Seq SystemFailure)) sig m, Has (Lift IO) sig m) =>
UIInitOptions -> m UIState
initUIState UIInitOptions {Bool
Int
Set DebugOption
speed :: UIInitOptions -> Int
showMainMenu :: UIInitOptions -> Bool
autoShowObjectives :: UIInitOptions -> Bool
debugOptions :: UIInitOptions -> Set DebugOption
speed :: Int
showMainMenu :: Bool
autoShowObjectives :: Bool
debugOptions :: Set DebugOption
..} = do
LaunchOptions
launchConfigPanel <- IO LaunchOptions -> m LaunchOptions
forall (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Lift IO) sig m =>
IO a -> m a
sendIO IO LaunchOptions
initConfigPanel
UIState -> m UIState
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return
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
, _uiDebugOptions :: Set DebugOption
_uiDebugOptions = Set DebugOption
debugOptions
, _uiLaunchConfig :: LaunchOptions
_uiLaunchConfig = LaunchOptions
launchConfigPanel
, _uiAttrMap :: AttrMap
_uiAttrMap = AttrMap
swarmAttrMap
}