License | BSD-3-Clause |
---|---|
Safe Haskell | None |
Language | Haskell2010 |
Swarm.TUI.Model
Description
Application state for the brick
-based Swarm TUI.
Synopsis
- data AppEvent
- = Frame
- | Web WebCommand
- | PopupEvent (EventM Name AppState ())
- | UpstreamVersion (Either (Severity, Text) String)
- data FocusablePanel
- data Name
- = FocusablePanel FocusablePanel
- | WorldEditorPanelControl WorldEditorFocusable
- | REPLInput
- | REPLHistoryCache
- | WorldCache
- | WorldExtent
- | WorldPositionIndicator
- | EntityPaintList
- | EntityPaintListItem Int
- | TerrainList
- | TerrainListItem Int
- | InventoryList
- | InventoryListItem Int
- | ScenarioPreview FilePath
- | MenuList
- | AchievementList
- | ScenarioConfigControl ScenarioConfigPanel
- | GoalWidgets GoalWidget
- | StructureWidgets StructureWidget
- | ScenarioList
- | RobotsListDialog RobotsDisplayMode
- | InfoViewport
- | ModalViewport
- | REPLViewport
- | Button Button
- | UIShortcut Text
- | CustomName Text
- data WebCommand = RunWebCode {
- webEntry :: Text
- webReply :: WebInvocationState -> IO ()
- data WebInvocationState
- data RejectionReason
- data ModalType
- data ScenarioOutcome
- data Button
- data ButtonAction
- = Cancel
- | KeepPlaying
- | StartOver Seed (ScenarioWith ScenarioPath)
- | QuitAction
- | Next (NonEmpty (ScenarioWith ScenarioPath))
- modalType :: Lens' Modal ModalType
- modalDialog :: Lens' Modal (Dialog ButtonAction Name)
- data MainMenuEntry
- mainMenu :: MainMenuEntry -> List Name MainMenuEntry
- _NewGameMenu :: Prism' Menu (NonEmpty (List Name (ScenarioItem ScenarioPath)))
- mkScenarioList :: ScenarioCollection a -> List Name (ScenarioItem a)
- data InventoryListEntry
- = Separator Text
- | InventoryEntry Count Entity
- | EquippedEntry Entity
- _Separator :: Prism' InventoryListEntry Text
- _InventoryEntry :: Prism' InventoryListEntry (Count, Entity)
- _EquippedEntry :: Prism' InventoryListEntry Entity
- populateInventoryList :: MonadState UIInventory m => Maybe Robot -> m ()
- infoScroll :: ViewportScroll Name
- modalScroll :: ViewportScroll Name
- replScroll :: ViewportScroll Name
- logEvent :: LogSource -> Severity -> Text -> Text -> Notifications LogEntry -> Notifications LogEntry
- type SwarmKeyDispatcher = KeyDispatcher SwarmEvent (EventM Name AppState)
- data KeyEventHandlingState = KeyEventHandlingState (KeyConfig SwarmEvent) SwarmKeyDispatchers
- data SwarmKeyDispatchers = SwarmKeyDispatchers {}
- keyConfig :: Lens' KeyEventHandlingState (KeyConfig SwarmEvent)
- keyDispatchers :: Lens' KeyEventHandlingState SwarmKeyDispatchers
- data AppState = AppState PlayState UIState KeyEventHandlingState RuntimeState (AnimationManager AppState AppEvent Name)
- uiState :: Lens' AppState UIState
- playState :: Lens' AppState PlayState
- keyEventHandling :: Lens' AppState KeyEventHandlingState
- runtimeState :: Lens' AppState RuntimeState
- animationMgr :: Lens' AppState (AnimationManager AppState AppEvent Name)
- data ScenarioState = ScenarioState GameState UIGameplay
- gameState :: Lens' ScenarioState GameState
- uiGameplay :: Lens' ScenarioState UIGameplay
- data PlayState = PlayState {}
- scenarioState :: Lens' PlayState ScenarioState
- progression :: Lens' PlayState ProgressionState
- data ProgressionState = ProgressionState {
- _scenarios :: ScenarioCollection ScenarioInfo
- _attainedAchievements :: Map CategorizedAchievement Attainment
- _uiPopups :: PopupState
- _uiPopupAnimationState :: AnimationState
- _scenarioSequence :: [ScenarioWith ScenarioPath]
- scenarios :: Lens' ProgressionState (ScenarioCollection ScenarioInfo)
- attainedAchievements :: Lens' ProgressionState (Map CategorizedAchievement Attainment)
- uiPopups :: Lens' ProgressionState PopupState
- uiPopupAnimationState :: Lens' ProgressionState AnimationState
- scenarioSequence :: Lens' ProgressionState [ScenarioWith ScenarioPath]
- data AnimationState
- _AnimActive :: Prism' AnimationState (Animation AppState Name)
- _AnimScheduled :: Prism' AnimationState ()
- _AnimInactive :: Prism' AnimationState ()
- data AppOpts = AppOpts {
- userSeed :: Maybe Seed
- userScenario :: Maybe FilePath
- scriptToRun :: Maybe FilePath
- pausedAtStart :: Bool
- autoPlay :: Bool
- autoShowObjectives :: Bool
- speed :: Int
- debugOptions :: Set DebugOption
- colorMode :: Maybe ColorMode
- userWebPort :: Maybe Port
- repoGitInfo :: Maybe GitInfo
- defaultAppOpts :: AppOpts
- data ColorMode
- focusedItem :: ScenarioState -> Maybe InventoryListEntry
- focusedEntity :: ScenarioState -> Maybe Entity
- animTraversal :: Traversal' AnimationState (Maybe (Animation AppState Name))
Custom UI label types
These types are used as parameters to various brick
types.
AppEvent
represents a type for custom event types our app can
receive. The primary custom event Frame
is sent by a separate thread as fast as
it can, telling the TUI to render a new frame. The custom event PopupEvent
is sent
by the animation manager and contains an event that starts, stops, or updates a
popup notification.
Constructors
Frame | |
Web WebCommand | |
PopupEvent (EventM Name AppState ()) | |
UpstreamVersion (Either (Severity, Text) String) |
data FocusablePanel Source #
Constructors
REPLPanel | The panel containing the REPL. |
WorldPanel | The panel containing the world view. |
WorldEditorPanel | The panel containing the world editor controls. |
RobotPanel | The panel showing robot info and inventory on the top left. |
InfoPanel | The info panel on the bottom left. |
Instances
Name
represents names to uniquely identify various components
of the UI, such as forms, panels, caches, extents, lists, and buttons.
Constructors
FocusablePanel FocusablePanel | |
WorldEditorPanelControl WorldEditorFocusable | An individual control within the world editor panel. |
REPLInput | The REPL input form. |
REPLHistoryCache | The REPL history cache. |
WorldCache | The render cache for the world view. |
WorldExtent | The cached extent for the world view. |
WorldPositionIndicator | The cursor/viewCenter display in the bottom left of the World view |
EntityPaintList | The list of possible entities to paint a map with. |
EntityPaintListItem Int | The entity paint item position in the EntityPaintList. |
TerrainList | The list of possible terrain materials. |
TerrainListItem Int | The terrain item position in the TerrainList. |
InventoryList | The list of inventory items for the currently focused robot. |
InventoryListItem Int | The inventory item position in the InventoryList. |
ScenarioPreview FilePath | Cacheable scenario preview |
MenuList | The list of main menu choices. |
AchievementList | The list of achievements. |
ScenarioConfigControl ScenarioConfigPanel | An individual control within the scenario launch config panel |
GoalWidgets GoalWidget | The list of goals/objectives. |
StructureWidgets StructureWidget | The list of goals/objectives. |
ScenarioList | The list of scenario choices. |
RobotsListDialog RobotsDisplayMode | The robots list |
InfoViewport | The scrollable viewport for the info panel. |
ModalViewport | The scrollable viewport for any modal dialog. |
REPLViewport | The scrollable viewport for the REPL. |
Button Button | A clickable button in a modal dialog. |
UIShortcut Text | A clickable shortcut in the TUI. |
CustomName Text | A custom widget name, for use in applications built on top of the Swarm library. |
Web command
data WebCommand Source #
Constructors
RunWebCode | |
Fields
|
data WebInvocationState Source #
Constructors
Rejected RejectionReason | |
InProgress | |
Complete String |
Instances
data RejectionReason Source #
Constructors
NoActiveGame | |
AlreadyRunning | |
ParseError String |
Instances
FromJSON RejectionReason Source # | |||||
Defined in Swarm.TUI.Model.WebCommand Methods parseJSON :: Value -> Parser RejectionReason # parseJSONList :: Value -> Parser [RejectionReason] # | |||||
ToJSON RejectionReason Source # | |||||
Defined in Swarm.TUI.Model.WebCommand Methods toJSON :: RejectionReason -> Value # toEncoding :: RejectionReason -> Encoding # toJSONList :: [RejectionReason] -> Value # toEncodingList :: [RejectionReason] -> Encoding # omitField :: RejectionReason -> Bool # | |||||
Generic RejectionReason Source # | |||||
Defined in Swarm.TUI.Model.WebCommand Associated Types
Methods from :: RejectionReason -> Rep RejectionReason x # to :: Rep RejectionReason x -> RejectionReason # | |||||
Show RejectionReason Source # | |||||
Defined in Swarm.TUI.Model.WebCommand Methods showsPrec :: Int -> RejectionReason -> ShowS # show :: RejectionReason -> String # showList :: [RejectionReason] -> ShowS # | |||||
Eq RejectionReason Source # | |||||
Defined in Swarm.TUI.Model.WebCommand Methods (==) :: RejectionReason -> RejectionReason -> Bool # (/=) :: RejectionReason -> RejectionReason -> Bool # | |||||
Ord RejectionReason Source # | |||||
Defined in Swarm.TUI.Model.WebCommand Methods compare :: RejectionReason -> RejectionReason -> Ordering # (<) :: RejectionReason -> RejectionReason -> Bool # (<=) :: RejectionReason -> RejectionReason -> Bool # (>) :: RejectionReason -> RejectionReason -> Bool # (>=) :: RejectionReason -> RejectionReason -> Bool # max :: RejectionReason -> RejectionReason -> RejectionReason # min :: RejectionReason -> RejectionReason -> RejectionReason # | |||||
type Rep RejectionReason Source # | |||||
Defined in Swarm.TUI.Model.WebCommand type Rep RejectionReason = D1 ('MetaData "RejectionReason" "Swarm.TUI.Model.WebCommand" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-tui" 'False) (C1 ('MetaCons "NoActiveGame" 'PrefixI 'False) (U1 :: Type -> Type) :+: (C1 ('MetaCons "AlreadyRunning" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "ParseError" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 String)))) |
Menus and dialogs
data ScenarioOutcome Source #
Instances
Show ScenarioOutcome Source # | |
Defined in Swarm.TUI.Model.Menu Methods showsPrec :: Int -> ScenarioOutcome -> ShowS # show :: ScenarioOutcome -> String # showList :: [ScenarioOutcome] -> ShowS # | |
Eq ScenarioOutcome Source # | |
Defined in Swarm.TUI.Model.Menu Methods (==) :: ScenarioOutcome -> ScenarioOutcome -> Bool # (/=) :: ScenarioOutcome -> ScenarioOutcome -> Bool # |
Clickable buttons in modal dialogs.
Constructors
CancelButton | |
KeepPlayingButton | |
StartOverButton | |
QuitButton | |
NextButton |
data ButtonAction Source #
Constructors
Cancel | |
KeepPlaying | |
StartOver Seed (ScenarioWith ScenarioPath) | |
QuitAction | |
Next (NonEmpty (ScenarioWith ScenarioPath)) |
data MainMenuEntry Source #
Instances
Bounded MainMenuEntry Source # | |
Defined in Swarm.TUI.Model.Menu | |
Enum MainMenuEntry Source # | |
Defined in Swarm.TUI.Model.Menu Methods succ :: MainMenuEntry -> MainMenuEntry # pred :: MainMenuEntry -> MainMenuEntry # toEnum :: Int -> MainMenuEntry # fromEnum :: MainMenuEntry -> Int # enumFrom :: MainMenuEntry -> [MainMenuEntry] # enumFromThen :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry] # enumFromTo :: MainMenuEntry -> MainMenuEntry -> [MainMenuEntry] # enumFromThenTo :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry -> [MainMenuEntry] # | |
Read MainMenuEntry Source # | |
Defined in Swarm.TUI.Model.Menu Methods readsPrec :: Int -> ReadS MainMenuEntry # readList :: ReadS [MainMenuEntry] # | |
Show MainMenuEntry Source # | |
Defined in Swarm.TUI.Model.Menu Methods showsPrec :: Int -> MainMenuEntry -> ShowS # show :: MainMenuEntry -> String # showList :: [MainMenuEntry] -> ShowS # | |
Eq MainMenuEntry Source # | |
Defined in Swarm.TUI.Model.Menu Methods (==) :: MainMenuEntry -> MainMenuEntry -> Bool # (/=) :: MainMenuEntry -> MainMenuEntry -> Bool # | |
Ord MainMenuEntry Source # | |
Defined in Swarm.TUI.Model.Menu Methods compare :: MainMenuEntry -> MainMenuEntry -> Ordering # (<) :: MainMenuEntry -> MainMenuEntry -> Bool # (<=) :: MainMenuEntry -> MainMenuEntry -> Bool # (>) :: MainMenuEntry -> MainMenuEntry -> Bool # (>=) :: MainMenuEntry -> MainMenuEntry -> Bool # max :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry # min :: MainMenuEntry -> MainMenuEntry -> MainMenuEntry # |
mkScenarioList :: ScenarioCollection a -> List Name (ScenarioItem a) Source #
Create a brick List
of scenario items from a ScenarioCollection
.
UI state
Inventory
data InventoryListEntry Source #
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.
Constructors
Separator Text | |
InventoryEntry Count Entity | |
EquippedEntry Entity |
Instances
Eq InventoryListEntry Source # | |
Defined in Swarm.TUI.Model.Menu Methods (==) :: InventoryListEntry -> InventoryListEntry -> Bool # (/=) :: InventoryListEntry -> InventoryListEntry -> Bool # |
_InventoryEntry :: Prism' InventoryListEntry (Count, Entity) Source #
_EquippedEntry :: Prism' InventoryListEntry Entity Source #
Updating
populateInventoryList :: MonadState UIInventory m => Maybe Robot -> m () Source #
Given the focused robot, populate the UI inventory list in the info panel with information about its inventory.
Utility
logEvent :: LogSource -> Severity -> Text -> Text -> Notifications LogEntry -> Notifications LogEntry Source #
Simply log to the runtime event log.
data KeyEventHandlingState Source #
Constructors
KeyEventHandlingState (KeyConfig SwarmEvent) SwarmKeyDispatchers |
data SwarmKeyDispatchers Source #
keyConfig :: Lens' KeyEventHandlingState (KeyConfig SwarmEvent) Source #
Keybindings (possibly customized by player) for SwarmEvent
s.
keyDispatchers :: Lens' KeyEventHandlingState SwarmKeyDispatchers Source #
Dispatchers that will call handler on key combo.
App state
The AppState
just stores together the other states.
This is so you can use a smaller state when e.g. writing some game logic or updating the UI. Also consider that GameState can change when loading a new scenario - if the state should persist games, use RuntimeState.
Constructors
AppState PlayState UIState KeyEventHandlingState RuntimeState (AnimationManager AppState AppEvent Name) |
keyEventHandling :: Lens' AppState KeyEventHandlingState Source #
The key event handling configuration.
runtimeState :: Lens' AppState RuntimeState Source #
The RuntimeState
record
animationMgr :: Lens' AppState (AnimationManager AppState AppEvent Name) Source #
The AnimationManager
record
data ScenarioState Source #
This encapsulates both game and UI state for an actively-playing scenario, as well as state that evolves as a result of playing a scenario.
Constructors
ScenarioState GameState UIGameplay |
gameState :: Lens' ScenarioState GameState Source #
The GameState
record.
uiGameplay :: Lens' ScenarioState UIGameplay Source #
UI active during live gameplay
This encapsulates both game and UI state for an actively-playing scenario, as well as state that evolves as a result of playing a scenario.
Constructors
PlayState | |
Fields |
scenarioState :: Lens' PlayState ScenarioState Source #
The ScenarioState
record.
progression :: Lens' PlayState ProgressionState Source #
State that can evolve as the user progresses through scenarios.
data ProgressionState Source #
State that can evolve as the user progresses through scenarios. This includes achievements and completion records.
Note that scenario completion/achievements are serialized to disk storage, but we also persist in memory since we don't reload data from disk as we progress through scenarios.
Constructors
ProgressionState | |
Fields
|
scenarios :: Lens' ProgressionState (ScenarioCollection ScenarioInfo) Source #
The collection of scenarios that comes with the game.
attainedAchievements :: Lens' ProgressionState (Map CategorizedAchievement Attainment) Source #
Map of achievements that were attained
uiPopups :: Lens' ProgressionState PopupState Source #
Queue of popups to display
uiPopupAnimationState :: Lens' ProgressionState AnimationState Source #
Popup Animation State
scenarioSequence :: Lens' ProgressionState [ScenarioWith ScenarioPath] Source #
Remaining scenarios in the current sequence
data AnimationState Source #
This enapsulates the state of a given animation that changes over time. AnimInactive
means that
the application is ready to start a new animation. AnimScheduled
means that the application
has told the animation manager to start the animation, but it hasn't started yet. AnimActive
means
that the animation is currently in progress.
Constructors
AnimActive (Animation AppState Name) | |
AnimScheduled | |
AnimInactive |
_AnimInactive :: Prism' AnimationState () Source #
Prisms for AnimationState
Initialization
Command-line options for configuring the app.
Constructors
AppOpts | |
Fields
|
defaultAppOpts :: AppOpts Source #
A default/empty AppOpts
record.
Re-exported types used in options
Constructors
NoColor | |
ColorMode8 | |
ColorMode16 | |
ColorMode240 !Word8 | |
FullColor |
Utility
focusedItem :: ScenarioState -> Maybe InventoryListEntry Source #
Get the currently focused InventoryListEntry
from the robot
info panel (if any).
focusedEntity :: ScenarioState -> Maybe Entity Source #
Get the currently focused entity from the robot info panel (if
any). This is just like focusedItem
but forgets the
distinction between plain inventory items and equipped devices.
animTraversal :: Traversal' AnimationState (Maybe (Animation AppState Name)) Source #
A non-lawful traversal for use in animations that allows us to manage the state of an animation and update it properly when we process an event sent by the animation manager. Exploits some assumptions about Brick's implementation of animations. It is defined such that when the animation manager starts the animation by setting the target of the traversal to Just theAnimation, the traversal will actually set the AnimationState of the popup animation to AnimActive theAnimation. When the animation manager signals that the animation has stopped by setting the target of the traversal to Nothing, the traversal will set the AnimationState of the popup to AnimInactive.