{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE ViewPatterns #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Application state for the @brick@-based Swarm TUI.
module Swarm.TUI.Model (
  -- * Custom UI label types
  -- $uilabel
  AppEvent (..),
  FocusablePanel (..),
  Name (..), -- helps to minimize import lines

  -- ** Web command
  WebCommand (..),
  WebInvocationState (..),
  RejectionReason (..),

  -- * Menus and dialogs
  ModalType (..),
  ScenarioOutcome (..),
  Button (..),
  ButtonAction (..),
  modalType,
  modalDialog,
  MainMenuEntry (..),
  mainMenu,
  _NewGameMenu,
  mkScenarioList,

  -- * UI state

  -- ** Inventory
  InventoryListEntry (..),
  _Separator,
  _InventoryEntry,
  _EquippedEntry,

  -- ** Updating
  populateInventoryList,
  infoScroll,
  modalScroll,
  replScroll,

  -- ** Utility
  logEvent,
  SwarmKeyDispatcher,
  KeyEventHandlingState (KeyEventHandlingState),
  SwarmKeyDispatchers (..),
  keyConfig,
  keyDispatchers,

  -- * App state
  AppState (AppState),
  uiState,
  playState,
  keyEventHandling,
  runtimeState,
  animationMgr,
  ScenarioState (ScenarioState),
  gameState,
  uiGameplay,
  PlayState (..),
  scenarioState,
  progression,
  ProgressionState (..),
  scenarios,
  attainedAchievements,
  uiPopups,
  uiPopupAnimationState,
  scenarioSequence,
  AnimationState (..),
  _AnimActive,
  _AnimScheduled,
  _AnimInactive,

  -- ** Initialization
  AppOpts (..),
  defaultAppOpts,

  -- *** Re-exported types used in options
  ColorMode (..),

  -- ** Utility
  focusedItem,
  focusedEntity,
  animTraversal,
) where

import Brick (EventM, ViewportScroll, viewportScroll)
import Brick.Animation (Animation, AnimationManager)
import Brick.Keybindings as BK
import Brick.Widgets.List qualified as BL
import Control.Lens hiding (from, (<.>))
import Control.Monad ((>=>))
import Control.Monad.State (MonadState)
import Data.List (findIndex)
import Data.Map (Map)
import Data.Maybe (fromMaybe)
import Data.Set (Set)
import Data.Text (Text)
import Data.Vector qualified as V
import GitHash (GitInfo)
import Graphics.Vty (ColorMode (..))
import Network.Wai.Handler.Warp (Port)
import Swarm.Game.Achievement.Attainment
import Swarm.Game.Achievement.Definitions
import Swarm.Game.Entity as E
import Swarm.Game.Ingredients
import Swarm.Game.Popup
import Swarm.Game.Robot
import Swarm.Game.Scenario.Status
import Swarm.Game.ScenarioInfo (ScenarioCollection)
import Swarm.Game.State
import Swarm.Game.State.Runtime
import Swarm.Game.State.Substate
import Swarm.Game.Tick (TickNumber (..))
import Swarm.Game.World.Gen (Seed)
import Swarm.Log
import Swarm.TUI.Inventory.Sorting
import Swarm.TUI.Model.DebugOption (DebugOption)
import Swarm.TUI.Model.Event (SwarmEvent)
import Swarm.TUI.Model.Menu
import Swarm.TUI.Model.Name
import Swarm.TUI.Model.UI
import Swarm.TUI.Model.UI.Gameplay
import Swarm.TUI.Model.WebCommand (RejectionReason (..), WebCommand (..), WebInvocationState (..))
import Swarm.Util.Lens (makeLensesNoSigs)
import Text.Fuzzy qualified as Fuzzy

------------------------------------------------------------
-- Custom UI label types
------------------------------------------------------------

-- $uilabel These types are used as parameters to various @brick@
-- types.

-- | 'Swarm.TUI.Model.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 AppEvent
  = Frame
  | Web WebCommand
  | PopupEvent (EventM Name AppState ())
  | UpstreamVersion (Either (Severity, Text) String)

infoScroll :: ViewportScroll Name
infoScroll :: ViewportScroll Name
infoScroll = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
InfoViewport

modalScroll :: ViewportScroll Name
modalScroll :: ViewportScroll Name
modalScroll = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
ModalViewport

replScroll :: ViewportScroll Name
replScroll :: ViewportScroll Name
replScroll = Name -> ViewportScroll Name
forall n. n -> ViewportScroll n
viewportScroll Name
REPLViewport

--------------------------------------------------
-- Utility

-- | Simply log to the runtime event log.
logEvent :: LogSource -> Severity -> Text -> Text -> Notifications LogEntry -> Notifications LogEntry
logEvent :: LogSource
-> Severity
-> Text
-> Text
-> Notifications LogEntry
-> Notifications LogEntry
logEvent LogSource
src Severity
sev Text
who Text
msg Notifications LogEntry
el =
  Notifications LogEntry
el
    Notifications LogEntry
-> (Notifications LogEntry -> Notifications LogEntry)
-> Notifications LogEntry
forall a b. a -> (a -> b) -> b
& (Int -> Identity Int)
-> Notifications LogEntry -> Identity (Notifications LogEntry)
forall a (f :: * -> *).
Functor f =>
(Int -> f Int) -> Notifications a -> f (Notifications a)
notificationsCount ((Int -> Identity Int)
 -> Notifications LogEntry -> Identity (Notifications LogEntry))
-> (Int -> Int) -> Notifications LogEntry -> Notifications LogEntry
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ Int -> Int
forall a. Enum a => a -> a
succ
    Notifications LogEntry
-> (Notifications LogEntry -> Notifications LogEntry)
-> Notifications LogEntry
forall a b. a -> (a -> b) -> b
& ([LogEntry] -> Identity [LogEntry])
-> Notifications LogEntry -> Identity (Notifications LogEntry)
forall a1 a2 (f :: * -> *).
Functor f =>
([a1] -> f [a2]) -> Notifications a1 -> f (Notifications a2)
notificationsContent (([LogEntry] -> Identity [LogEntry])
 -> Notifications LogEntry -> Identity (Notifications LogEntry))
-> ([LogEntry] -> [LogEntry])
-> Notifications LogEntry
-> Notifications LogEntry
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (LogEntry
l LogEntry -> [LogEntry] -> [LogEntry]
forall a. a -> [a] -> [a]
:)
 where
  l :: LogEntry
l = TickNumber -> LogSource -> Severity -> Text -> Text -> LogEntry
LogEntry (Int64 -> TickNumber
TickNumber Int64
0) LogSource
src Severity
sev Text
who Text
msg

-- | 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.
data ScenarioState = ScenarioState
  { ScenarioState -> GameState
_gameState :: GameState
  , ScenarioState -> UIGameplay
_uiGameplay :: UIGameplay
  }

-- | 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.
data AnimationState
  = AnimActive (Animation AppState Name)
  | AnimScheduled
  | AnimInactive

-- | 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.
data ProgressionState = ProgressionState
  { ProgressionState -> ScenarioCollection ScenarioInfo
_scenarios :: ScenarioCollection ScenarioInfo
  , ProgressionState -> Map CategorizedAchievement Attainment
_attainedAchievements :: Map CategorizedAchievement Attainment
  , ProgressionState -> PopupState
_uiPopups :: PopupState
  , ProgressionState -> AnimationState
_uiPopupAnimationState :: AnimationState
  , ProgressionState -> [ScenarioWith ScenarioPath]
_scenarioSequence :: [ScenarioWith ScenarioPath]
  }

-- | 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.
data PlayState = PlayState
  { PlayState -> ScenarioState
_scenarioState :: ScenarioState
  , PlayState -> ProgressionState
_progression :: ProgressionState
  }

-- ----------------------------------------------------------------------------
--                                   APPSTATE                                --
-- ----------------------------------------------------------------------------

-- | 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.
data AppState = AppState
  { AppState -> PlayState
_playState :: PlayState
  , AppState -> UIState
_uiState :: UIState
  , AppState -> KeyEventHandlingState
_keyEventHandling :: KeyEventHandlingState
  , AppState -> RuntimeState
_runtimeState :: RuntimeState
  , AppState -> AnimationManager AppState AppEvent Name
_animationMgr :: AnimationManager AppState AppEvent Name
  }

------------------------------------------------------------

type SwarmKeyDispatcher = KeyDispatcher SwarmEvent (EventM Name AppState)

data SwarmKeyDispatchers = SwarmKeyDispatchers
  { SwarmKeyDispatchers -> SwarmKeyDispatcher
mainGameDispatcher :: SwarmKeyDispatcher
  , SwarmKeyDispatchers -> SwarmKeyDispatcher
replDispatcher :: SwarmKeyDispatcher
  , SwarmKeyDispatchers -> SwarmKeyDispatcher
worldDispatcher :: SwarmKeyDispatcher
  , SwarmKeyDispatchers -> SwarmKeyDispatcher
robotDispatcher :: SwarmKeyDispatcher
  }

data KeyEventHandlingState = KeyEventHandlingState
  { KeyEventHandlingState -> KeyConfig SwarmEvent
_keyConfig :: KeyConfig SwarmEvent
  , KeyEventHandlingState -> SwarmKeyDispatchers
_keyDispatchers :: SwarmKeyDispatchers
  }

------------------------------------------------------------
-- Functions for updating the UI state
------------------------------------------------------------

-- | Given the focused robot, populate the UI inventory list in the info
--   panel with information about its inventory.
populateInventoryList :: (MonadState UIInventory m) => Maybe Robot -> m ()
populateInventoryList :: forall (m :: * -> *).
MonadState UIInventory m =>
Maybe Robot -> m ()
populateInventoryList Maybe Robot
Nothing = (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Identity
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory -> Identity UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Identity
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory -> Identity UIInventory)
-> Maybe (Int, GenericList Name Vector InventoryListEntry) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe (Int, GenericList Name Vector InventoryListEntry)
forall a. Maybe a
Nothing
populateInventoryList (Just Robot
r) = do
  Maybe (GenericList Name Vector InventoryListEntry)
mList <- Getting
  (First (GenericList Name Vector InventoryListEntry))
  UIInventory
  (GenericList Name Vector InventoryListEntry)
-> m (Maybe (GenericList Name Vector InventoryListEntry))
forall s (m :: * -> *) a.
MonadState s m =>
Getting (First a) s a -> m (Maybe a)
preuse (Getting
   (First (GenericList Name Vector InventoryListEntry))
   UIInventory
   (GenericList Name Vector InventoryListEntry)
 -> m (Maybe (GenericList Name Vector InventoryListEntry)))
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
-> m (Maybe (GenericList Name Vector InventoryListEntry))
forall a b. (a -> b) -> a -> b
$ (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIInventory)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> Maybe (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Int, GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Int, GenericList Name Vector InventoryListEntry))
 -> Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Int, GenericList Name Vector InventoryListEntry))
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector InventoryListEntry
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (GenericList Name Vector InventoryListEntry))
-> (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Int, GenericList Name Vector InventoryListEntry)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Int, GenericList Name Vector InventoryListEntry)
  (Int, GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
_2
  Bool
showZero <- Getting Bool UIInventory Bool -> m Bool
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting Bool UIInventory Bool
Lens' UIInventory Bool
uiShowZero
  InventorySortOptions
sortOptions <- Getting InventorySortOptions UIInventory InventorySortOptions
-> m InventorySortOptions
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting InventorySortOptions UIInventory InventorySortOptions
Lens' UIInventory InventorySortOptions
uiInventorySort
  Maybe Text
search <- Getting (Maybe Text) UIInventory (Maybe Text) -> m (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use Getting (Maybe Text) UIInventory (Maybe Text)
Lens' UIInventory (Maybe Text)
uiInventorySearch
  let mkInvEntry :: (Int, Entity) -> InventoryListEntry
mkInvEntry (Int
n, Entity
e) = Int -> Entity -> InventoryListEntry
InventoryEntry Int
n Entity
e
      mkInstEntry :: (a, Entity) -> InventoryListEntry
mkInstEntry (a
_, Entity
e) = Entity -> InventoryListEntry
EquippedEntry Entity
e
      itemList :: Bool
-> ((Int, Entity) -> InventoryListEntry)
-> Text
-> Inventory
-> [InventoryListEntry]
itemList Bool
isInventoryDisplay (Int, Entity) -> InventoryListEntry
mk Text
label =
        (\case [] -> []; [InventoryListEntry]
xs -> Text -> InventoryListEntry
Separator Text
label InventoryListEntry -> [InventoryListEntry] -> [InventoryListEntry]
forall a. a -> [a] -> [a]
: [InventoryListEntry]
xs)
          ([InventoryListEntry] -> [InventoryListEntry])
-> (Inventory -> [InventoryListEntry])
-> Inventory
-> [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> InventoryListEntry)
-> [(Int, Entity)] -> [InventoryListEntry]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Entity) -> InventoryListEntry
mk
          ([(Int, Entity)] -> [InventoryListEntry])
-> (Inventory -> [(Int, Entity)])
-> Inventory
-> [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InventorySortOptions -> [(Int, Entity)] -> [(Int, Entity)]
forall a.
Ord a =>
InventorySortOptions -> [(a, Entity)] -> [(a, Entity)]
sortInventory InventorySortOptions
sortOptions
          ([(Int, Entity)] -> [(Int, Entity)])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [(Int, Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, Entity) -> Bool) -> [(Int, Entity)] -> [(Int, Entity)]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool -> Bool
(&&) (Bool -> Bool -> Bool)
-> ((Int, Entity) -> Bool) -> (Int, Entity) -> Bool -> Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Entity) -> Bool
matchesSearch ((Int, Entity) -> Bool -> Bool)
-> ((Int, Entity) -> Bool) -> (Int, Entity) -> Bool
forall a b.
((Int, Entity) -> a -> b)
-> ((Int, Entity) -> a) -> (Int, Entity) -> b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Int, Entity) -> Bool
forall {a}. (Ord a, Num a) => (a, Entity) -> Bool
shouldDisplay)
          ([(Int, Entity)] -> [(Int, Entity)])
-> (Inventory -> [(Int, Entity)]) -> Inventory -> [(Int, Entity)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Inventory -> [(Int, Entity)]
elems
       where
        -- Display items if we have a positive number of them, or they
        -- aren't an equipped device.  In other words we don't need to
        -- display equipped devices twice unless we actually have some
        -- in our inventory in addition to being equipped.
        shouldDisplay :: (a, Entity) -> Bool
shouldDisplay (a
n, Entity
e) =
          a
n a -> a -> Bool
forall a. Ord a => a -> a -> Bool
> a
0
            Bool -> Bool -> Bool
|| Bool
isInventoryDisplay
              Bool -> Bool -> Bool
&& Bool
showZero
              Bool -> Bool -> Bool
&& Bool -> Bool
not ((Robot
r Robot -> Getting Inventory Robot Inventory -> Inventory
forall s a. s -> Getting a s a -> a
^. Getting Inventory Robot Inventory
Lens' Robot Inventory
equippedDevices) Inventory -> Entity -> Bool
`E.contains` Entity
e)

      matchesSearch :: (Count, Entity) -> Bool
      matchesSearch :: (Int, Entity) -> Bool
matchesSearch (Int
_, Entity
e) = (Text -> Bool)
-> (Text -> Text -> Bool) -> Maybe Text -> Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Bool -> Text -> Bool
forall a b. a -> b -> a
const Bool
True) Text -> Text -> Bool
forall s. TextualMonoid s => s -> s -> Bool
Fuzzy.test Maybe Text
search (Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
E.entityName)

      items :: [InventoryListEntry]
items =
        (Robot
r Robot
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
-> [InventoryListEntry]
forall s a. s -> Getting a s a -> a
^. (Inventory -> Const [InventoryListEntry] Inventory)
-> Robot -> Const [InventoryListEntry] Robot
Lens' Robot Inventory
robotInventory ((Inventory -> Const [InventoryListEntry] Inventory)
 -> Robot -> Const [InventoryListEntry] Robot)
-> (([InventoryListEntry]
     -> Const [InventoryListEntry] [InventoryListEntry])
    -> Inventory -> Const [InventoryListEntry] Inventory)
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> [InventoryListEntry])
-> ([InventoryListEntry]
    -> Const [InventoryListEntry] [InventoryListEntry])
-> Inventory
-> Const [InventoryListEntry] Inventory
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Bool
-> ((Int, Entity) -> InventoryListEntry)
-> Text
-> Inventory
-> [InventoryListEntry]
itemList Bool
True (Int, Entity) -> InventoryListEntry
mkInvEntry Text
"Compendium"))
          [InventoryListEntry]
-> [InventoryListEntry] -> [InventoryListEntry]
forall a. [a] -> [a] -> [a]
++ (Robot
r Robot
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
-> [InventoryListEntry]
forall s a. s -> Getting a s a -> a
^. (Inventory -> Const [InventoryListEntry] Inventory)
-> Robot -> Const [InventoryListEntry] Robot
Lens' Robot Inventory
equippedDevices ((Inventory -> Const [InventoryListEntry] Inventory)
 -> Robot -> Const [InventoryListEntry] Robot)
-> (([InventoryListEntry]
     -> Const [InventoryListEntry] [InventoryListEntry])
    -> Inventory -> Const [InventoryListEntry] Inventory)
-> Getting [InventoryListEntry] Robot [InventoryListEntry]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Inventory -> [InventoryListEntry])
-> ([InventoryListEntry]
    -> Const [InventoryListEntry] [InventoryListEntry])
-> Inventory
-> Const [InventoryListEntry] Inventory
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to (Bool
-> ((Int, Entity) -> InventoryListEntry)
-> Text
-> Inventory
-> [InventoryListEntry]
itemList Bool
False (Int, Entity) -> InventoryListEntry
forall {a}. (a, Entity) -> InventoryListEntry
mkInstEntry Text
"Equipped devices"))

      -- Attempt to keep the selected element steady.
      sel :: Maybe (Int, InventoryListEntry)
sel = Maybe (GenericList Name Vector InventoryListEntry)
mList Maybe (GenericList Name Vector InventoryListEntry)
-> (GenericList Name Vector InventoryListEntry
    -> Maybe (Int, InventoryListEntry))
-> Maybe (Int, InventoryListEntry)
forall a b. Maybe a -> (a -> Maybe b) -> Maybe b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GenericList Name Vector InventoryListEntry
-> Maybe (Int, InventoryListEntry)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement -- Get the currently selected element+index.
      idx :: Int
idx = case Maybe (Int, InventoryListEntry)
sel of
        -- If there is no currently selected element, just focus on
        -- index 1 (not 0, to avoid the separator).
        Maybe (Int, InventoryListEntry)
Nothing -> Int
1
        -- Otherwise, try to find the same entry in the list;
        -- if it's not there, keep the index the same.
        Just (Int
selIdx, InventoryEntry Int
_ Entity
e) ->
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
selIdx ((InventoryListEntry -> Bool) -> [InventoryListEntry] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Entity -> Maybe Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e) (Maybe Entity -> Bool)
-> (InventoryListEntry -> Maybe Entity)
-> InventoryListEntry
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Entity) InventoryListEntry Entity
-> InventoryListEntry -> Maybe Entity
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (((Int, Entity) -> Const (First Entity) (Int, Entity))
-> InventoryListEntry -> Const (First Entity) InventoryListEntry
Prism' InventoryListEntry (Int, Entity)
_InventoryEntry (((Int, Entity) -> Const (First Entity) (Int, Entity))
 -> InventoryListEntry -> Const (First Entity) InventoryListEntry)
-> ((Entity -> Const (First Entity) Entity)
    -> (Int, Entity) -> Const (First Entity) (Int, Entity))
-> Getting (First Entity) InventoryListEntry Entity
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Entity -> Const (First Entity) Entity)
-> (Int, Entity) -> Const (First Entity) (Int, Entity)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Int, Entity) (Int, Entity) Entity Entity
_2)) [InventoryListEntry]
items)
        Just (Int
selIdx, EquippedEntry Entity
e) ->
          Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
selIdx ((InventoryListEntry -> Bool) -> [InventoryListEntry] -> Maybe Int
forall a. (a -> Bool) -> [a] -> Maybe Int
findIndex ((Maybe Entity -> Maybe Entity -> Bool
forall a. Eq a => a -> a -> Bool
== Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e) (Maybe Entity -> Bool)
-> (InventoryListEntry -> Maybe Entity)
-> InventoryListEntry
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Entity) InventoryListEntry Entity
-> InventoryListEntry -> Maybe Entity
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview Getting (First Entity) InventoryListEntry Entity
Prism' InventoryListEntry Entity
_EquippedEntry) [InventoryListEntry]
items)
        Just (Int
selIdx, InventoryListEntry
_) -> Int
selIdx

      -- Create the new list, focused at the desired index.
      lst :: GenericList Name Vector InventoryListEntry
lst = Int
-> GenericList Name Vector InventoryListEntry
-> GenericList Name Vector InventoryListEntry
forall (t :: * -> *) n e.
(Foldable t, Splittable t) =>
Int -> GenericList n t e -> GenericList n t e
BL.listMoveTo Int
idx (GenericList Name Vector InventoryListEntry
 -> GenericList Name Vector InventoryListEntry)
-> GenericList Name Vector InventoryListEntry
-> GenericList Name Vector InventoryListEntry
forall a b. (a -> b) -> a -> b
$ Name
-> Vector InventoryListEntry
-> Int
-> GenericList Name Vector InventoryListEntry
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
BL.list Name
InventoryList ([InventoryListEntry] -> Vector InventoryListEntry
forall a. [a] -> Vector a
V.fromList [InventoryListEntry]
items) Int
1

  -- Finally, populate the newly created list in the UI, and remember
  -- the hash of the current robot.
  (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Identity
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory -> Identity UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Identity
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory -> Identity UIInventory)
-> Maybe (Int, GenericList Name Vector InventoryListEntry) -> m ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= (Int, GenericList Name Vector InventoryListEntry)
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
forall a. a -> Maybe a
Just (Robot
r Robot -> Getting Int Robot Int -> Int
forall s a. s -> Getting a s a -> a
^. Getting Int Robot Int
Getter Robot Int
inventoryHash, GenericList Name Vector InventoryListEntry
lst)

------------------------------------------------------------
-- App state (= UI state + game state) initialization
------------------------------------------------------------

-- | Command-line options for configuring the app.
data AppOpts = AppOpts
  { AppOpts -> Maybe Int
userSeed :: Maybe Seed
  -- ^ Explicit seed chosen by the user.
  , AppOpts -> Maybe FilePath
userScenario :: Maybe FilePath
  -- ^ Scenario the user wants to play.
  , AppOpts -> Maybe FilePath
scriptToRun :: Maybe FilePath
  -- ^ Code to be run on base.
  , AppOpts -> Bool
pausedAtStart :: Bool
  -- ^ Pause the game on start by default.
  , AppOpts -> Bool
autoPlay :: Bool
  -- ^ Automatically run the solution defined in the scenario file
  , AppOpts -> Bool
autoShowObjectives :: Bool
  -- ^ Show objectives dialogs when an objective is achieved/failed.
  , AppOpts -> Int
speed :: Int
  -- ^ Initial game speed (logarithm)
  , AppOpts -> Set DebugOption
debugOptions :: Set DebugOption
  -- ^ Debugging options, for example show creative switch.
  , AppOpts -> Maybe ColorMode
colorMode :: Maybe ColorMode
  -- ^ What colour mode should be used?
  , AppOpts -> Maybe Int
userWebPort :: Maybe Port
  -- ^ Explicit port on which to run the web API
  , AppOpts -> Maybe GitInfo
repoGitInfo :: Maybe GitInfo
  -- ^ Information about the Git repository (not present in release).
  }

-- | A default/empty 'AppOpts' record.
defaultAppOpts :: AppOpts
defaultAppOpts :: AppOpts
defaultAppOpts =
  AppOpts
    { userSeed :: Maybe Int
userSeed = Maybe Int
forall a. Maybe a
Nothing
    , userScenario :: Maybe FilePath
userScenario = Maybe FilePath
forall a. Maybe a
Nothing
    , scriptToRun :: Maybe FilePath
scriptToRun = Maybe FilePath
forall a. Maybe a
Nothing
    , pausedAtStart :: Bool
pausedAtStart = Bool
False
    , autoShowObjectives :: Bool
autoShowObjectives = Bool
True
    , autoPlay :: Bool
autoPlay = Bool
False
    , speed :: Int
speed = Int
defaultInitLgTicksPerSecond
    , debugOptions :: Set DebugOption
debugOptions = Set DebugOption
forall a. Monoid a => a
mempty
    , colorMode :: Maybe ColorMode
colorMode = Maybe ColorMode
forall a. Maybe a
Nothing
    , userWebPort :: Maybe Int
userWebPort = Maybe Int
forall a. Maybe a
Nothing
    , repoGitInfo :: Maybe GitInfo
repoGitInfo = Maybe GitInfo
forall a. Maybe a
Nothing
    }

--------------------------------------------------
-- Lenses for ScenarioState

makeLensesNoSigs ''ScenarioState

-- | The 'GameState' record.
gameState :: Lens' ScenarioState GameState

-- | UI active during live gameplay
uiGameplay :: Lens' ScenarioState UIGameplay

--------------------------------------------------
-- Lenses for PlayState

makeLensesNoSigs ''PlayState

-- | The 'ScenarioState' record.
scenarioState :: Lens' PlayState ScenarioState

-- | State that can evolve as the user progresses through scenarios.
progression :: Lens' PlayState ProgressionState

--------------------------------------------------
-- Lenses for Progression State
makeLensesNoSigs ''ProgressionState

-- | Map of achievements that were attained
attainedAchievements :: Lens' ProgressionState (Map CategorizedAchievement Attainment)

-- | The collection of scenarios that comes with the game.
scenarios :: Lens' ProgressionState (ScenarioCollection ScenarioInfo)

-- | Queue of popups to display
uiPopups :: Lens' ProgressionState PopupState

-- | Popup Animation State
uiPopupAnimationState :: Lens' ProgressionState AnimationState

-- | Remaining scenarios in the current sequence
scenarioSequence :: Lens' ProgressionState [ScenarioWith ScenarioPath]

--------------------------------------------------
-- Lenses for KeyEventHandlingState

makeLensesNoSigs ''KeyEventHandlingState

-- | Keybindings (possibly customized by player) for 'SwarmEvent's.
keyConfig :: Lens' KeyEventHandlingState (KeyConfig SwarmEvent)

-- | Dispatchers that will call handler on key combo.
keyDispatchers :: Lens' KeyEventHandlingState SwarmKeyDispatchers

--------------------------------------------------
-- Lenses for AppState

makeLensesNoSigs ''AppState

-- | The 'ScenarioState' record.
playState :: Lens' AppState PlayState

-- | The 'UIState' record.
uiState :: Lens' AppState UIState

-- | The key event handling configuration.
keyEventHandling :: Lens' AppState KeyEventHandlingState

-- | The 'RuntimeState' record
runtimeState :: Lens' AppState RuntimeState

-- | The 'Brick.Animation.AnimationManager' record
animationMgr :: Lens' AppState (AnimationManager AppState AppEvent Name)

-------------------------------------------------

-- | Prisms for AnimationState
makePrisms ''AnimationState

--------------------------------------------------
-- Utility functions

-- | Get the currently focused 'InventoryListEntry' from the robot
--   info panel (if any).
focusedItem :: ScenarioState -> Maybe InventoryListEntry
focusedItem :: ScenarioState -> Maybe InventoryListEntry
focusedItem ScenarioState
s = do
  GenericList Name Vector InventoryListEntry
list <- ScenarioState
s ScenarioState
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     ScenarioState
     (GenericList Name Vector InventoryListEntry)
-> Maybe (GenericList Name Vector InventoryListEntry)
forall s a. s -> Getting (First a) s a -> Maybe a
^? (UIGameplay
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> ScenarioState
-> Const
     (First (GenericList Name Vector InventoryListEntry)) ScenarioState
Lens' ScenarioState UIGameplay
uiGameplay ((UIGameplay
  -> Const
       (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
 -> ScenarioState
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) ScenarioState)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> UIGameplay
    -> Const
         (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     ScenarioState
     (GenericList Name Vector InventoryListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIInventory)
-> UIGameplay
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory
  -> Const
       (First (GenericList Name Vector InventoryListEntry)) UIInventory)
 -> UIGameplay
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> UIGameplay
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> UIInventory
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIInventory
Lens'
  UIInventory
  (Maybe (Int, GenericList Name Vector InventoryListEntry))
uiInventoryList ((Maybe (Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Maybe (Int, GenericList Name Vector InventoryListEntry)))
 -> UIInventory
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIInventory)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> Maybe (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     UIInventory
     (GenericList Name Vector InventoryListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Int, GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall a b (p :: * -> * -> *) (f :: * -> *).
(Choice p, Applicative f) =>
p a (f b) -> p (Maybe a) (f (Maybe b))
_Just (((Int, GenericList Name Vector InventoryListEntry)
  -> Const
       (First (GenericList Name Vector InventoryListEntry))
       (Int, GenericList Name Vector InventoryListEntry))
 -> Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> (Int, GenericList Name Vector InventoryListEntry)
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (Int, GenericList Name Vector InventoryListEntry))
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector InventoryListEntry
 -> Const
      (First (GenericList Name Vector InventoryListEntry))
      (GenericList Name Vector InventoryListEntry))
-> (Int, GenericList Name Vector InventoryListEntry)
-> Const
     (First (GenericList Name Vector InventoryListEntry))
     (Int, GenericList Name Vector InventoryListEntry)
forall s t a b. Field2 s t a b => Lens s t a b
Lens
  (Int, GenericList Name Vector InventoryListEntry)
  (Int, GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
  (GenericList Name Vector InventoryListEntry)
_2
  (Int
_, InventoryListEntry
entry) <- GenericList Name Vector InventoryListEntry
-> Maybe (Int, InventoryListEntry)
forall (t :: * -> *) e n.
(Splittable t, Traversable t, Semigroup (t e)) =>
GenericList n t e -> Maybe (Int, e)
BL.listSelectedElement GenericList Name Vector InventoryListEntry
list
  InventoryListEntry -> Maybe InventoryListEntry
forall a. a -> Maybe a
forall (m :: * -> *) a. Monad m => a -> m a
return InventoryListEntry
entry

-- | 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.
focusedEntity :: ScenarioState -> Maybe Entity
focusedEntity :: ScenarioState -> Maybe Entity
focusedEntity =
  ScenarioState -> Maybe InventoryListEntry
focusedItem (ScenarioState -> Maybe InventoryListEntry)
-> (InventoryListEntry -> Maybe Entity)
-> ScenarioState
-> Maybe Entity
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
    Separator Text
_ -> Maybe Entity
forall a. Maybe a
Nothing
    InventoryEntry Int
_ Entity
e -> Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e
    EquippedEntry Entity
e -> Entity -> Maybe Entity
forall a. a -> Maybe a
Just Entity
e

-- | 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.
animTraversal :: Traversal' AnimationState (Maybe (Animation AppState Name))
animTraversal :: Traversal' AnimationState (Maybe (Animation AppState Name))
animTraversal = ((Maybe (Animation AppState Name)
  -> f (Maybe (Animation AppState Name)))
 -> AnimationState -> f AnimationState)
-> (Maybe (Animation AppState Name)
    -> f (Maybe (Animation AppState Name)))
-> AnimationState
-> f AnimationState
forall a (f :: * -> *) b s t.
((a -> f b) -> s -> f t) -> (a -> f b) -> s -> f t
traversal (Maybe (Animation AppState Name)
 -> f (Maybe (Animation AppState Name)))
-> AnimationState -> f AnimationState
Traversal' AnimationState (Maybe (Animation AppState Name))
go
 where
  go :: Applicative f => (Maybe (Animation AppState Name) -> f (Maybe (Animation AppState Name))) -> AnimationState -> f AnimationState
  go :: Traversal' AnimationState (Maybe (Animation AppState Name))
go Maybe (Animation AppState Name)
-> f (Maybe (Animation AppState Name))
focus = \case
    AnimationState
AnimInactive -> AnimationState
-> (Animation AppState Name -> AnimationState)
-> Maybe (Animation AppState Name)
-> AnimationState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AnimationState
AnimInactive Animation AppState Name -> AnimationState
AnimActive (Maybe (Animation AppState Name) -> AnimationState)
-> f (Maybe (Animation AppState Name)) -> f AnimationState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Animation AppState Name)
-> f (Maybe (Animation AppState Name))
focus Maybe (Animation AppState Name)
forall a. Maybe a
Nothing
    AnimationState
AnimScheduled -> AnimationState
-> (Animation AppState Name -> AnimationState)
-> Maybe (Animation AppState Name)
-> AnimationState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AnimationState
AnimInactive Animation AppState Name -> AnimationState
AnimActive (Maybe (Animation AppState Name) -> AnimationState)
-> f (Maybe (Animation AppState Name)) -> f AnimationState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Animation AppState Name)
-> f (Maybe (Animation AppState Name))
focus Maybe (Animation AppState Name)
forall a. Maybe a
Nothing
    AnimActive Animation AppState Name
x -> AnimationState
-> (Animation AppState Name -> AnimationState)
-> Maybe (Animation AppState Name)
-> AnimationState
forall b a. b -> (a -> b) -> Maybe a -> b
maybe AnimationState
AnimInactive Animation AppState Name -> AnimationState
AnimActive (Maybe (Animation AppState Name) -> AnimationState)
-> f (Maybe (Animation AppState Name)) -> f AnimationState
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Animation AppState Name)
-> f (Maybe (Animation AppState Name))
focus (Animation AppState Name -> Maybe (Animation AppState Name)
forall a. a -> Maybe a
Just Animation AppState Name
x)