| License | BSD-3-Clause |
|---|---|
| Safe Haskell | Safe-Inferred |
| Language | Haskell2010 |
Swarm.TUI.Model
Description
Application state for the brick-based Swarm TUI.
Synopsis
- data AppEvent
- = Frame
- | Web WebCommand
- | UpstreamVersion (Either NewReleaseFailure String)
- newtype WebCommand = RunWebCode Text
- data FocusablePanel
- data Name
- = FocusablePanel FocusablePanel
- | WorldEditorPanelControl WorldEditorFocusable
- | REPLInput
- | REPLHistoryCache
- | WorldCache
- | WorldExtent
- | WorldPositionIndicator
- | EntityPaintList
- | EntityPaintListItem Int
- | TerrainList
- | TerrainListItem Int
- | InventoryList
- | InventoryListItem Int
- | MenuList
- | AchievementList
- | ScenarioConfigControl ScenarioConfigPanel
- | GoalWidgets GoalWidget
- | StructureWidgets StructureWidget
- | ScenarioList
- | InfoViewport
- | ModalViewport
- | REPLViewport
- | Button Button
- | CustomName Text
- data ModalType
- data ScenarioOutcome
- data Button
- data ButtonAction
- = Cancel
- | KeepPlaying
- | StartOver Seed ScenarioInfoPair
- | QuitAction
- | Next ScenarioInfoPair
- data Modal = Modal {}
- modalType :: Lens' Modal ModalType
- modalDialog :: Lens' Modal (Dialog ButtonAction Name)
- data MainMenuEntry
- mainMenu :: MainMenuEntry -> List Name MainMenuEntry
- data Menu
- = NoMenu
- | MainMenu (List Name MainMenuEntry)
- | NewGameMenu (NonEmpty (List Name ScenarioItem))
- | AchievementsMenu (List Name CategorizedAchievement)
- | MessagesMenu
- | AboutMenu
- _NewGameMenu :: Prism' Menu (NonEmpty (List Name ScenarioItem))
- mkScenarioList :: Bool -> ScenarioCollection -> List Name ScenarioItem
- mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu
- 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 GameState UIState KeyEventHandlingState RuntimeState
- gameState :: Lens' AppState GameState
- uiState :: Lens' AppState UIState
- keyEventHandling :: Lens' AppState KeyEventHandlingState
- runtimeState :: Lens' AppState RuntimeState
- data AppOpts = AppOpts {}
- defaultAppOpts :: AppOpts
- data ColorMode
- focusedItem :: AppState -> Maybe InventoryListEntry
- focusedEntity :: AppState -> Maybe Entity
- nextScenario :: Menu -> Maybe ScenarioInfoPair
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.
Constructors
| Frame | |
| Web WebCommand | |
| UpstreamVersion (Either NewReleaseFailure String) |
newtype WebCommand Source #
Constructors
| RunWebCode Text |
Instances
| Show WebCommand Source # | |
Defined in Swarm.TUI.Model Methods showsPrec :: Int -> WebCommand -> ShowS # show :: WebCommand -> String # showList :: [WebCommand] -> ShowS # | |
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. |
| 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. |
| 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. |
| CustomName Text | A custom widget name, for use in applications built on top of the Swarm library. |
Menus and dialogs
Constructors
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 ScenarioInfoPair | |
| QuitAction | |
| Next ScenarioInfoPair |
Constructors
| Modal | |
Fields | |
data MainMenuEntry Source #
Instances
Constructors
| NoMenu | We started playing directly from command line, no menu to show |
| MainMenu (List Name MainMenuEntry) | |
| NewGameMenu (NonEmpty (List Name ScenarioItem)) | Stack of scenario item lists. INVARIANT: the currently selected menu item is ALWAYS the same as the scenario currently being played. See https://github.com/swarm-game/swarm/issues/1064 and https://github.com/swarm-game/swarm/pull/1065. |
| AchievementsMenu (List Name CategorizedAchievement) | |
| MessagesMenu | |
| AboutMenu |
mkScenarioList :: Bool -> ScenarioCollection -> List Name ScenarioItem Source #
Create a brick List of scenario items from a ScenarioCollection.
mkNewGameMenu :: Bool -> ScenarioCollection -> FilePath -> Maybe Menu Source #
Given a ScenarioCollection and a FilePath which is the canonical
path to some folder or scenario, construct a NewGameMenu stack
focused on the given item, if possible.
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 SwarmEvents.
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 GameState UIState KeyEventHandlingState RuntimeState |
keyEventHandling :: Lens' AppState KeyEventHandlingState Source #
The key event handling configuration.
runtimeState :: Lens' AppState RuntimeState Source #
The RuntimeState record
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 :: AppState -> Maybe InventoryListEntry Source #
Get the currently focused InventoryListEntry from the robot
info panel (if any).
focusedEntity :: AppState -> 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.
nextScenario :: Menu -> Maybe ScenarioInfoPair Source #
Extract the scenario which would come next in the menu from the
currently selected scenario (if any). Can return Nothing if
either we are not in the NewGameMenu, or the current scenario
is the last among its siblings.