swarm-0.7.0.0: 2D resource gathering game with programmable robots
LicenseBSD-3-Clause
Safe HaskellNone
LanguageHaskell2010

Swarm.TUI.Model

Description

Application state for the brick-based Swarm TUI.

Synopsis

Custom UI label types

These types are used as parameters to various brick types.

data AppEvent Source #

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.

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

Instances details
Bounded FocusablePanel Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Enum FocusablePanel Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Read FocusablePanel Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Show FocusablePanel Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Eq FocusablePanel Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Ord FocusablePanel Source # 
Instance details

Defined in Swarm.TUI.Model.Name

data Name Source #

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.

Instances

Instances details
Read Name Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Show Name Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Methods

showsPrec :: Int -> Name -> ShowS #

show :: Name -> String #

showList :: [Name] -> ShowS #

Eq Name Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Methods

(==) :: Name -> Name -> Bool #

(/=) :: Name -> Name -> Bool #

Ord Name Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Methods

compare :: Name -> Name -> Ordering #

(<) :: Name -> Name -> Bool #

(<=) :: Name -> Name -> Bool #

(>) :: Name -> Name -> Bool #

(>=) :: Name -> Name -> Bool #

max :: Name -> Name -> Name #

min :: Name -> Name -> Name #

Web command

data WebCommand Source #

Constructors

RunWebCode 

data WebInvocationState Source #

Instances

Instances details
FromJSON WebInvocationState Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

ToJSON WebInvocationState Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Generic WebInvocationState Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Associated Types

type Rep WebInvocationState 
Instance details

Defined in Swarm.TUI.Model.WebCommand

type Rep WebInvocationState = D1 ('MetaData "WebInvocationState" "Swarm.TUI.Model.WebCommand" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-tui" 'False) (C1 ('MetaCons "Rejected" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 RejectionReason)) :+: (C1 ('MetaCons "InProgress" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Complete" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 String))))
Show WebInvocationState Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Eq WebInvocationState Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Ord WebInvocationState Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

type Rep WebInvocationState Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

type Rep WebInvocationState = D1 ('MetaData "WebInvocationState" "Swarm.TUI.Model.WebCommand" "swarm-0.7.0.0-IuFfgHrMoE7JrptOBRVOwx-swarm-tui" 'False) (C1 ('MetaCons "Rejected" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 RejectionReason)) :+: (C1 ('MetaCons "InProgress" 'PrefixI 'False) (U1 :: Type -> Type) :+: C1 ('MetaCons "Complete" 'PrefixI 'False) (S1 ('MetaSel ('Nothing :: Maybe Symbol) 'NoSourceUnpackedness 'NoSourceStrictness 'DecidedStrict) (Rec0 String))))

data RejectionReason Source #

Instances

Instances details
FromJSON RejectionReason Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

ToJSON RejectionReason Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Generic RejectionReason Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Associated Types

type Rep RejectionReason 
Instance details

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))))
Show RejectionReason Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Eq RejectionReason Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

Ord RejectionReason Source # 
Instance details

Defined in Swarm.TUI.Model.WebCommand

type Rep RejectionReason Source # 
Instance details

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 Button Source #

Clickable buttons in modal dialogs.

Instances

Instances details
Bounded Button Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Enum Button Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Read Button Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Show Button Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Eq Button Source # 
Instance details

Defined in Swarm.TUI.Model.Name

Methods

(==) :: Button -> Button -> Bool #

(/=) :: Button -> Button -> Bool #

Ord Button Source # 
Instance details

Defined in Swarm.TUI.Model.Name

data ButtonAction Source #

Constructors

Cancel 
KeepPlaying 
StartOver Seed (ScenarioWith ScenarioPath) 
QuitAction 
Next (NonEmpty (ScenarioWith ScenarioPath)) 

data MainMenuEntry Source #

Instances

Instances details
Bounded MainMenuEntry Source # 
Instance details

Defined in Swarm.TUI.Model.Menu

Enum MainMenuEntry Source # 
Instance details

Defined in Swarm.TUI.Model.Menu

Read MainMenuEntry Source # 
Instance details

Defined in Swarm.TUI.Model.Menu

Show MainMenuEntry Source # 
Instance details

Defined in Swarm.TUI.Model.Menu

Eq MainMenuEntry Source # 
Instance details

Defined in Swarm.TUI.Model.Menu

Ord MainMenuEntry Source # 
Instance details

Defined in Swarm.TUI.Model.Menu

_NewGameMenu :: Prism' Menu (NonEmpty (List Name (ScenarioItem ScenarioPath))) Source #

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

Instances details
Eq InventoryListEntry Source # 
Instance details

Defined in Swarm.TUI.Model.Menu

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.

keyConfig :: Lens' KeyEventHandlingState (KeyConfig SwarmEvent) Source #

Keybindings (possibly customized by player) for SwarmEvents.

keyDispatchers :: Lens' KeyEventHandlingState SwarmKeyDispatchers Source #

Dispatchers that will call handler on key combo.

App state

data AppState Source #

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.

keyEventHandling :: Lens' AppState KeyEventHandlingState Source #

The key event handling configuration.

runtimeState :: Lens' AppState RuntimeState Source #

The RuntimeState 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

data PlayState 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.

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

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.

_AnimInactive :: Prism' AnimationState () Source #

Prisms for AnimationState

Initialization

data AppOpts Source #

Command-line options for configuring the app.

Constructors

AppOpts 

Fields

defaultAppOpts :: AppOpts Source #

A default/empty AppOpts record.

Re-exported types used in options

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.