{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE QuasiQuotes #-}

-- |
-- SPDX-License-Identifier: BSD-3-Clause
--
-- Here is the RobotPanel key event handler.
--
-- Because of how tricky the search logic is,
-- the player configurable part and the dynamic
-- search handler are both here.
module Swarm.TUI.Controller.EventHandlers.Robot (
  robotEventHandlers,
  handleRobotPanelEvent,
) where

import Brick
import Brick.Keybindings
import Control.Lens as Lens
import Control.Lens.Extras as Lens (is)
import Control.Monad (unless, when)
import Data.Text qualified as T
import Graphics.Vty qualified as V
import Swarm.Game.Entity hiding (empty)
import Swarm.Game.Robot.Concrete
import Swarm.Game.State
import Swarm.Language.Pipeline.QQ (tmQ)
import Swarm.Language.Syntax hiding (Key)
import Swarm.TUI.Controller.Util
import Swarm.TUI.Inventory.Sorting (cycleSortDirection, cycleSortOrder)
import Swarm.TUI.List
import Swarm.TUI.Model
import Swarm.TUI.Model.Event
import Swarm.TUI.Model.UI
import Swarm.TUI.View.Util (generateModal)

-- | Handle user input events in the robot panel.
handleRobotPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleRobotPanelEvent BrickEvent Name AppEvent
bev = do
  Maybe Text
search <- Getting (Maybe Text) AppState (Maybe Text)
-> EventM Name AppState (Maybe Text)
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting (Maybe Text) AppState (Maybe Text)
 -> EventM Name AppState (Maybe Text))
-> Getting (Maybe Text) AppState (Maybe Text)
-> EventM Name AppState (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (UIState -> Const (Maybe Text) UIState)
-> AppState -> Const (Maybe Text) AppState
Lens' AppState UIState
uiState ((UIState -> Const (Maybe Text) UIState)
 -> AppState -> Const (Maybe Text) AppState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIState -> Const (Maybe Text) UIState)
-> Getting (Maybe Text) AppState (Maybe Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Const (Maybe Text) UIGameplay)
-> UIState -> Const (Maybe Text) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Const (Maybe Text) UIGameplay)
 -> UIState -> Const (Maybe Text) UIState)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIGameplay -> Const (Maybe Text) UIGameplay)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIState
-> Const (Maybe Text) UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory -> Const (Maybe Text) UIInventory)
-> UIGameplay -> Const (Maybe Text) UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Const (Maybe Text) UIInventory)
 -> UIGameplay -> Const (Maybe Text) UIGameplay)
-> ((Maybe Text -> Const (Maybe Text) (Maybe Text))
    -> UIInventory -> Const (Maybe Text) UIInventory)
-> (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIGameplay
-> Const (Maybe Text) UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Text -> Const (Maybe Text) (Maybe Text))
-> UIInventory -> Const (Maybe Text) UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch
  KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler <- Getting
  (KeyDispatcher SwarmEvent (EventM Name AppState))
  AppState
  (KeyDispatcher SwarmEvent (EventM Name AppState))
-> EventM
     Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState))
forall s (m :: * -> *) a. MonadState s m => Getting a s a -> m a
use (Getting
   (KeyDispatcher SwarmEvent (EventM Name AppState))
   AppState
   (KeyDispatcher SwarmEvent (EventM Name AppState))
 -> EventM
      Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
-> EventM
     Name AppState (KeyDispatcher SwarmEvent (EventM Name AppState))
forall a b. (a -> b) -> a -> b
$ (KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> AppState
-> Const (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState
Lens' AppState KeyEventHandlingState
keyEventHandling ((KeyEventHandlingState
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       KeyEventHandlingState)
 -> AppState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState)) AppState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> KeyEventHandlingState
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         KeyEventHandlingState)
-> Getting
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     AppState
     (KeyDispatcher SwarmEvent (EventM Name AppState))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      SwarmKeyDispatchers)
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
Lens' KeyEventHandlingState SwarmKeyDispatchers
keyDispatchers ((SwarmKeyDispatchers
  -> Const
       (KeyDispatcher SwarmEvent (EventM Name AppState))
       SwarmKeyDispatchers)
 -> KeyEventHandlingState
 -> Const
      (KeyDispatcher SwarmEvent (EventM Name AppState))
      KeyEventHandlingState)
-> ((KeyDispatcher SwarmEvent (EventM Name AppState)
     -> Const
          (KeyDispatcher SwarmEvent (EventM Name AppState))
          (KeyDispatcher SwarmEvent (EventM Name AppState)))
    -> SwarmKeyDispatchers
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         SwarmKeyDispatchers)
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> KeyEventHandlingState
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     KeyEventHandlingState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SwarmKeyDispatchers
 -> KeyDispatcher SwarmEvent (EventM Name AppState))
-> (KeyDispatcher SwarmEvent (EventM Name AppState)
    -> Const
         (KeyDispatcher SwarmEvent (EventM Name AppState))
         (KeyDispatcher SwarmEvent (EventM Name AppState)))
-> SwarmKeyDispatchers
-> Const
     (KeyDispatcher SwarmEvent (EventM Name AppState))
     SwarmKeyDispatchers
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to SwarmKeyDispatchers
-> KeyDispatcher SwarmEvent (EventM Name AppState)
robotDispatcher
  case Maybe Text
search of
    Just Text
_ -> BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent BrickEvent Name AppEvent
bev
    Maybe Text
Nothing -> case BrickEvent Name AppEvent
bev of
      VtyEvent ev :: Event
ev@(V.EvKey Key
k [Modifier]
m) -> do
        Bool
handled <- KeyDispatcher SwarmEvent (EventM Name AppState)
-> Key -> [Modifier] -> EventM Name AppState Bool
forall (m :: * -> *) k.
Monad m =>
KeyDispatcher k m -> Key -> [Modifier] -> m Bool
handleKey KeyDispatcher SwarmEvent (EventM Name AppState)
keyHandler Key
k [Modifier]
m
        Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
handled (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev
      BrickEvent Name AppEvent
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw

-- | Handle key events in the robot panel.
robotEventHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
robotEventHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
robotEventHandlers = [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall {k}. [KeyEventHandler k (EventM Name AppState)]
nonCustomizableHandlers [KeyEventHandler SwarmEvent (EventM Name AppState)]
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall a. Semigroup a => a -> a -> a
<> [KeyEventHandler SwarmEvent (EventM Name AppState)]
customizableHandlers
 where
  nonCustomizableHandlers :: [KeyEventHandler k (EventM Name AppState)]
nonCustomizableHandlers =
    [ Key
-> Text
-> EventM Name AppState ()
-> KeyEventHandler k (EventM Name AppState)
forall a (m :: * -> *) k.
ToBinding a =>
a -> Text -> m () -> KeyEventHandler k m
onKey Key
V.KEnter Text
"Show entity description" EventM Name AppState ()
showEntityDescription
    ]
  customizableHandlers :: [KeyEventHandler SwarmEvent (EventM Name AppState)]
customizableHandlers = (RobotEvent -> SwarmEvent)
-> (RobotEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall e2 e1.
(Ord e2, Enum e1, Bounded e1) =>
(e1 -> e2)
-> (e1 -> (Text, EventM Name AppState ()))
-> [KeyEventHandler e2 (EventM Name AppState)]
allHandlers RobotEvent -> SwarmEvent
Robot ((RobotEvent -> (Text, EventM Name AppState ()))
 -> [KeyEventHandler SwarmEvent (EventM Name AppState)])
-> (RobotEvent -> (Text, EventM Name AppState ()))
-> [KeyEventHandler SwarmEvent (EventM Name AppState)]
forall a b. (a -> b) -> a -> b
$ \case
    RobotEvent
MakeEntityEvent -> (Text
"Make the selected entity", EventM Name AppState ()
makeFocusedEntity)
    RobotEvent
ShowZeroInventoryEntitiesEvent -> (Text
"Show entities with zero count in inventory", EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory EventM Name UIInventory ()
showZero)
    RobotEvent
CycleInventorySortEvent -> (Text
"Cycle inventory sorting type", EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory EventM Name UIInventory ()
cycleSort)
    RobotEvent
SwitchInventorySortDirection -> (Text
"Switch ascending/descending inventory sort", EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory EventM Name UIInventory ()
switchSortDirection)
    RobotEvent
SearchInventoryEvent -> (Text
"Start inventory search", EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory EventM Name UIInventory ()
searchInventory)

-- | Display a modal window with the description of an entity.
showEntityDescription :: EventM Name AppState ()
showEntityDescription :: EventM Name AppState ()
showEntityDescription = (AppState -> Maybe Entity) -> EventM Name AppState (Maybe Entity)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe Entity
focusedEntity EventM Name AppState (Maybe Entity)
-> (Maybe Entity -> EventM Name AppState ())
-> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> (a -> EventM Name AppState b) -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EventM Name AppState ()
-> (Entity -> EventM Name AppState ())
-> Maybe Entity
-> EventM Name AppState ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw Entity -> EventM Name AppState ()
descriptionModal
 where
  descriptionModal :: Entity -> EventM Name AppState ()
  descriptionModal :: Entity -> EventM Name AppState ()
descriptionModal Entity
e = do
    AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    ViewportScroll Name -> EventM Name AppState ()
resetViewport ViewportScroll Name
modalScroll
    (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIState -> Identity UIState)
-> (Maybe Modal -> Identity (Maybe Modal))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((Maybe Modal -> Identity (Maybe Modal))
    -> UIGameplay -> Identity UIGameplay)
-> (Maybe Modal -> Identity (Maybe Modal))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Maybe Modal -> Identity (Maybe Modal))
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay (Maybe Modal)
uiModal ((Maybe Modal -> Identity (Maybe Modal))
 -> AppState -> Identity AppState)
-> Modal -> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a (Maybe b) -> b -> m ()
?= AppState -> ModalType -> Modal
generateModal AppState
s (Entity -> ModalType
DescriptionModal Entity
e)

-- | Attempt to make an entity selected from the inventory, if the
--   base is not currently busy.
makeFocusedEntity :: EventM Name AppState ()
makeFocusedEntity :: EventM Name AppState ()
makeFocusedEntity = (AppState -> Maybe Entity) -> EventM Name AppState (Maybe Entity)
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets AppState -> Maybe Entity
focusedEntity EventM Name AppState (Maybe Entity)
-> (Maybe Entity -> EventM Name AppState ())
-> EventM Name AppState ()
forall a b.
EventM Name AppState a
-> (a -> EventM Name AppState b) -> EventM Name AppState b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= EventM Name AppState ()
-> (Entity -> EventM Name AppState ())
-> Maybe Entity
-> EventM Name AppState ()
forall b a. b -> (a -> b) -> Maybe a -> b
maybe EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw Entity -> EventM Name AppState ()
makeEntity
 where
  makeEntity :: Entity -> EventM Name AppState ()
  makeEntity :: Entity -> EventM Name AppState ()
makeEntity Entity
e = do
    AppState
s <- EventM Name AppState AppState
forall s (m :: * -> *). MonadState s m => m s
get
    let name :: Text
name = Entity
e Entity -> Getting Text Entity Text -> Text
forall s a. s -> Getting a s a -> a
^. Getting Text Entity Text
Lens' Entity Text
entityName
        mkT :: Syntax' (Poly (Fix TypeF))
mkT = [tmQ| make $str:name |]
    case Robot -> Bool
isActive (Robot -> Bool) -> Maybe Robot -> Maybe Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (AppState
s AppState -> Getting (First Robot) AppState Robot -> Maybe Robot
forall s a. s -> Getting (First a) s a -> Maybe a
^? (GameState -> Const (First Robot) GameState)
-> AppState -> Const (First Robot) AppState
Lens' AppState GameState
gameState ((GameState -> Const (First Robot) GameState)
 -> AppState -> Const (First Robot) AppState)
-> ((Robot -> Const (First Robot) Robot)
    -> GameState -> Const (First Robot) GameState)
-> Getting (First Robot) AppState Robot
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Robot -> Const (First Robot) Robot)
-> GameState -> Const (First Robot) GameState
Traversal' GameState Robot
baseRobot) of
      Just Bool
False -> Maybe (Syntax' (Poly (Fix TypeF))) -> EventM Name AppState ()
forall (m :: * -> *).
MonadState AppState m =>
Maybe (Syntax' (Poly (Fix TypeF))) -> m ()
runBaseTerm (Syntax' (Poly (Fix TypeF)) -> Maybe (Syntax' (Poly (Fix TypeF)))
forall a. a -> Maybe a
Just Syntax' (Poly (Fix TypeF))
mkT)
      Maybe Bool
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw

showZero :: EventM Name UIInventory ()
showZero :: EventM Name UIInventory ()
showZero = (Bool -> Identity Bool) -> UIInventory -> Identity UIInventory
Lens' UIInventory Bool
uiShowZero ((Bool -> Identity Bool) -> UIInventory -> Identity UIInventory)
-> (Bool -> Bool) -> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= Bool -> Bool
not

cycleSort :: EventM Name UIInventory ()
cycleSort :: EventM Name UIInventory ()
cycleSort = (InventorySortOptions -> Identity InventorySortOptions)
-> UIInventory -> Identity UIInventory
Lens' UIInventory InventorySortOptions
uiInventorySort ((InventorySortOptions -> Identity InventorySortOptions)
 -> UIInventory -> Identity UIInventory)
-> (InventorySortOptions -> InventorySortOptions)
-> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= InventorySortOptions -> InventorySortOptions
cycleSortOrder

switchSortDirection :: EventM Name UIInventory ()
switchSortDirection :: EventM Name UIInventory ()
switchSortDirection = (InventorySortOptions -> Identity InventorySortOptions)
-> UIInventory -> Identity UIInventory
Lens' UIInventory InventorySortOptions
uiInventorySort ((InventorySortOptions -> Identity InventorySortOptions)
 -> UIInventory -> Identity UIInventory)
-> (InventorySortOptions -> InventorySortOptions)
-> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= InventorySortOptions -> InventorySortOptions
cycleSortDirection

searchInventory :: EventM Name UIInventory ()
searchInventory :: EventM Name UIInventory ()
searchInventory = (Maybe Text -> Identity (Maybe Text))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch ((Maybe Text -> Identity (Maybe Text))
 -> UIInventory -> Identity UIInventory)
-> Maybe Text -> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Text -> Maybe Text
forall a. a -> Maybe a
Just Text
""

-- | Handle an event to navigate through the inventory list.
handleInventoryListEvent :: V.Event -> EventM Name AppState ()
handleInventoryListEvent :: Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev = do
  -- Note, refactoring like this is tempting:
  --
  --   Brick.zoom (uiState . ... . _Just . _2) (handleListEventWithSeparators ev (is _Separator))
  --
  -- However, this does not work since we want to skip redrawing in the no-list case!
  Maybe (GenericList Name Vector InventoryListEntry)
mList <- Getting
  (First (GenericList Name Vector InventoryListEntry))
  AppState
  (GenericList Name Vector InventoryListEntry)
-> EventM
     Name AppState (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))
   AppState
   (GenericList Name Vector InventoryListEntry)
 -> EventM
      Name AppState (Maybe (GenericList Name Vector InventoryListEntry)))
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     AppState
     (GenericList Name Vector InventoryListEntry)
-> EventM
     Name AppState (Maybe (GenericList Name Vector InventoryListEntry))
forall a b. (a -> b) -> a -> b
$ (UIState
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIState)
-> AppState
-> Const
     (First (GenericList Name Vector InventoryListEntry)) AppState
Lens' AppState UIState
uiState ((UIState
  -> Const
       (First (GenericList Name Vector InventoryListEntry)) UIState)
 -> AppState
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) AppState)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> UIState
    -> Const
         (First (GenericList Name Vector InventoryListEntry)) UIState)
-> Getting
     (First (GenericList Name Vector InventoryListEntry))
     AppState
     (GenericList Name Vector InventoryListEntry)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> UIState
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Const
       (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
 -> UIState
 -> Const
      (First (GenericList Name Vector InventoryListEntry)) UIState)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (GenericList Name Vector InventoryListEntry))
    -> UIGameplay
    -> Const
         (First (GenericList Name Vector InventoryListEntry)) UIGameplay)
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> UIState
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIState
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)
-> ((GenericList Name Vector InventoryListEntry
     -> Const
          (First (GenericList Name Vector InventoryListEntry))
          (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))
-> 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)))
-> (GenericList Name Vector InventoryListEntry
    -> Const
         (First (GenericList Name Vector InventoryListEntry))
         (GenericList Name Vector InventoryListEntry))
-> UIInventory
-> Const
     (First (GenericList Name Vector InventoryListEntry)) UIInventory
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
  case Maybe (GenericList Name Vector InventoryListEntry)
mList of
    Maybe (GenericList Name Vector InventoryListEntry)
Nothing -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw
    Just GenericList Name Vector InventoryListEntry
l -> do
      Bool -> EventM Name AppState () -> EventM Name AppState ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Event -> Bool
isValidListMovement Event
ev) (EventM Name AppState () -> EventM Name AppState ())
-> EventM Name AppState () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ ViewportScroll Name -> EventM Name AppState ()
resetViewport ViewportScroll Name
infoScroll
      GenericList Name Vector InventoryListEntry
l' <- GenericList Name Vector InventoryListEntry
-> EventM Name (GenericList Name Vector InventoryListEntry) ()
-> EventM
     Name AppState (GenericList Name Vector InventoryListEntry)
forall a n b s. a -> EventM n a b -> EventM n s a
nestEventM' GenericList Name Vector InventoryListEntry
l (Event
-> (InventoryListEntry -> Bool)
-> EventM Name (GenericList Name Vector InventoryListEntry) ()
forall (t :: * -> *) n e.
(Foldable t, Splittable t, Ord n, Searchable t) =>
Event -> (e -> Bool) -> EventM n (GenericList n t e) ()
handleListEventWithSeparators Event
ev (APrism InventoryListEntry InventoryListEntry Text Text
-> InventoryListEntry -> Bool
forall s t a b. APrism s t a b -> s -> Bool
is APrism InventoryListEntry InventoryListEntry Text Text
Prism' InventoryListEntry Text
_Separator))
      (UIState -> Identity UIState) -> AppState -> Identity AppState
Lens' AppState UIState
uiState ((UIState -> Identity UIState) -> AppState -> Identity AppState)
-> ((GenericList Name Vector InventoryListEntry
     -> Identity (GenericList Name Vector InventoryListEntry))
    -> UIState -> Identity UIState)
-> (GenericList Name Vector InventoryListEntry
    -> Identity (GenericList Name Vector InventoryListEntry))
-> AppState
-> Identity AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay -> Identity UIGameplay) -> UIState -> Identity UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay -> Identity UIGameplay)
 -> UIState -> Identity UIState)
-> ((GenericList Name Vector InventoryListEntry
     -> Identity (GenericList Name Vector InventoryListEntry))
    -> UIGameplay -> Identity UIGameplay)
-> (GenericList Name Vector InventoryListEntry
    -> Identity (GenericList Name Vector InventoryListEntry))
-> UIState
-> Identity UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory -> Identity UIInventory)
-> UIGameplay -> Identity UIGameplay
Lens' UIGameplay UIInventory
uiInventory ((UIInventory -> Identity UIInventory)
 -> UIGameplay -> Identity UIGameplay)
-> ((GenericList Name Vector InventoryListEntry
     -> Identity (GenericList Name Vector InventoryListEntry))
    -> UIInventory -> Identity UIInventory)
-> (GenericList Name Vector InventoryListEntry
    -> Identity (GenericList Name Vector InventoryListEntry))
-> UIGameplay
-> Identity UIGameplay
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (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)
-> ((GenericList Name Vector InventoryListEntry
     -> Identity (GenericList Name Vector InventoryListEntry))
    -> Maybe (Int, GenericList Name Vector InventoryListEntry)
    -> Identity
         (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> (GenericList Name Vector InventoryListEntry
    -> Identity (GenericList Name Vector InventoryListEntry))
-> UIInventory
-> Identity UIInventory
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GenericList Name Vector InventoryListEntry)
 -> Identity (Int, GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Identity
     (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)
  -> Identity (Int, GenericList Name Vector InventoryListEntry))
 -> Maybe (Int, GenericList Name Vector InventoryListEntry)
 -> Identity
      (Maybe (Int, GenericList Name Vector InventoryListEntry)))
-> ((GenericList Name Vector InventoryListEntry
     -> Identity (GenericList Name Vector InventoryListEntry))
    -> (Int, GenericList Name Vector InventoryListEntry)
    -> Identity (Int, GenericList Name Vector InventoryListEntry))
-> (GenericList Name Vector InventoryListEntry
    -> Identity (GenericList Name Vector InventoryListEntry))
-> Maybe (Int, GenericList Name Vector InventoryListEntry)
-> Identity
     (Maybe (Int, GenericList Name Vector InventoryListEntry))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GenericList Name Vector InventoryListEntry
 -> Identity (GenericList Name Vector InventoryListEntry))
-> (Int, GenericList Name Vector InventoryListEntry)
-> Identity (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 ((GenericList Name Vector InventoryListEntry
  -> Identity (GenericList Name Vector InventoryListEntry))
 -> AppState -> Identity AppState)
-> GenericList Name Vector InventoryListEntry
-> EventM Name AppState ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= GenericList Name Vector InventoryListEntry
l'

-- ----------------------------------------------
--               INVENTORY SEARCH
-- ----------------------------------------------

-- | Handle a user input event in the robot/inventory panel, while in
--   inventory search mode.
handleInventorySearchEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent :: BrickEvent Name AppEvent -> EventM Name AppState ()
handleInventorySearchEvent = \case
  -- Escape: stop filtering and go back to regular inventory mode
  BrickEvent Name AppEvent
EscapeKey ->
    EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory (EventM Name UIInventory () -> EventM Name AppState ())
-> EventM Name UIInventory () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Identity (Maybe Text))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch ((Maybe Text -> Identity (Maybe Text))
 -> UIInventory -> Identity UIInventory)
-> Maybe Text -> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
forall a. Maybe a
Nothing
  -- Enter: return to regular inventory mode, and pop out the selected item
  Key Key
V.KEnter -> do
    EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory (EventM Name UIInventory () -> EventM Name AppState ())
-> EventM Name UIInventory () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Identity (Maybe Text))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch ((Maybe Text -> Identity (Maybe Text))
 -> UIInventory -> Identity UIInventory)
-> Maybe Text -> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Maybe Text
forall a. Maybe a
Nothing
    EventM Name AppState ()
showEntityDescription
  -- Any old character: append to the current search string
  CharKey Char
c -> do
    ViewportScroll Name -> EventM Name AppState ()
resetViewport ViewportScroll Name
infoScroll
    EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory (EventM Name UIInventory () -> EventM Name AppState ())
-> EventM Name UIInventory () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Identity (Maybe Text))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch ((Maybe Text -> Identity (Maybe Text))
 -> UIInventory -> Identity UIInventory)
-> (Maybe Text -> Maybe Text) -> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Text -> Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text -> Char -> Text
forall s a. Snoc s s a a => s -> a -> s
`snoc` Char
c)
  -- Backspace: chop the last character off the end of the current search string
  BrickEvent Name AppEvent
BackspaceKey -> do
    EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory (EventM Name UIInventory () -> EventM Name AppState ())
-> EventM Name UIInventory () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ (Maybe Text -> Identity (Maybe Text))
-> UIInventory -> Identity UIInventory
Lens' UIInventory (Maybe Text)
uiInventorySearch ((Maybe Text -> Identity (Maybe Text))
 -> UIInventory -> Identity UIInventory)
-> (Maybe Text -> Maybe Text) -> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> (a -> b) -> m ()
%= (Text -> Text) -> Maybe Text -> Maybe Text
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Text -> Text
T.dropEnd Int
1)
  -- Handle any other event as list navigation, so we can look through
  -- the filtered inventory using e.g. arrow keys
  VtyEvent Event
ev -> Event -> EventM Name AppState ()
handleInventoryListEvent Event
ev
  BrickEvent Name AppEvent
_ -> EventM Name AppState ()
forall n s. EventM n s ()
continueWithoutRedraw

-- ----------------------------------------------
--                 HELPER UTILS
-- ----------------------------------------------

zoomInventory :: EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory :: EventM Name UIInventory () -> EventM Name AppState ()
zoomInventory EventM Name UIInventory ()
act = LensLike'
  (Zoomed (EventM Name UIInventory) ()) AppState UIInventory
-> EventM Name UIInventory () -> EventM Name AppState ()
forall c.
LensLike' (Zoomed (EventM Name UIInventory) c) AppState UIInventory
-> EventM Name UIInventory c -> EventM Name AppState c
forall (m :: * -> *) (n :: * -> *) s t c.
Zoom m n s t =>
LensLike' (Zoomed m c) t s -> m c -> n c
Brick.zoom ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> AppState -> Focusing (StateT (EventState Name) IO) () AppState
Lens' AppState UIState
uiState ((UIState -> Focusing (StateT (EventState Name) IO) () UIState)
 -> AppState -> Focusing (StateT (EventState Name) IO) () AppState)
-> ((UIInventory
     -> Focusing (StateT (EventState Name) IO) () UIInventory)
    -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> (UIInventory
    -> Focusing (StateT (EventState Name) IO) () UIInventory)
-> AppState
-> Focusing (StateT (EventState Name) IO) () AppState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIGameplay
 -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> UIState -> Focusing (StateT (EventState Name) IO) () UIState
Lens' UIState UIGameplay
uiGameplay ((UIGameplay
  -> Focusing (StateT (EventState Name) IO) () UIGameplay)
 -> UIState -> Focusing (StateT (EventState Name) IO) () UIState)
-> ((UIInventory
     -> Focusing (StateT (EventState Name) IO) () UIInventory)
    -> UIGameplay
    -> Focusing (StateT (EventState Name) IO) () UIGameplay)
-> (UIInventory
    -> Focusing (StateT (EventState Name) IO) () UIInventory)
-> UIState
-> Focusing (StateT (EventState Name) IO) () UIState
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UIInventory
 -> Focusing (StateT (EventState Name) IO) () UIInventory)
-> UIGameplay
-> Focusing (StateT (EventState Name) IO) () UIGameplay
Lens' UIGameplay UIInventory
uiInventory) (EventM Name UIInventory () -> EventM Name AppState ())
-> EventM Name UIInventory () -> EventM Name AppState ()
forall a b. (a -> b) -> a -> b
$ do
  (Bool -> Identity Bool) -> UIInventory -> Identity UIInventory
Lens' UIInventory Bool
uiInventoryShouldUpdate ((Bool -> Identity Bool) -> UIInventory -> Identity UIInventory)
-> Bool -> EventM Name UIInventory ()
forall s (m :: * -> *) a b.
MonadState s m =>
ASetter s s a b -> b -> m ()
.= Bool
True
  EventM Name UIInventory ()
act