-- | Semantics of "Game.LambdaHack.Client.UI.HumanCmd"
-- client commands that return server requests.
-- A couple of them do not take time, the rest does.
-- Here prompts and menus are displayed, but any feedback resulting
-- from the commands (e.g., from inventory manipulation) is generated later on,
-- by the server, for all clients that witness the results of the commands.
module Game.LambdaHack.Client.UI.HandleHumanGlobalM
  ( -- * Meta commands
    byAreaHuman, byAimModeHuman
  , composeIfLocalHuman, composeUnlessErrorHuman, compose2ndLocalHuman
  , loopOnNothingHuman, executeIfClearHuman
    -- * Global commands that usually take time
  , waitHuman, waitHuman10, yellHuman, moveRunHuman
  , runOnceAheadHuman, moveOnceToXhairHuman
  , runOnceToXhairHuman, continueToXhairHuman
  , moveItemHuman, projectHuman, applyHuman
  , alterDirHuman, alterWithPointerHuman
  , helpHuman, hintHuman, dashboardHuman, itemMenuHuman, chooseItemMenuHuman
  , mainMenuHuman, mainMenuAutoOnHuman, mainMenuAutoOffHuman
  , settingsMenuHuman, challengesMenuHuman
  , gameScenarioIncr, gameDifficultyIncr, gameWolfToggle, gameFishToggle
    -- * Global commands that never take time
  , gameRestartHuman, gameQuitHuman, gameDropHuman, gameExitHuman, gameSaveHuman
  , tacticHuman, automateHuman, automateToggleHuman, automateBackHuman
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , areaToRectangles, meleeAid, displaceAid, moveSearchAlter, goToXhair
  , multiActorGoTo, moveOrSelectItem, selectItemsToMove, moveItems, projectItem
  , applyItem, alterTile, alterTileAtPos, verifyAlters, verifyEscape, guessAlter
  , artWithVersion, generateMenu, nxtGameMode
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

-- Cabal
import qualified Paths_LambdaHack as Self (version)

import qualified Data.EnumMap.Strict as EM
import qualified Data.EnumSet as ES
import qualified Data.Map.Strict as M
import qualified Data.Text as T
import           Data.Version
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Client.Bfs
import           Game.LambdaHack.Client.BfsM
import           Game.LambdaHack.Client.CommonM
import           Game.LambdaHack.Client.MonadClient
import           Game.LambdaHack.Client.Request
import           Game.LambdaHack.Client.State
import           Game.LambdaHack.Client.UI.ActorUI
import           Game.LambdaHack.Client.UI.Content.Input
import           Game.LambdaHack.Client.UI.Content.Screen
import           Game.LambdaHack.Client.UI.ContentClientUI
import           Game.LambdaHack.Client.UI.FrameM
import           Game.LambdaHack.Client.UI.Frontend (frontendName)
import           Game.LambdaHack.Client.UI.HandleHelperM
import           Game.LambdaHack.Client.UI.HandleHumanLocalM
import           Game.LambdaHack.Client.UI.HumanCmd
import           Game.LambdaHack.Client.UI.InventoryM
import           Game.LambdaHack.Client.UI.ItemDescription
import qualified Game.LambdaHack.Client.UI.Key as K
import           Game.LambdaHack.Client.UI.KeyBindings
import           Game.LambdaHack.Client.UI.MonadClientUI
import           Game.LambdaHack.Client.UI.Msg
import           Game.LambdaHack.Client.UI.MsgM
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Client.UI.RunM
import           Game.LambdaHack.Client.UI.SessionUI
import           Game.LambdaHack.Client.UI.Slideshow
import           Game.LambdaHack.Client.UI.SlideshowM
import           Game.LambdaHack.Client.UI.UIOptions
import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.ActorState
import           Game.LambdaHack.Common.Area
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Kind
import           Game.LambdaHack.Common.Level
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.MonadStateRead
import           Game.LambdaHack.Common.Point
import           Game.LambdaHack.Common.ReqFailure
import           Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import           Game.LambdaHack.Common.Types
import           Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import           Game.LambdaHack.Content.ModeKind
import           Game.LambdaHack.Content.RuleKind
import           Game.LambdaHack.Content.TileKind (TileKind)
import qualified Game.LambdaHack.Content.TileKind as TK
import           Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- * ByArea

-- | Pick command depending on area the mouse pointer is in.
-- The first matching area is chosen. If none match, only interrupt.
byAreaHuman :: MonadClientUI m
            => (HumanCmd -> m (Either MError ReqUI))
            -> [(CmdArea, HumanCmd)]
            -> m (Either MError ReqUI)
byAreaHuman :: (HumanCmd -> m (Either MError ReqUI))
-> [(CmdArea, HumanCmd)] -> m (Either MError ReqUI)
byAreaHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction l :: [(CmdArea, HumanCmd)]
l = do
  Point
pointer <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
  let pointerInArea :: CmdArea -> m Bool
pointerInArea a :: CmdArea
a = do
        [Maybe Area]
rs <- CmdArea -> m [Maybe Area]
forall (m :: * -> *). MonadClientUI m => CmdArea -> m [Maybe Area]
areaToRectangles CmdArea
a
        Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! (Area -> Bool) -> [Area] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point -> Area -> Bool
inside Point
pointer) ([Area] -> Bool) -> [Area] -> Bool
forall a b. (a -> b) -> a -> b
$ [Maybe Area] -> [Area]
forall a. [Maybe a] -> [a]
catMaybes [Maybe Area]
rs
  [(CmdArea, HumanCmd)]
cmds <- ((CmdArea, HumanCmd) -> m Bool)
-> [(CmdArea, HumanCmd)] -> m [(CmdArea, HumanCmd)]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM (CmdArea -> m Bool
pointerInArea (CmdArea -> m Bool)
-> ((CmdArea, HumanCmd) -> CmdArea)
-> (CmdArea, HumanCmd)
-> m Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (CmdArea, HumanCmd) -> CmdArea
forall a b. (a, b) -> a
fst) [(CmdArea, HumanCmd)]
l
  case [(CmdArea, HumanCmd)]
cmds of
    [] -> do
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
      Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
    (_, cmd :: HumanCmd
cmd) : _ ->
      HumanCmd -> m (Either MError ReqUI)
cmdAction HumanCmd
cmd

-- Many values here are shared with "Game.LambdaHack.Client.UI.DrawM".
areaToRectangles :: MonadClientUI m => CmdArea -> m [Maybe Area]
areaToRectangles :: CmdArea -> m [Maybe Area]
areaToRectangles ca :: CmdArea
ca = ((X, X, X, X) -> Maybe Area) -> [(X, X, X, X)] -> [Maybe Area]
forall a b. (a -> b) -> [a] -> [b]
map (X, X, X, X) -> Maybe Area
toArea ([(X, X, X, X)] -> [Maybe Area])
-> m [(X, X, X, X)] -> m [Maybe Area]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
 CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: ScreenContent -> X
rwidth :: X
rwidth, X
rheight :: ScreenContent -> X
rheight :: X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
 case CmdArea
ca of
  CaMessage -> [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(0, 0, X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1, 0)]
  CaMapLeader -> do  -- takes preference over @CaMapParty@ and @CaMap@
    ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
    let Point{..} = Actor -> Point
bpos Actor
b
    [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
px, X
mapStartY X -> X -> X
forall a. Num a => a -> a -> a
+ X
py, X
px, X
mapStartY X -> X -> X
forall a. Num a => a -> a -> a
+ X
py)]
  CaMapParty -> do  -- takes preference over @CaMap@
    LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
    FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
    [Actor]
ours <- (State -> [Actor]) -> m [Actor]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [Actor]) -> m [Actor])
-> (State -> [Actor]) -> m [Actor]
forall a b. (a -> b) -> a -> b
$ (Actor -> Bool) -> [Actor] -> [Actor]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Actor -> Bool) -> Actor -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Bool
bproj) ([Actor] -> [Actor]) -> (State -> [Actor]) -> State -> [Actor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((ActorId, Actor) -> Actor) -> [(ActorId, Actor)] -> [Actor]
forall a b. (a -> b) -> [a] -> [b]
map (ActorId, Actor) -> Actor
forall a b. (a, b) -> b
snd
                        ([(ActorId, Actor)] -> [Actor])
-> (State -> [(ActorId, Actor)]) -> State -> [Actor]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (FactionId -> Bool) -> LevelId -> State -> [(ActorId, Actor)]
actorAssocs (FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side) LevelId
lidV
    let rectFromB :: Point -> (X, X, X, X)
rectFromB Point{..} = (X
px, X
mapStartY X -> X -> X
forall a. Num a => a -> a -> a
+ X
py, X
px, X
mapStartY X -> X -> X
forall a. Num a => a -> a -> a
+ X
py)
    [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(X, X, X, X)] -> m [(X, X, X, X)])
-> [(X, X, X, X)] -> m [(X, X, X, X)]
forall a b. (a -> b) -> a -> b
$! (Actor -> (X, X, X, X)) -> [Actor] -> [(X, X, X, X)]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> (X, X, X, X)
rectFromB (Point -> (X, X, X, X))
-> (Actor -> Point) -> Actor -> (X, X, X, X)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos) [Actor]
ours
  CaMap -> [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return
    [( 0, X
mapStartY, X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1, X
mapStartY X -> X -> X
forall a. Num a => a -> a -> a
+ X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 4 )]
  CaLevelNumber -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2
                   in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(0, X
y, 1, X
y)]
  CaArenaName -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2
                     x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2 X -> X -> X
forall a. Num a => a -> a -> a
- 11
                 in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(3, X
y, X
x, X
y)]
  CaPercentSeen -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2
                       x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
                   in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
x X -> X -> X
forall a. Num a => a -> a -> a
- 9, X
y, X
x, X
y)]
  CaXhairDesc -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2
                     x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2 X -> X -> X
forall a. Num a => a -> a -> a
+ 2
                 in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
x, X
y, X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1, X
y)]
  CaSelected -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 1
                    x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
                in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(0, X
y, X
x X -> X -> X
forall a. Num a => a -> a -> a
- 24, X
y)]
  CaCalmGauge -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 1
                     x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
                 in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
x X -> X -> X
forall a. Num a => a -> a -> a
- 22, X
y, X
x X -> X -> X
forall a. Num a => a -> a -> a
- 18, X
y)]
  CaCalmValue -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 1
                     x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
                 in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
x X -> X -> X
forall a. Num a => a -> a -> a
- 17, X
y, X
x X -> X -> X
forall a. Num a => a -> a -> a
- 11, X
y)]
  CaHPGauge -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 1
                   x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
               in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
x X -> X -> X
forall a. Num a => a -> a -> a
- 9, X
y, X
x X -> X -> X
forall a. Num a => a -> a -> a
- 6, X
y)]
  CaHPValue -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 1
                   x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
               in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
x X -> X -> X
forall a. Num a => a -> a -> a
- 6, X
y, X
x, X
y)]
  CaLeaderDesc -> let y :: X
y = X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 1
                      x :: X
x = (X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2 X -> X -> X
forall a. Num a => a -> a -> a
+ 2
                  in [(X, X, X, X)] -> m [(X, X, X, X)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(X
x, X
y, X
rwidth X -> X -> X
forall a. Num a => a -> a -> a
- 1, X
y)]

-- * ByAimMode

byAimModeHuman :: MonadClientUI m
               => m (Either MError ReqUI) -> m (Either MError ReqUI)
               -> m (Either MError ReqUI)
byAimModeHuman :: m (Either MError ReqUI)
-> m (Either MError ReqUI) -> m (Either MError ReqUI)
byAimModeHuman cmdNotAimingM :: m (Either MError ReqUI)
cmdNotAimingM cmdAimingM :: m (Either MError ReqUI)
cmdAimingM = do
  Maybe AimMode
aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
aimMode then m (Either MError ReqUI)
cmdNotAimingM else m (Either MError ReqUI)
cmdAimingM

-- * ComposeIfLocal

composeIfLocalHuman :: MonadClientUI m
                    => m (Either MError ReqUI) -> m (Either MError ReqUI)
                    -> m (Either MError ReqUI)
composeIfLocalHuman :: m (Either MError ReqUI)
-> m (Either MError ReqUI) -> m (Either MError ReqUI)
composeIfLocalHuman c1 :: m (Either MError ReqUI)
c1 c2 :: m (Either MError ReqUI)
c2 = do
  Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
  case Either MError ReqUI
slideOrCmd1 of
    Left merr1 :: MError
merr1 -> do
      Either MError ReqUI
slideOrCmd2 <- m (Either MError ReqUI)
c2
      case Either MError ReqUI
slideOrCmd2 of
        Left merr2 :: MError
merr2 -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
forall a b. (a -> b) -> a -> b
$ MError -> MError -> MError
mergeMError MError
merr1 MError
merr2
        _ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd2
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd1

-- * ComposeUnlessError

composeUnlessErrorHuman :: MonadClientUI m
                        => m (Either MError ReqUI) -> m (Either MError ReqUI)
                        -> m (Either MError ReqUI)
composeUnlessErrorHuman :: m (Either MError ReqUI)
-> m (Either MError ReqUI) -> m (Either MError ReqUI)
composeUnlessErrorHuman c1 :: m (Either MError ReqUI)
c1 c2 :: m (Either MError ReqUI)
c2 = do
  Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
  case Either MError ReqUI
slideOrCmd1 of
    Left Nothing -> m (Either MError ReqUI)
c2
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd1

-- * Compose2ndLocal

compose2ndLocalHuman :: MonadClientUI m
                     => m (Either MError ReqUI) -> m (Either MError ReqUI)
                     -> m (Either MError ReqUI)
compose2ndLocalHuman :: m (Either MError ReqUI)
-> m (Either MError ReqUI) -> m (Either MError ReqUI)
compose2ndLocalHuman c1 :: m (Either MError ReqUI)
c1 c2 :: m (Either MError ReqUI)
c2 = do
  Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
  case Either MError ReqUI
slideOrCmd1 of
    Left merr1 :: MError
merr1 -> do
      Either MError ReqUI
slideOrCmd2 <- m (Either MError ReqUI)
c2
      case Either MError ReqUI
slideOrCmd2 of
        Left merr2 :: MError
merr2 -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
forall a b. (a -> b) -> a -> b
$ MError -> MError -> MError
mergeMError MError
merr1 MError
merr2
        _ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd1  -- ignore second request, keep effect
    req :: Either MError ReqUI
req -> do
      m (Either MError ReqUI) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Either MError ReqUI)
c2  -- ignore second request, keep effect
      Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
req

-- * LoopOnNothing

loopOnNothingHuman :: MonadClientUI m
                   => m (Either MError ReqUI)
                   -> m (Either MError ReqUI)
loopOnNothingHuman :: m (Either MError ReqUI) -> m (Either MError ReqUI)
loopOnNothingHuman cmd :: m (Either MError ReqUI)
cmd = do
  Either MError ReqUI
res <- m (Either MError ReqUI)
cmd
  case Either MError ReqUI
res of
    Left Nothing -> m (Either MError ReqUI) -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
m (Either MError ReqUI) -> m (Either MError ReqUI)
loopOnNothingHuman m (Either MError ReqUI)
cmd
    _ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
res

-- * ExecuteIfClear

executeIfClearHuman :: MonadClientUI m
                    => m (Either MError ReqUI)
                    -> m (Either MError ReqUI)
executeIfClearHuman :: m (Either MError ReqUI) -> m (Either MError ReqUI)
executeIfClearHuman c1 :: m (Either MError ReqUI)
c1 = do
  Bool
sreportNull <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sreportNull
  if Bool
sreportNull then m (Either MError ReqUI)
c1 else Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing

-- * Wait

-- | Leader waits a turn (and blocks, etc.).
waitHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)
waitHuman :: m (FailOrCmd RequestTimed)
waitHuman = do
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  if Skill -> Skills -> X
Ability.getSk Skill
Ability.SkWait Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then do
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {swaitTimes :: X
swaitTimes = X -> X
forall a. Num a => a -> a
abs (SessionUI -> X
swaitTimes SessionUI
sess) X -> X -> X
forall a. Num a => a -> a -> a
+ 1}
    FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
ReqWait
  else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
WaitUnskilled

-- * Wait10

-- | Leader waits a 1/10th of a turn (and doesn't block, etc.).
waitHuman10 :: MonadClientUI m => m (FailOrCmd RequestTimed)
waitHuman10 :: m (FailOrCmd RequestTimed)
waitHuman10 = do
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  if Skill -> Skills -> X
Ability.getSk Skill
Ability.SkWait Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 4 then do
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {swaitTimes :: X
swaitTimes = X -> X
forall a. Num a => a -> a
abs (SessionUI -> X
swaitTimes SessionUI
sess) X -> X -> X
forall a. Num a => a -> a -> a
+ 1}
    FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
ReqWait10
  else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
WaitUnskilled

-- * Yell

-- | Leader yells or yawns, if sleeping.
yellHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)
yellHuman :: m (FailOrCmd RequestTimed)
yellHuman = do
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  if Skill -> Skills -> X
Ability.getSk Skill
Ability.SkWait Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0
     -- If waiting drained and really, potentially, no other possible action,
     -- still allow yelling.
     Bool -> Bool -> Bool
|| Skill -> Skills -> X
Ability.getSk Skill
Ability.SkMove Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
     Bool -> Bool -> Bool
|| Skill -> Skills -> X
Ability.getSk Skill
Ability.SkDisplace Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
     Bool -> Bool -> Bool
|| Skill -> Skills -> X
Ability.getSk Skill
Ability.SkMelee Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
  then FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
ReqYell
  else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
WaitUnskilled

-- * MoveDir and RunDir

moveRunHuman :: (MonadClient m, MonadClientUI m)
             => Bool -> Bool -> Bool -> Bool -> Vector
             -> m (FailOrCmd RequestTimed)
moveRunHuman :: Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman initialStep :: Bool
initialStep finalGoal :: Bool
finalGoal run :: Bool
run runAhead :: Bool
runAhead dir :: Vector
dir = do
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
sb) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  -- Start running in the given direction. The first turn of running
  -- succeeds much more often than subsequent turns, because we ignore
  -- most of the disturbances, since the player is mostly aware of them
  -- and still explicitly requests a run, knowing how it behaves.
  EnumSet ActorId
sel <- (SessionUI -> EnumSet ActorId) -> m (EnumSet ActorId)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumSet ActorId
sselected
  let runMembers :: [ActorId]
runMembers = if Bool
runAhead Bool -> Bool -> Bool
|| Faction -> Bool
noRunWithMulti Faction
fact
                   then [ActorId
leader]
                   else EnumSet ActorId -> [ActorId]
forall k. Enum k => EnumSet k -> [k]
ES.toList (ActorId -> EnumSet ActorId -> EnumSet ActorId
forall k. Enum k => k -> EnumSet k -> EnumSet k
ES.delete ActorId
leader EnumSet ActorId
sel) [ActorId] -> [ActorId] -> [ActorId]
forall a. [a] -> [a] -> [a]
++ [ActorId
leader]
      runParams :: RunParams
runParams = $WRunParams :: ActorId -> [ActorId] -> Bool -> Maybe Text -> X -> RunParams
RunParams { runLeader :: ActorId
runLeader = ActorId
leader
                            , [ActorId]
runMembers :: [ActorId]
runMembers :: [ActorId]
runMembers
                            , runInitial :: Bool
runInitial = Bool
True
                            , runStopMsg :: Maybe Text
runStopMsg = Maybe Text
forall a. Maybe a
Nothing
                            , runWaiting :: X
runWaiting = 0 }
      macroRun25 :: [String]
macroRun25 = ["C-comma", "C-V"]
  Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
initialStep Bool -> Bool -> Bool
&& Bool
run) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: SessionUI
cli ->
      SessionUI
cli {srunning :: Maybe RunParams
srunning = RunParams -> Maybe RunParams
forall a. a -> Maybe a
Just RunParams
runParams}
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
runAhead (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: SessionUI
cli ->
        SessionUI
cli {slastPlay :: [KM]
slastPlay = (String -> KM) -> [String] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map String -> KM
K.mkKM [String]
macroRun25 [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ SessionUI -> [KM]
slastPlay SessionUI
cli}
  -- When running, the invisible actor is hit (not displaced!),
  -- so that running in the presence of roving invisible
  -- actors is equivalent to moving (with visible actors
  -- this is not a problem, since runnning stops early enough).
  let tpos :: Point
tpos = Actor -> Point
bpos Actor
sb Point -> Vector -> Point
`shift` Vector
dir
  -- We start by checking actors at the target position,
  -- which gives a partial information (actors can be invisible),
  -- as opposed to accessibility (and items) which are always accurate
  -- (tiles can't be invisible).
  [(ActorId, Actor)]
tgts <- (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)])
-> (State -> [(ActorId, Actor)]) -> m [(ActorId, Actor)]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [(ActorId, Actor)]
posToAidAssocs Point
tpos LevelId
arena
  case [(ActorId, Actor)]
tgts of
    [] -> do  -- move or search or alter
      FailOrCmd RequestTimed
runStopOrCmd <- Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter Bool
run Vector
dir
      case FailOrCmd RequestTimed
runStopOrCmd of
        Left stopMsg :: FailError
stopMsg -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
stopMsg
        Right runCmd :: RequestTimed
runCmd ->
          -- Don't check @initialStep@ and @finalGoal@
          -- and don't stop going to target: door opening is mundane enough.
          FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
runCmd
    [(target :: ActorId
target, _)] | Bool
run
                    Bool -> Bool -> Bool
&& Bool
initialStep
                    Bool -> Bool -> Bool
&& Skill -> Skills -> X
Ability.getSk Skill
Ability.SkDisplace Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ->
      -- No @stopPlayBack@: initial displace is benign enough.
      -- Displacing requires accessibility, but it's checked later on.
      ActorId -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (FailOrCmd RequestTimed)
displaceAid ActorId
target
    _ : _ : _ | Bool
run
                Bool -> Bool -> Bool
&& Bool
initialStep
                Bool -> Bool -> Bool
&& Skill -> Skills -> X
Ability.getSk Skill
Ability.SkDisplace Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ->
      ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceMultiple
    (target :: ActorId
target, tb :: Actor
tb) : _ | Bool -> Bool
not Bool
run
                       Bool -> Bool -> Bool
&& Bool
initialStep Bool -> Bool -> Bool
&& Bool
finalGoal
                       Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
tb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
sb Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) -> do
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack  -- don't ever auto-repeat leader choice
      -- We always see actors from our own faction.
      -- Select one of adjacent actors by bumping into him. Takes no time.
      Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
target
      let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "bump self"
                                String
-> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
leader, ActorId
target, Actor
tb)) ()
      Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "by bumping"
    (target :: ActorId
target, tb :: Actor
tb) : _ | Bool -> Bool
not Bool
run
                       Bool -> Bool -> Bool
&& Bool
initialStep Bool -> Bool -> Bool
&& Bool
finalGoal
                       Bool -> Bool -> Bool
&& (Actor -> FactionId
bfid Actor
tb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
sb Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
tb)
                       Bool -> Bool -> Bool
&& Skill -> Skills -> X
Ability.getSk Skill
Ability.SkMelee Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> do
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack  -- don't ever auto-repeat melee
      -- No problem if there are many projectiles at the spot. We just
      -- attack the first one.
      ActorId -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m (FailOrCmd RequestTimed)
meleeAid ActorId
target
    _ : _ -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "actor in the way"

-- | Actor attacks an enemy actor or his own projectile.
meleeAid :: (MonadClient m, MonadClientUI m)
         => ActorId -> m (FailOrCmd RequestTimed)
meleeAid :: ActorId -> m (FailOrCmd RequestTimed)
meleeAid target :: ActorId
target = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Actor
tb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  Faction
sfact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
sb) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Maybe RequestTimed
mel <- ActorId -> ActorId -> m (Maybe RequestTimed)
forall (m :: * -> *).
MonadClient m =>
ActorId -> ActorId -> m (Maybe RequestTimed)
pickWeaponClient ActorId
leader ActorId
target
  case Maybe RequestTimed
mel of
    Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "nothing to melee with"
    Just wp :: RequestTimed
wp -> do
      let returnCmd :: m (FailOrCmd RequestTimed)
returnCmd = do
            -- Set personal target to enemy, so that AI, if it takes over
            -- the actor, is likely to continue the fight even if the foe flees.
            (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
leader ((Maybe Target -> Maybe Target) -> StateClient -> StateClient)
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
forall a b. (a -> b) -> a -> b
$ Maybe Target -> Maybe Target -> Maybe Target
forall a b. a -> b -> a
const (Maybe Target -> Maybe Target -> Maybe Target)
-> Maybe Target -> Maybe Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
target
            -- Also set xhair to see the foe's HP, because it's automatically
            -- set to any new spotted actor, so it needs to be reset
            -- and also it's not useful as permanent ranged target anyway.
            (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
target}
            FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
wp
          res :: m (FailOrCmd RequestTimed)
res | Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
sb) Faction
sfact (Actor -> FactionId
bfid Actor
tb) = m (FailOrCmd RequestTimed)
returnCmd
              | FactionId -> Faction -> FactionId -> Bool
isFriend (Actor -> FactionId
bfid Actor
sb) Faction
sfact (Actor -> FactionId
bfid Actor
tb) = do
                let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Actor -> FactionId
bfid Actor
sb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
tb) ()
                Bool
go1 <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
                         "You are bound by an alliance. Really attack?"
                if Bool -> Bool
not Bool
go1 then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "attack canceled" else m (FailOrCmd RequestTimed)
returnCmd
              | Bool
otherwise = do
                Bool
go2 <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
                         "This attack will start a war. Are you sure?"
                if Bool -> Bool
not Bool
go2 then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "attack canceled" else m (FailOrCmd RequestTimed)
returnCmd
      m (FailOrCmd RequestTimed)
res
  -- Seeing the actor prevents altering a tile under it, but that
  -- does not limit the player, he just doesn't waste a turn
  -- on a failed altering.

-- | Actor swaps position with another.
displaceAid :: MonadClientUI m
            => ActorId -> m (FailOrCmd RequestTimed)
displaceAid :: ActorId -> m (FailOrCmd RequestTimed)
displaceAid target :: ActorId
target = do
  COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Actor
tb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
  let dozes :: Bool
dozes = Actor -> Watchfulness
bwatch Actor
tb Watchfulness -> [Watchfulness] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Watchfulness
WSleep, Watchfulness
WWake]
  Faction
tfact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
tb) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
target
  Bool
dEnemy <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> ActorId -> Skills -> State -> Bool
dispEnemy ActorId
leader ActorId
target Skills
actorMaxSk
  let immobile :: Bool
immobile = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
      tpos :: Point
tpos = Actor -> Point
bpos Actor
tb
      adj :: Bool
adj = Actor -> Actor -> Bool
checkAdjacent Actor
sb Actor
tb
      atWar :: Bool
atWar = FactionId -> Faction -> FactionId -> Bool
isFoe (Actor -> FactionId
bfid Actor
tb) Faction
tfact (Actor -> FactionId
bfid Actor
sb)
  if | Bool -> Bool
not Bool
adj -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceDistant
     | Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) Bool -> Bool -> Bool
&& Bool
atWar
       Bool -> Bool -> Bool
&& Actor -> Bool
actorDying Actor
tb ->
       ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceDying
     | Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) Bool -> Bool -> Bool
&& Bool
atWar
       Bool -> Bool -> Bool
&& Actor -> Bool
actorWaits Actor
tb ->
       ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceBraced
     | Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) Bool -> Bool -> Bool
&& Bool
atWar
       Bool -> Bool -> Bool
&& Bool
immobile Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
dozes ->  -- roots weak if the tree sleeps
       ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceImmobile
     | Bool -> Bool
not Bool
dEnemy Bool -> Bool -> Bool
&& Bool
atWar ->
       ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceSupported
     | Bool
otherwise -> do
       let lid :: LevelId
lid = Actor -> LevelId
blid Actor
sb
       Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
       -- Displacing requires full access.
       if TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool) -> ContentId TileKind -> Bool
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos then
         case Point -> Level -> [ActorId]
posToAidsLvl Point
tpos Level
lvl of
           [] -> String -> m (FailOrCmd RequestTimed)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (FailOrCmd RequestTimed))
-> String -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ "" String -> (ActorId, Actor, ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
leader, Actor
sb, ActorId
target, Actor
tb)
           [_] -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
target
           _ -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceMultiple
       else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceAccess

-- | Leader moves or searches or alters. No visible actor at the position.
moveSearchAlter :: MonadClientUI m
                => Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter :: Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter run :: Bool
run dir :: Vector
dir = do
  COps{ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile :: ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
sb Skills
actorMaxSk
      moveSkill :: X
moveSkill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkMove Skills
actorSk
      alterSkill :: X
alterSkill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkAlter Skills
actorSk
      applySkill :: X
applySkill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkApply Skills
actorSk
      spos :: Point
spos = Actor -> Point
bpos Actor
sb           -- source position
      tpos :: Point
tpos = Point
spos Point -> Vector -> Point
`shift` Vector
dir  -- target position
  ItemId -> ItemFull
itemToF <- (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull))
-> (State -> ItemId -> ItemFull) -> m (ItemId -> ItemFull)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemFull) -> State -> ItemId -> ItemFull
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemFull
itemToFull
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
sb)
  ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag (Actor -> LevelId
blid Actor
sb) Point
tpos
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
sb
  Text
blurb <- LevelId -> Point -> m Text
forall (m :: * -> *). MonadClientUI m => LevelId -> Point -> m Text
lookAtPosition (Actor -> LevelId
blid Actor
sb) Point
tpos
  let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
      alterMinSkill :: X
alterMinSkill = TileSpeedup -> ContentId TileKind -> X
Tile.alterMinSkill TileSpeedup
coTileSpeedup ContentId TileKind
t
      canApplyEmbeds :: Bool
canApplyEmbeds = ((ItemId, ItemQuant) -> Bool) -> [(ItemId, ItemQuant)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (ItemId, ItemQuant) -> Bool
canApplyEmbed ([(ItemId, ItemQuant)] -> Bool) -> [(ItemId, ItemQuant)] -> Bool
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(ItemId, ItemQuant)]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds
      canApplyEmbed :: (ItemId, ItemQuant) -> Bool
canApplyEmbed (iid :: ItemId
iid, kit :: ItemQuant
kit) =
        let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
            legal :: Either ReqFailure Bool
legal = Time
-> X -> Bool -> ItemFull -> ItemQuant -> Either ReqFailure Bool
permittedApply Time
localTime X
applySkill Bool
calmE ItemFull
itemFull ItemQuant
kit
        -- Let even completely unskilled actors trigger basic embeds.
        in (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) (Bool -> Bool -> Bool
forall a b. a -> b -> a
const Bool
True) Either ReqFailure Bool
legal
      alterable :: Bool
alterable = TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
t Bool -> Bool -> Bool
|| Bool -> Bool
not (ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
embeds)
      underFeet :: Bool
underFeet = Point
tpos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
spos  -- if enter and alter, be more permissive
  FailOrCmd RequestTimed
runStopOrCmd <-
    if -- Movement requires full access.
       | TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t ->
           if X
moveSkill X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then
             -- A potential invisible actor is hit. War started without asking.
             FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ Vector -> RequestTimed
ReqMove Vector
dir
           else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MoveUnskilled
       -- Not walkable, so search and/or alter the tile.
       | Bool
run -> do
           -- Explicit request to examine the terrain.
           Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
blurb
           Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith (Text -> m (FailOrCmd RequestTimed))
-> Text -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ if Bool
alterable
                      then "potentially alterable"
                      else "not alterable"
       | Bool -> Bool
not Bool
alterable -> do
           let name :: Part
name = Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ TileKind -> Text
TK.tname (TileKind -> Text) -> TileKind -> Text
forall a b. (a -> b) -> a -> b
$ ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t
           Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith (Text -> m (FailOrCmd RequestTimed))
-> Text -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ [Part] -> Text
makePhrase ["there is no point kicking", Part -> Part
MU.AW Part
name]
             -- misclick? related to AlterNothing but no searching possible;
             -- we don't show tile description, because it only comes from
             -- embedded items and here probably there are none (can be all
             -- charging, but that's rare)
       | Bool -> Bool
not Bool
underFeet Bool -> Bool -> Bool
&& X
alterSkill X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterUnskilled
       | Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
t)
         Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underFeet
         Bool -> Bool -> Bool
&& X
alterSkill X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
alterMinSkill -> do
           -- Rather rare (requires high skill), so describe the tile.
           Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
blurb
           ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterUnwalked
       | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
t Bool -> Bool -> Bool
|| Bool
canApplyEmbeds -> do
           -- Rather rare (charging embeds or too low skill for embeds
           -- that are, e.g., `?`), so describe the tile.
           -- Unfortunately this includes cases when an actor can exploit
           -- signboard when hidden, but can't later on when revealed.
           Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
blurb
           Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "unable to exploit the terrain"
       | Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member Point
tpos (EnumMap Point ItemBag -> Bool) -> EnumMap Point ItemBag -> Bool
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ItemBag
lfloor Level
lvl -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterBlockItem
       | Point -> Level -> Bool
occupiedBigLvl Point
tpos Level
lvl Bool -> Bool -> Bool
|| Point -> Level -> Bool
occupiedProjLvl Point
tpos Level
lvl ->
           -- Don't mislead describing terrain, if other actor is to blame.
           ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterBlockActor
       | Bool
otherwise -> do  -- promising
           FailOrCmd ()
verAlters <- LevelId -> Point -> m (FailOrCmd ())
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Point -> m (FailOrCmd ())
verifyAlters (Actor -> LevelId
blid Actor
sb) Point
tpos
           case FailOrCmd ()
verAlters of
             Right () -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ Point -> RequestTimed
ReqAlter Point
tpos
             Left err :: FailError
err -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
           -- We don't use ReqMove, because we don't hit invisible actors,
           -- e.g., hidden in a wall. If server performed an attack for free
           -- on the invisible actor anyway, the player (or AI)
           -- would be tempted to repeatedly hit random walls
           -- in hopes of killing a monster residing within.
           -- If the action had a cost, misclicks would incur the cost, too.
           -- Right now the player may repeatedly alter tiles trying to learn
           -- about invisible pass-wall actors, but when an actor detected,
           -- it costs a turn and does not harm the invisible actors,
           -- so it's not so tempting.
  FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$! FailOrCmd RequestTimed
runStopOrCmd

-- * RunOnceAhead

runOnceAheadHuman :: MonadClientUI m => m (Either MError RequestTimed)
runOnceAheadHuman :: m (Either MError RequestTimed)
runOnceAheadHuman = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
  Maybe RunParams
srunning <- (SessionUI -> Maybe RunParams) -> m (Maybe RunParams)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RunParams
srunning
  -- When running, stop if disturbed. If not running, stop at once.
  case Maybe RunParams
srunning of
    Nothing -> do
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
      Either MError RequestTimed -> m (Either MError RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError RequestTimed -> m (Either MError RequestTimed))
-> Either MError RequestTimed -> m (Either MError RequestTimed)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError RequestTimed
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
    Just RunParams{[ActorId]
runMembers :: [ActorId]
runMembers :: RunParams -> [ActorId]
runMembers}
      | Faction -> Bool
noRunWithMulti Faction
fact Bool -> Bool -> Bool
&& [ActorId]
runMembers [ActorId] -> [ActorId] -> Bool
forall a. Eq a => a -> a -> Bool
/= [ActorId
leader] -> do
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
      MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgRunStop "run stop: automatic leader change"
      Either MError RequestTimed -> m (Either MError RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError RequestTimed -> m (Either MError RequestTimed))
-> Either MError RequestTimed -> m (Either MError RequestTimed)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError RequestTimed
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
    Just _runParams :: RunParams
_runParams | Bool
keyPressed -> do
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
discardPressedKey
      m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
      MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgRunStop "run stop: key pressed"
      FailOrCmd RequestTimed -> Either MError RequestTimed
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd RequestTimed -> Either MError RequestTimed)
-> m (FailOrCmd RequestTimed) -> m (Either MError RequestTimed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "interrupted"
    Just runParams :: RunParams
runParams -> do
      LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
      Either Text RequestTimed
runOutcome <- LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
runParams
      case Either Text RequestTimed
runOutcome of
        Left stopMsg :: Text
stopMsg -> do
          m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
          MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgRunStop ("run stop:" Text -> Text -> Text
<+> Text
stopMsg)
          Either MError RequestTimed -> m (Either MError RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError RequestTimed -> m (Either MError RequestTimed))
-> Either MError RequestTimed -> m (Either MError RequestTimed)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError RequestTimed
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
        Right runCmd :: RequestTimed
runCmd ->
          Either MError RequestTimed -> m (Either MError RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError RequestTimed -> m (Either MError RequestTimed))
-> Either MError RequestTimed -> m (Either MError RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Either MError RequestTimed
forall a b. b -> Either a b
Right RequestTimed
runCmd

-- * MoveOnceToXhair

moveOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
                     => m (FailOrCmd RequestTimed)
moveOnceToXhairHuman :: m (FailOrCmd RequestTimed)
moveOnceToXhairHuman = Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair Bool
True Bool
False

goToXhair :: (MonadClient m, MonadClientUI m)
          => Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair :: Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair initialStep :: Bool
initialStep run :: Bool
run = do
  Maybe AimMode
aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
  -- Movement is legal only outside aiming mode.
  if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
aimMode then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "cannot move in aiming mode"
  else do
    ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
    Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
    Maybe Point
xhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
    case Maybe Point
xhairPos of
      Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "crosshair position invalid"
      Just c :: Point
c | Point
c Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "position reached"
      Just c :: Point
c -> do
        Maybe RunParams
running <- (SessionUI -> Maybe RunParams) -> m (Maybe RunParams)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RunParams
srunning
        case Maybe RunParams
running of
          -- Don't use running params from previous run or goto-xhair.
          Just paramOld :: RunParams
paramOld | Bool -> Bool
not Bool
initialStep -> do
            LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
            FailOrCmd (Bool, Vector)
runOutcome <- LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo LevelId
arena Point
c RunParams
paramOld
            case FailOrCmd (Bool, Vector)
runOutcome of
              Left stopMsg :: FailError
stopMsg -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
stopMsg
              Right (finalGoal :: Bool
finalGoal, dir :: Vector
dir) ->
                Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman Bool
initialStep Bool
finalGoal Bool
run Bool
False Vector
dir
          _ -> do
            let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
initialStep Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
run) ()
            (bfs :: Array BfsDistance
bfs, mpath :: Maybe AndPath
mpath) <- ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
getCacheBfsAndPath ActorId
leader Point
c
            Bool
xhairMoused <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sxhairMoused
            case Maybe AndPath
mpath of
              _ | Bool
xhairMoused Bool -> Bool -> Bool
&& Maybe X -> Bool
forall a. Maybe a -> Bool
isNothing (Array BfsDistance -> Point -> Maybe X
accessBfs Array BfsDistance
bfs Point
c) ->
                Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith
                  "no route to crosshair (press again to go there anyway)"
              _ | Bool
initialStep Bool -> Bool -> Bool
&& Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
c -> do
                let dir :: Vector
dir = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
c
                Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman Bool
initialStep Bool
True Bool
run Bool
False Vector
dir
              Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no route to crosshair"
              Just AndPath{pathList :: AndPath -> [Point]
pathList=[]} -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "almost there"
              Just AndPath{pathList :: AndPath -> [Point]
pathList = p1 :: Point
p1 : _} -> do
                let finalGoal :: Bool
finalGoal = Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
c
                    dir :: Vector
dir = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
p1
                Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman Bool
initialStep Bool
finalGoal Bool
run Bool
False Vector
dir

multiActorGoTo :: (MonadClient m, MonadClientUI m)
               => LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo :: LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo arena :: LevelId
arena c :: Point
c paramOld :: RunParams
paramOld =
  case RunParams
paramOld of
    RunParams{runMembers :: RunParams -> [ActorId]
runMembers = []} -> Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "selected actors no longer there"
    RunParams{runMembers :: RunParams -> [ActorId]
runMembers = r :: ActorId
r : rs :: [ActorId]
rs, X
runWaiting :: X
runWaiting :: RunParams -> X
runWaiting} -> do
      Bool
onLevel <- (State -> Bool) -> m Bool
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Bool) -> m Bool) -> (State -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ ActorId -> LevelId -> State -> Bool
memActor ActorId
r LevelId
arena
      if Bool -> Bool
not Bool
onLevel then do
        let paramNew :: RunParams
paramNew = RunParams
paramOld {runMembers :: [ActorId]
runMembers = [ActorId]
rs}
        LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo LevelId
arena Point
c RunParams
paramNew
      else do
        State
sL <- m State
forall (m :: * -> *). MonadStateRead m => m State
getState
        (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> StateClient -> StateClient
updateLeader ActorId
r State
sL
        let runMembersNew :: [ActorId]
runMembersNew = [ActorId]
rs [ActorId] -> [ActorId] -> [ActorId]
forall a. [a] -> [a] -> [a]
++ [ActorId
r]
            paramNew :: RunParams
paramNew = RunParams
paramOld { runMembers :: [ActorId]
runMembers = [ActorId]
runMembersNew
                                , runWaiting :: X
runWaiting = 0}
        Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
r
        (bfs :: Array BfsDistance
bfs, mpath :: Maybe AndPath
mpath) <- ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
getCacheBfsAndPath ActorId
r Point
c
        Bool
xhairMoused <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sxhairMoused
        case Maybe AndPath
mpath of
          _ | Bool
xhairMoused Bool -> Bool -> Bool
&& Maybe X -> Bool
forall a. Maybe a -> Bool
isNothing (Array BfsDistance -> Point -> Maybe X
accessBfs Array BfsDistance
bfs Point
c) ->
            Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no route to crosshair (press again to go there anyway)"
          Nothing -> Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no route to crosshair"
          Just AndPath{pathList :: AndPath -> [Point]
pathList=[]} -> Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "almost there"
          Just AndPath{pathList :: AndPath -> [Point]
pathList = p1 :: Point
p1 : _} -> do
            let finalGoal :: Bool
finalGoal = Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
c
                dir :: Vector
dir = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
p1
            [ActorId]
tgts <- (State -> [ActorId]) -> m [ActorId]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [ActorId]) -> m [ActorId])
-> (State -> [ActorId]) -> m [ActorId]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [ActorId]
posToAids Point
p1 LevelId
arena
            case [ActorId]
tgts of
              [] -> do
                (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {srunning :: Maybe RunParams
srunning = RunParams -> Maybe RunParams
forall a. a -> Maybe a
Just RunParams
paramNew}
                FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector)))
-> FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector))
forall a b. (a -> b) -> a -> b
$ (Bool, Vector) -> FailOrCmd (Bool, Vector)
forall a b. b -> Either a b
Right (Bool
finalGoal, Vector
dir)
              [target :: ActorId
target] | ActorId
target ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActorId]
rs Bool -> Bool -> Bool
|| X
runWaiting X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= [ActorId] -> X
forall a. [a] -> X
length [ActorId]
rs ->
                -- Let r wait until all others move. Mark it in runWaiting
                -- to avoid cycles. When all wait for each other, fail.
                LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo LevelId
arena Point
c RunParams
paramNew{runWaiting :: X
runWaiting=X
runWaiting X -> X -> X
forall a. Num a => a -> a -> a
+ 1}
              _ ->
                Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "actor in the way"

-- * RunOnceToXhair

runOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
                    => m (FailOrCmd RequestTimed)
runOnceToXhairHuman :: m (FailOrCmd RequestTimed)
runOnceToXhairHuman = Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair Bool
True Bool
True

-- * ContinueToXhair

continueToXhairHuman :: (MonadClient m, MonadClientUI m)
                     => m (FailOrCmd RequestTimed)
continueToXhairHuman :: m (FailOrCmd RequestTimed)
continueToXhairHuman = Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair Bool
False Bool
False{-irrelevant-}

-- * MoveItem

moveItemHuman :: forall m. MonadClientUI m
              => [CStore] -> CStore -> Maybe MU.Part -> Bool
              -> m (FailOrCmd RequestTimed)
moveItemHuman :: [CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
moveItemHuman cLegalRaw :: [CStore]
cLegalRaw destCStore :: CStore
destCStore mverb :: Maybe Part
mverb auto :: Bool
auto = do
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  if Skill -> Skills -> X
Ability.getSk Skill
Ability.SkMoveItem Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then
    [CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
moveOrSelectItem [CStore]
cLegalRaw CStore
destCStore Maybe Part
mverb Bool
auto
  else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MoveItemUnskilled

-- This cannot be structured as projecting or applying, with @ByItemMode@
-- and @ChooseItemToMove@, because at least in case of grabbing items,
-- more than one item is chosen, which doesn't fit @sitemSel@. Separating
-- grabbing of multiple items as a distinct command is too high a price.
moveOrSelectItem :: forall m. MonadClientUI m
                 => [CStore] -> CStore -> Maybe MU.Part -> Bool
                 -> m (FailOrCmd RequestTimed)
moveOrSelectItem :: [CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
moveOrSelectItem cLegalRaw :: [CStore]
cLegalRaw destCStore :: CStore
destCStore mverb :: Maybe Part
mverb auto :: Bool
auto = do
  Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}  -- prevent surprise
  case Maybe (ItemId, CStore, Bool)
itemSel of
    Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) | CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
destCStore
                                Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore]
cLegalRaw -> do
      ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
      ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
      case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
        Nothing ->  -- the case of old selection or selection from another actor
          [CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
moveItemHuman [CStore]
cLegalRaw CStore
destCStore Maybe Part
mverb Bool
auto
        Just (k :: X
k, it :: ItemTimer
it) -> Bool -> m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (X
k X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0) (m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed))
-> m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ do
          ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
          let eqpFree :: X
eqpFree = Actor -> X
eqpFreeN Actor
b
              kToPick :: X
kToPick | CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp = X -> X -> X
forall a. Ord a => a -> a -> a
min X
eqpFree X
k
                      | Bool
otherwise = X
k
          if X
kToPick X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0
          then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no more items can be equipped"
          else do
            Either MError X
socK <- Bool -> X -> m (Either MError X)
forall (m :: * -> *).
MonadClientUI m =>
Bool -> X -> m (Either MError X)
pickNumber (Bool -> Bool
not Bool
auto) X
kToPick
            case Either MError X
socK of
              Left Nothing -> [CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
moveItemHuman [CStore]
cLegalRaw CStore
destCStore Maybe Part
mverb Bool
auto
              Left (Just err :: FailError
err) -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
              Right kChosen :: X
kChosen ->
                let is :: (CStore, [(ItemId, (ItemFull, ItemQuant))])
is = ( CStore
fromCStore
                         , [(ItemId
iid, (ItemFull
itemFull, (X
kChosen, X -> ItemTimer -> ItemTimer
forall a. X -> [a] -> [a]
take X
kChosen ItemTimer
it)))] )
                in [CStore]
-> (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> CStore
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[CStore]
-> (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> CStore
-> m (FailOrCmd RequestTimed)
moveItems [CStore]
cLegalRaw (CStore, [(ItemId, (ItemFull, ItemQuant))])
is CStore
destCStore
    _ -> do
      FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])
mis <- [CStore]
-> CStore
-> Maybe Part
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
forall (m :: * -> *).
MonadClientUI m =>
[CStore]
-> CStore
-> Maybe Part
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
selectItemsToMove [CStore]
cLegalRaw CStore
destCStore Maybe Part
mverb Bool
auto
      case FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])
mis of
        Left err :: FailError
err -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
        Right (fromCStore :: CStore
fromCStore, [(iid :: ItemId
iid, _)]) | [CStore]
cLegalRaw [CStore] -> [CStore] -> Bool
forall a. Eq a => a -> a -> Bool
/= [CStore
CGround] -> do
          (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
            SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
          [CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[CStore]
-> CStore -> Maybe Part -> Bool -> m (FailOrCmd RequestTimed)
moveItemHuman [CStore]
cLegalRaw CStore
destCStore Maybe Part
mverb Bool
auto
        Right is :: (CStore, [(ItemId, (ItemFull, ItemQuant))])
is -> [CStore]
-> (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> CStore
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[CStore]
-> (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> CStore
-> m (FailOrCmd RequestTimed)
moveItems [CStore]
cLegalRaw (CStore, [(ItemId, (ItemFull, ItemQuant))])
is CStore
destCStore

selectItemsToMove :: forall m. MonadClientUI m
                  => [CStore] -> CStore -> Maybe MU.Part -> Bool
                  -> m (FailOrCmd (CStore, [(ItemId, ItemFullKit)]))
selectItemsToMove :: [CStore]
-> CStore
-> Maybe Part
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
selectItemsToMove cLegalRaw :: [CStore]
cLegalRaw destCStore :: CStore
destCStore mverb :: Maybe Part
mverb auto :: Bool
auto = do
  let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (CStore
destCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore]
cLegalRaw) ()
  let verb :: Part
verb = Part -> Maybe Part -> Part
forall a. a -> Maybe a -> a
fromMaybe (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
verbCStore CStore
destCStore) Maybe Part
mverb
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  -- This calmE is outdated when one of the items increases max Calm
  -- (e.g., in pickup, which handles many items at once), but this is OK,
  -- the server accepts item movement based on calm at the start, not end
  -- or in the middle.
  -- The calmE is inaccurate also if an item not IDed, but that's intended
  -- and the server will ignore and warn (and content may avoid that,
  -- e.g., making all rings identified)
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  Maybe (CStore, CStore)
lastItemMove <- (SessionUI -> Maybe (CStore, CStore)) -> m (Maybe (CStore, CStore))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (CStore, CStore)
slastItemMove
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      cLegalE :: [CStore]
cLegalE | Bool
calmE = [CStore]
cLegalRaw
              | CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CSha = []
              | Bool
otherwise = CStore -> [CStore] -> [CStore]
forall a. Eq a => a -> [a] -> [a]
delete CStore
CSha [CStore]
cLegalRaw
      cLegal :: [CStore]
cLegal = case Maybe (CStore, CStore)
lastItemMove of
        Just (lastFrom :: CStore
lastFrom, lastDest :: CStore
lastDest) | CStore
lastDest CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
destCStore
                                    Bool -> Bool -> Bool
&& CStore
lastFrom CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore]
cLegalE ->
          CStore
lastFrom CStore -> [CStore] -> [CStore]
forall a. a -> [a] -> [a]
: CStore -> [CStore] -> [CStore]
forall a. Eq a => a -> [a] -> [a]
delete CStore
lastFrom [CStore]
cLegalE
        _ -> [CStore]
cLegalE
      prompt :: Text
prompt = [Part] -> Text
makePhrase ["What to", Part
verb]
      promptEqp :: Text
promptEqp = [Part] -> Text
makePhrase ["What consumable to", Part
verb]
      (promptGeneric :: Text
promptGeneric, psuit :: m Suitability
psuit) =
        -- We prune item list only for eqp, because other stores don't have
        -- so clear cut heuristics. So when picking up a stash, either grab
        -- it to auto-store things, or equip first using the pruning
        -- and then pack/stash the rest selectively or en masse.
        if CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& [CStore]
cLegalRaw [CStore] -> [CStore] -> Bool
forall a. Eq a => a -> a -> Bool
/= [CStore
CGround]
        then (Text
promptEqp, Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return (Suitability -> m Suitability) -> Suitability -> m Suitability
forall a b. (a -> b) -> a -> b
$ (ItemFull -> ItemQuant -> Bool) -> Suitability
SuitsSomething ((ItemFull -> ItemQuant -> Bool) -> Suitability)
-> (ItemFull -> ItemQuant -> Bool) -> Suitability
forall a b. (a -> b) -> a -> b
$ \itemFull :: ItemFull
itemFull _kit :: ItemQuant
_kit ->
               AspectRecord -> Bool
IA.goesIntoEqp (AspectRecord -> Bool) -> AspectRecord -> Bool
forall a b. (a -> b) -> a -> b
$ ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull)
        else (Text
prompt, Suitability -> m Suitability
forall (m :: * -> *) a. Monad m => a -> m a
return Suitability
SuitsEverything)
  Either
  Text
  ([(ItemId, (ItemFull, ItemQuant))],
   (ItemDialogMode, Either KM SlotChar))
ggi <- m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
        Text
        ([(ItemId, (ItemFull, ItemQuant))],
         (ItemDialogMode, Either KM SlotChar)))
forall (m :: * -> *).
MonadClientUI m =>
m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> [CStore]
-> Bool
-> Bool
-> m (Either
        Text
        ([(ItemId, (ItemFull, ItemQuant))],
         (ItemDialogMode, Either KM SlotChar)))
getFull m Suitability
psuit
                 (\_ _ _ cCur :: ItemDialogMode
cCur _ -> Text
prompt Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur)
                 (\_ _ _ cCur :: ItemDialogMode
cCur _ -> Text
promptGeneric Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur)
                 [CStore]
cLegalRaw [CStore]
cLegal (Bool -> Bool
not Bool
auto) Bool
True
  case Either
  Text
  ([(ItemId, (ItemFull, ItemQuant))],
   (ItemDialogMode, Either KM SlotChar))
ggi of
    Right (l :: [(ItemId, (ItemFull, ItemQuant))]
l, (MStore fromCStore :: CStore
fromCStore, _)) -> do
      (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
        SessionUI
sess {slastItemMove :: Maybe (CStore, CStore)
slastItemMove = (CStore, CStore) -> Maybe (CStore, CStore)
forall a. a -> Maybe a
Just (CStore
fromCStore, CStore
destCStore)}
      FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])
 -> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])))
-> FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
forall a b. (a -> b) -> a -> b
$ (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])
forall a b. b -> Either a b
Right (CStore
fromCStore, [(ItemId, (ItemFull, ItemQuant))]
l)
    Left err :: Text
err -> Text -> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
    _ -> String -> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
forall a. (?callStack::CallStack) => String -> a
error (String
 -> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))])))
-> String
-> m (FailOrCmd (CStore, [(ItemId, (ItemFull, ItemQuant))]))
forall a b. (a -> b) -> a -> b
$ "" String
-> Either
     Text
     ([(ItemId, (ItemFull, ItemQuant))],
      (ItemDialogMode, Either KM SlotChar))
-> String
forall v. Show v => String -> v -> String
`showFailure` Either
  Text
  ([(ItemId, (ItemFull, ItemQuant))],
   (ItemDialogMode, Either KM SlotChar))
ggi

moveItems :: forall m. MonadClientUI m
          => [CStore] -> (CStore, [(ItemId, ItemFullKit)]) -> CStore
          -> m (FailOrCmd RequestTimed)
moveItems :: [CStore]
-> (CStore, [(ItemId, (ItemFull, ItemQuant))])
-> CStore
-> m (FailOrCmd RequestTimed)
moveItems cLegalRaw :: [CStore]
cLegalRaw (fromCStore :: CStore
fromCStore, l :: [(ItemId, (ItemFull, ItemQuant))]
l) destCStore :: CStore
destCStore = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  DiscoveryBenefit
discoBenefit <- (StateClient -> DiscoveryBenefit) -> m DiscoveryBenefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> DiscoveryBenefit
sdiscoBenefit
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      ret4 :: [(ItemId, ItemFullKit)] -> Int
           -> m [(ItemId, Int, CStore, CStore)]
      ret4 :: [(ItemId, (ItemFull, ItemQuant))]
-> X -> m [(ItemId, X, CStore, CStore)]
ret4 [] _ = [(ItemId, X, CStore, CStore)] -> m [(ItemId, X, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      ret4 ((iid :: ItemId
iid, (itemFull :: ItemFull
itemFull, (itemK :: X
itemK, _))) : rest :: [(ItemId, (ItemFull, ItemQuant))]
rest) oldN :: X
oldN = do
        let k :: X
k = X
itemK
            !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (X
k X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 0) ()
            inEqp :: Bool
inEqp = Benefit -> Bool
benInEqp (Benefit -> Bool) -> Benefit -> Bool
forall a b. (a -> b) -> a -> b
$ DiscoveryBenefit
discoBenefit DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid
            retRec :: CStore -> m [(ItemId, X, CStore, CStore)]
retRec toCStore :: CStore
toCStore = do
              let n :: X
n = X
oldN X -> X -> X
forall a. Num a => a -> a -> a
+ if CStore
toCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp then X
k else 0
              [(ItemId, X, CStore, CStore)]
l4 <- [(ItemId, (ItemFull, ItemQuant))]
-> X -> m [(ItemId, X, CStore, CStore)]
ret4 [(ItemId, (ItemFull, ItemQuant))]
rest X
n
              [(ItemId, X, CStore, CStore)] -> m [(ItemId, X, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ItemId, X, CStore, CStore)] -> m [(ItemId, X, CStore, CStore)])
-> [(ItemId, X, CStore, CStore)] -> m [(ItemId, X, CStore, CStore)]
forall a b. (a -> b) -> a -> b
$ (ItemId
iid, X
k, CStore
fromCStore, CStore
toCStore) (ItemId, X, CStore, CStore)
-> [(ItemId, X, CStore, CStore)] -> [(ItemId, X, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, X, CStore, CStore)]
l4
            issueWarning :: m ()
issueWarning = do
              let fullWarn :: ReqFailure
fullWarn = if Actor -> X -> Bool
eqpOverfull Actor
b (X
oldN X -> X -> X
forall a. Num a => a -> a -> a
+ 1)
                             then ReqFailure
EqpOverfull
                             else ReqFailure
EqpStackFull
              MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Warning:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
fullWarn Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
        if [CStore]
cLegalRaw [CStore] -> [CStore] -> Bool
forall a. Eq a => a -> a -> Bool
== [CStore
CGround]  -- normal pickup
        then case CStore
destCStore of  -- @CEqp@ is the implicit default; refine:
          CEqp | Bool
calmE Bool -> Bool -> Bool
&& AspectRecord -> Bool
IA.goesIntoSha (ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull) ->
            CStore -> m [(ItemId, X, CStore, CStore)]
retRec CStore
CSha
          CEqp | Bool
inEqp Bool -> Bool -> Bool
&& Actor -> X -> Bool
eqpOverfull Actor
b (X
oldN X -> X -> X
forall a. Num a => a -> a -> a
+ X
k) -> do
            -- If this stack doesn't fit, we don't equip any part of it,
            -- but we may equip a smaller stack later in the same pickup.
            m ()
issueWarning
            CStore -> m [(ItemId, X, CStore, CStore)]
retRec (CStore -> m [(ItemId, X, CStore, CStore)])
-> CStore -> m [(ItemId, X, CStore, CStore)]
forall a b. (a -> b) -> a -> b
$ if Bool
calmE then CStore
CSha else CStore
CInv
          CEqp | Bool
inEqp ->
            CStore -> m [(ItemId, X, CStore, CStore)]
retRec CStore
CEqp
          CEqp ->
            CStore -> m [(ItemId, X, CStore, CStore)]
retRec CStore
CInv
          _ ->
            CStore -> m [(ItemId, X, CStore, CStore)]
retRec CStore
destCStore
        else case CStore
destCStore of  -- player forces store, so @inEqp@ ignored
          CEqp | Actor -> X -> Bool
eqpOverfull Actor
b (X
oldN X -> X -> X
forall a. Num a => a -> a -> a
+ X
k) -> do
            -- If the chosen number from the stack doesn't fit,
            -- we don't equip any part of it and we exit item manipulation.
            m ()
issueWarning
            -- No recursive call here:
            [(ItemId, X, CStore, CStore)] -> m [(ItemId, X, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
          _ -> CStore -> m [(ItemId, X, CStore, CStore)]
retRec CStore
destCStore
  if Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& CStore
CSha CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
fromCStore, CStore
destCStore]
  then ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemNotCalm
  else do
    [(ItemId, X, CStore, CStore)]
l4 <- [(ItemId, (ItemFull, ItemQuant))]
-> X -> m [(ItemId, X, CStore, CStore)]
ret4 [(ItemId, (ItemFull, ItemQuant))]
l 0
    FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$! if [(ItemId, X, CStore, CStore)] -> Bool
forall a. [a] -> Bool
null [(ItemId, X, CStore, CStore)]
l4
              then String -> FailOrCmd RequestTimed
forall a. (?callStack::CallStack) => String -> a
error (String -> FailOrCmd RequestTimed)
-> String -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ "" String -> [(ItemId, (ItemFull, ItemQuant))] -> String
forall v. Show v => String -> v -> String
`showFailure` [(ItemId, (ItemFull, ItemQuant))]
l
              else RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ [(ItemId, X, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, X, CStore, CStore)]
l4

-- * Project

projectHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)
projectHuman :: m (FailOrCmd RequestTimed)
projectHuman = do
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  if Skill -> Skills -> X
Ability.getSk Skill
Ability.SkProject Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then  -- detailed check later
    ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ProjectUnskilled
  else do
    Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
    case Maybe (ItemId, CStore, Bool)
itemSel of
      Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) -> do
        ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
        Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
        ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
        case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
          Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to fling"
          Just _kit :: ItemQuant
_kit -> do
            ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
            let i :: (CStore, (ItemId, ItemFull))
i = (CStore
fromCStore, (ItemId
iid, ItemFull
itemFull))
            (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
projectItem (CStore, (ItemId, ItemFull))
i
      Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to fling"

projectItem :: (MonadClient m, MonadClientUI m)
            => (CStore, (ItemId, ItemFull))
            -> m (FailOrCmd RequestTimed)
projectItem :: (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
projectItem (fromCStore :: CStore
fromCStore, (iid :: ItemId
iid, itemFull :: ItemFull
itemFull)) = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
  if Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CSha then ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemNotCalm
  else do
    Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq <- m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq
    case Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq of
      Left err :: Text
err -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
      Right psuitReqFun :: ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ->
        case ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull of
          Left reqFail :: ReqFailure
reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
reqFail
          Right (pos :: Point
pos, _) -> do
            Benefit{Double
benFling :: Benefit -> Double
benFling :: Double
benFling} <- (StateClient -> Benefit) -> m Benefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Benefit) -> m Benefit)
-> (StateClient -> Benefit) -> m Benefit
forall a b. (a -> b) -> a -> b
$ (DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (DiscoveryBenefit -> Benefit)
-> (StateClient -> DiscoveryBenefit) -> StateClient -> Benefit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> DiscoveryBenefit
sdiscoBenefit
            Bool
go <- if Double
benFling Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
> 0
                  then ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
                         "The item appears beneficial. Do you really want to fling it?"
                  else Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            if Bool
go then do
              -- Set personal target to enemy, so that AI, if it takes over
              -- the actor, is likely to continue the fight even if the foe
              -- flees. Similarly if the crosshair points at position, etc.
              Maybe Target
sxhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
              (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
leader (Maybe Target -> Maybe Target -> Maybe Target
forall a b. a -> b -> a
const Maybe Target
sxhair)
              -- Project.
              X
eps <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
seps
              FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ Point -> X -> ItemId -> CStore -> RequestTimed
ReqProject Point
pos X
eps ItemId
iid CStore
fromCStore
            else do
              (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
              Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"

-- * Apply

applyHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)
applyHuman :: m (FailOrCmd RequestTimed)
applyHuman = do
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  if Skill -> Skills -> X
Ability.getSk Skill
Ability.SkApply Skills
actorSk X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then  -- detailed check later
    ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ApplyUnskilled
  else do
    Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
    case Maybe (ItemId, CStore, Bool)
itemSel of
      Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) -> do
        ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
        Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
        ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
        case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
          Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to apply"
          Just kit :: ItemQuant
kit -> do
            ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
            (CStore, (ItemId, (ItemFull, ItemQuant)))
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
(CStore, (ItemId, (ItemFull, ItemQuant)))
-> m (FailOrCmd RequestTimed)
applyItem (CStore
fromCStore, (ItemId
iid, (ItemFull
itemFull, ItemQuant
kit)))
      Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to apply"

applyItem :: MonadClientUI m
          => (CStore, (ItemId, ItemFullKit))
          -> m (FailOrCmd RequestTimed)
applyItem :: (CStore, (ItemId, (ItemFull, ItemQuant)))
-> m (FailOrCmd RequestTimed)
applyItem (fromCStore :: CStore
fromCStore, (iid :: ItemId
iid, (itemFull :: ItemFull
itemFull, kit :: ItemQuant
kit))) = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
  Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  let skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkApply Skills
actorSk
      calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
      arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
  if Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CSha
  then ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemNotCalm
  else case Time
-> X -> Bool -> ItemFull -> ItemQuant -> Either ReqFailure Bool
permittedApply Time
localTime X
skill Bool
calmE ItemFull
itemFull ItemQuant
kit of
    Left reqFail :: ReqFailure
reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
reqFail
    Right _ -> do
      Benefit{Double
benApply :: Benefit -> Double
benApply :: Double
benApply} <- (StateClient -> Benefit) -> m Benefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Benefit) -> m Benefit)
-> (StateClient -> Benefit) -> m Benefit
forall a b. (a -> b) -> a -> b
$ (DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (DiscoveryBenefit -> Benefit)
-> (StateClient -> DiscoveryBenefit) -> StateClient -> Benefit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> DiscoveryBenefit
sdiscoBenefit
      Bool
go <-
        if | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
             Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem) ->
             -- No warning if item durable, because activation weak,
             -- but price low, due to no destruction.
             ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
                          "Applying this periodic item will produce only the first of its effects and moreover, because it's not durable, will destroy it. Are you sure?"
           | Double
benApply Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
< 0 ->
             ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
                          "The item appears harmful. Do you really want to apply it?"
           | Bool
otherwise -> Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      if Bool
go
      then FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ ItemId -> CStore -> RequestTimed
ReqApply ItemId
iid CStore
fromCStore
      else do
        (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
        Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"

-- * AlterDir

-- | Ask for a direction and alter a tile in the specified way, if possible.
alterDirHuman :: MonadClientUI m
              => [TriggerTile] -> m (FailOrCmd RequestTimed)
alterDirHuman :: [TriggerTile] -> m (FailOrCmd RequestTimed)
alterDirHuman ts :: [TriggerTile]
ts = do
  UIOptions{Bool
uVi :: UIOptions -> Bool
uVi :: Bool
uVi, Bool
uLaptop :: UIOptions -> Bool
uLaptop :: Bool
uLaptop} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
  let verb1 :: Part
verb1 = case [TriggerTile]
ts of
        [] -> "alter"
        tr :: TriggerTile
tr : _ -> TriggerTile -> Part
ttverb TriggerTile
tr
      keys :: [KM]
keys = KM
K.escKM
             KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: KM
K.leftButtonReleaseKM
             KM -> [KM] -> [KM]
forall a. a -> [a] -> [a]
: (Key -> KM) -> [Key] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier) (Bool -> Bool -> [Key]
K.dirAllKey Bool
uVi Bool
uLaptop)
      prompt :: Text
prompt = [Part] -> Text
makePhrase
        ["Where to", Part
verb1 Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> "? [movement key] [pointer]"]
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 Text
prompt
  Slideshow
slides <- [KM] -> m Slideshow
forall (m :: * -> *). MonadClientUI m => [KM] -> m Slideshow
reportToSlideshow [KM
K.escKM]
  KM
km <- ColorMode -> [KM] -> Slideshow -> m KM
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
  case KM -> Key
K.key KM
km of
    K.LeftButtonRelease -> do
      ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
      Point x :: X
x y :: X
y <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
      let dir :: Vector
dir = X -> X -> Point
Point X
x (X
y X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY) Point -> Point -> Vector
`vectorToFrom` Actor -> Point
bpos Actor
b
      if Vector -> Bool
isUnit Vector
dir
      then [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)
alterTile [TriggerTile]
ts Vector
dir
      else Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
    _ ->
      case Bool -> Bool -> KM -> Maybe Vector
K.handleDir Bool
uVi Bool
uLaptop KM
km of
        Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
        Just dir :: Vector
dir -> [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)
alterTile [TriggerTile]
ts Vector
dir

-- | Try to alter a tile using a feature in the given direction.
alterTile :: MonadClientUI m
          => [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)
alterTile :: [TriggerTile] -> Vector -> m (FailOrCmd RequestTimed)
alterTile ts :: [TriggerTile]
ts dir :: Vector
dir = do
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  let tpos :: Point
tpos = Actor -> Point
bpos Actor
b Point -> Vector -> Point
`shift` Vector
dir
      pText :: Text
pText = Vector -> Text
compassText Vector
dir
  [TriggerTile] -> Point -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[TriggerTile] -> Point -> Text -> m (FailOrCmd RequestTimed)
alterTileAtPos [TriggerTile]
ts Point
tpos Text
pText

-- | Try to alter a tile using a feature at the given position.
--
-- We don't check if the tile is interesting, e.g., if any embedded
-- item can be triggered, because the player explicitely requested
-- the action. Consequently, even if all embedded items are recharching,
-- the time will be wasted and the server will describe the failure in detail.
alterTileAtPos :: MonadClientUI m
               => [TriggerTile] -> Point -> Text
               -> m (FailOrCmd RequestTimed)
alterTileAtPos :: [TriggerTile] -> Point -> Text -> m (FailOrCmd RequestTimed)
alterTileAtPos ts :: [TriggerTile]
ts tpos :: Point
tpos pText :: Text
pText = do
  cops :: COps
cops@COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile, TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
  Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
  Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel (LevelId -> m Level) -> LevelId -> m Level
forall a b. (a -> b) -> a -> b
$ Actor -> LevelId
blid Actor
b
  ItemBag
embeds <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag (Actor -> LevelId
blid Actor
b) Point
tpos
  let alterSkill :: X
alterSkill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkAlter Skills
actorSk
      t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
      alterMinSkill :: X
alterMinSkill = TileSpeedup -> ContentId TileKind -> X
Tile.alterMinSkill TileSpeedup
coTileSpeedup ContentId TileKind
t
      hasFeat :: TriggerTile -> Bool
hasFeat TriggerTile{Feature
ttfeature :: TriggerTile -> Feature
ttfeature :: Feature
ttfeature} = ContentData TileKind -> Feature -> ContentId TileKind -> Bool
Tile.hasFeature ContentData TileKind
cotile Feature
ttfeature ContentId TileKind
t
  case (TriggerTile -> Bool) -> [TriggerTile] -> [TriggerTile]
forall a. (a -> Bool) -> [a] -> [a]
filter TriggerTile -> Bool
hasFeat [TriggerTile]
ts of
    [] | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ [TriggerTile] -> Bool
forall a. [a] -> Bool
null [TriggerTile]
ts -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith (Text -> m (FailOrCmd RequestTimed))
-> Text -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ COps -> [TriggerTile] -> ContentId TileKind -> Text
guessAlter COps
cops [TriggerTile]
ts ContentId TileKind
t
    _ | Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
t)
        Bool -> Bool -> Bool
&& ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
embeds -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterNothing
    _ | Point -> Point -> X
chessDist Point
tpos (Actor -> Point
bpos Actor
b) X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> 1 -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterDistant
    _ | X
alterSkill X -> X -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterUnskilled
    _ | Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
t)
        Bool -> Bool -> Bool
&& X
alterSkill X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
alterMinSkill -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterUnwalked
    trs :: [TriggerTile]
trs ->
      if Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.notMember Point
tpos (EnumMap Point ItemBag -> Bool) -> EnumMap Point ItemBag -> Bool
forall a b. (a -> b) -> a -> b
$ Level -> EnumMap Point ItemBag
lfloor Level
lvl then
        if Bool -> Bool
not (Point -> Level -> Bool
occupiedBigLvl Point
tpos Level
lvl)
           Bool -> Bool -> Bool
&& Bool -> Bool
not (Point -> Level -> Bool
occupiedProjLvl Point
tpos Level
lvl) then do
          let v :: Part
v = case [TriggerTile]
trs of
                [] -> "alter"
                tr :: TriggerTile
tr : _ -> TriggerTile -> Part
ttverb TriggerTile
tr
          FailOrCmd ()
verAlters <- LevelId -> Point -> m (FailOrCmd ())
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Point -> m (FailOrCmd ())
verifyAlters (Actor -> LevelId
blid Actor
b) Point
tpos
          case FailOrCmd ()
verAlters of
            Right () -> do
              let msg :: Text
msg = [Part] -> Text
makeSentence ["you", Part
v, Text -> Part
MU.Text Text
pText]
              MsgClass -> Text -> m ()
forall (m :: * -> *). MonadClientUI m => MsgClass -> Text -> m ()
msgAdd MsgClass
MsgDone Text
msg
              FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ Point -> RequestTimed
ReqAlter Point
tpos
            Left err :: FailError
err -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
        else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterBlockActor
      else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterBlockItem

-- | Verify important effects, such as fleeing the dungeon.
--
-- This is contrived for now, the embedded items are not analyzed,
-- but only recognized by name.
verifyAlters :: MonadClientUI m => LevelId -> Point -> m (FailOrCmd ())
verifyAlters :: LevelId -> Point -> m (FailOrCmd ())
verifyAlters lid :: LevelId
lid p :: Point
p = do
  COps{TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lid
  let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
  ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ LevelId -> Point -> State -> ItemBag
getEmbedBag LevelId
lid Point
p
  ItemId -> ItemKind
getKind <- (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind))
-> (State -> ItemId -> ItemKind) -> m (ItemId -> ItemKind)
forall a b. (a -> b) -> a -> b
$ (ItemId -> State -> ItemKind) -> State -> ItemId -> ItemKind
forall a b c. (a -> b -> c) -> b -> a -> c
flip ItemId -> State -> ItemKind
getIidKind
  let ks :: [ItemKind]
ks = (ItemId -> ItemKind) -> [ItemId] -> [ItemKind]
forall a b. (a -> b) -> [a] -> [b]
map ItemId -> ItemKind
getKind ([ItemId] -> [ItemKind]) -> [ItemId] -> [ItemKind]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [ItemId]
forall k a. Enum k => EnumMap k a -> [k]
EM.keys ItemBag
bag
  if | (ItemKind -> Bool) -> [ItemKind] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
IK.isEffEscape ([Effect] -> Bool) -> (ItemKind -> [Effect]) -> ItemKind -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ItemKind -> [Effect]
IK.ieffects) [ItemKind]
ks -> m (FailOrCmd ())
forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ())
verifyEscape
     | [ItemKind] -> Bool
forall a. [a] -> Bool
null [ItemKind]
ks Bool -> Bool -> Bool
&& Bool -> Bool
not (TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
t) ->
         Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
     | Bool
otherwise -> FailOrCmd () -> m (FailOrCmd ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd () -> m (FailOrCmd ()))
-> FailOrCmd () -> m (FailOrCmd ())
forall a b. (a -> b) -> a -> b
$ () -> FailOrCmd ()
forall a b. b -> Either a b
Right ()

verifyEscape :: MonadClientUI m => m (FailOrCmd ())
verifyEscape :: m (FailOrCmd ())
verifyEscape = do
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  if Bool -> Bool
not (Player -> Bool
fcanEscape (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact)
  then Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith
         "This is the way out, but where would you go in this alien world?"
  else do
    (_, total :: X
total) <- (State -> (ItemBag, X)) -> m (ItemBag, X)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (ItemBag, X)) -> m (ItemBag, X))
-> (State -> (ItemBag, X)) -> m (ItemBag, X)
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> (ItemBag, X)
calculateTotal FactionId
side
    X
dungeonTotal <- (State -> X) -> m X
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> X
sgold
    let prompt :: Text
prompt | X
dungeonTotal X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
                 "You finally reached the way out. Really leave now?"
               | X
total X -> X -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
                 "Afraid of the challenge? Leaving so soon and without any treasure? Are you sure?"
               | X
total X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
dungeonTotal =
                 "You finally found the way out, but still more valuables are rumoured to hide around here. Really leave already?"
               | Bool
otherwise =
                 "This is the way out and you collected all treasure there is to find. Really leave now?"
    -- The player can back off, but we never insist,
    -- because possibly the score formula doesn't reward treasure
    -- or he is focused on winning only.
    Bool
go <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW Text
prompt
    if Bool -> Bool
not Bool
go
    then Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "here's your chance!"
    else FailOrCmd () -> m (FailOrCmd ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd () -> m (FailOrCmd ()))
-> FailOrCmd () -> m (FailOrCmd ())
forall a b. (a -> b) -> a -> b
$ () -> FailOrCmd ()
forall a b. b -> Either a b
Right ()

-- | Guess and report why the bump command failed.
guessAlter :: COps -> [TriggerTile] -> ContentId TileKind -> Text
guessAlter :: COps -> [TriggerTile] -> ContentId TileKind -> Text
guessAlter COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} (TriggerTile{ttfeature :: TriggerTile -> Feature
ttfeature=TK.OpenTo _} : _) t :: ContentId TileKind
t
  | ContentData TileKind -> ContentId TileKind -> Bool
Tile.isClosable ContentData TileKind
cotile ContentId TileKind
t = "already open"
guessAlter _ (TriggerTile{ttfeature :: TriggerTile -> Feature
ttfeature=TK.OpenTo _} : _) _ = "cannot be opened"
guessAlter COps{ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} (TriggerTile{ttfeature :: TriggerTile -> Feature
ttfeature=TK.CloseTo _} : _) t :: ContentId TileKind
t
  | ContentData TileKind -> ContentId TileKind -> Bool
Tile.isOpenable ContentData TileKind
cotile ContentId TileKind
t = "already closed"
guessAlter _ (TriggerTile{ttfeature :: TriggerTile -> Feature
ttfeature=TK.CloseTo _} : _) _ = "cannot be closed"
guessAlter _ _ _ = "never mind"

-- * AlterWithPointer

-- | Try to alter a tile using a feature under the pointer.
alterWithPointerHuman :: MonadClientUI m
                      => [TriggerTile] -> m (FailOrCmd RequestTimed)
alterWithPointerHuman :: [TriggerTile] -> m (FailOrCmd RequestTimed)
alterWithPointerHuman ts :: [TriggerTile]
ts = do
  COps{corule :: COps -> RuleContent
corule=RuleContent{X
rXmax :: RuleContent -> X
rXmax :: X
rXmax, X
rYmax :: RuleContent -> X
rYmax :: X
rYmax}, ContentData TileKind
cotile :: ContentData TileKind
cotile :: COps -> ContentData TileKind
cotile} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  LevelId
lidV <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
viewedLevelUI
  -- Not @ScreenContent@, because not drawing here.
  Level
lvl <- LevelId -> m Level
forall (m :: * -> *). MonadStateRead m => LevelId -> m Level
getLevel LevelId
lidV
  Point{..} <- (SessionUI -> Point) -> m Point
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Point
spointer
  let tpos :: Point
tpos = X -> X -> Point
Point X
px (X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY)
      t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
  if X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
     Bool -> Bool -> Bool
&& X
px X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rXmax Bool -> Bool -> Bool
&& X
py X -> X -> X
forall a. Num a => a -> a -> a
- X
mapStartY X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< X
rYmax
  then [TriggerTile] -> Point -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
[TriggerTile] -> Point -> Text -> m (FailOrCmd RequestTimed)
alterTileAtPos [TriggerTile]
ts Point
tpos (Text -> m (FailOrCmd RequestTimed))
-> Text -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ "the" Text -> Text -> Text
<+> TileKind -> Text
TK.tname (ContentData TileKind -> ContentId TileKind -> TileKind
forall a. ContentData a -> ContentId a -> a
okind ContentData TileKind
cotile ContentId TileKind
t)
  else Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"

-- * Help

-- | Display command help.
helpHuman :: MonadClientUI m
          => (HumanCmd -> m (Either MError ReqUI))
          -> m (Either MError ReqUI)
helpHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
helpHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  ccui :: CCUI
ccui@CCUI{InputContent
coinput :: CCUI -> InputContent
coinput :: InputContent
coinput, coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth, X
rheight :: X
rheight :: ScreenContent -> X
rheight}}
    <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  let keyH :: [(Text, OKX)]
keyH = COps -> CCUI -> X -> [(Text, OKX)]
keyHelp COps
cops CCUI
ccui 1
      splitHelp :: (Text, OKX) -> [OKX]
splitHelp (t :: Text
t, okx :: OKX
okx) =
        X -> X -> AttrLine -> [KM] -> OKX -> [OKX]
splitOKX X
rwidth X
rheight (Text -> AttrLine
textToAL Text
t) [KM
K.spaceKM, KM
K.escKM] OKX
okx
      sli :: Slideshow
sli = [OKX] -> Slideshow
toSlideshow ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ [[OKX]] -> [OKX]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[OKX]] -> [OKX]) -> [[OKX]] -> [OKX]
forall a b. (a -> b) -> a -> b
$ ((Text, OKX) -> [OKX]) -> [(Text, OKX)] -> [[OKX]]
forall a b. (a -> b) -> [a] -> [b]
map (Text, OKX) -> [OKX]
splitHelp [(Text, OKX)]
keyH
  -- Thus, the whole help menu corresponde to a single menu of item or lore,
  -- e.g., shared stash menu. This is especially clear when the shared stash
  -- menu contains many pages.
  Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "help" ColorMode
ColorFull Bool
True Slideshow
sli [KM
K.spaceKM, KM
K.escKM]
  case Either KM SlotChar
ekm of
    Left km :: KM
km -> case KM
km KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InputContent -> Map KM CmdTriple
bcmdMap InputContent
coinput of
      _ | KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM
K.escKM, KM
K.spaceKM] -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
      Just (_desc :: [CmdCategory]
_desc, _cats :: Text
_cats, cmd :: HumanCmd
cmd) -> HumanCmd -> m (Either MError ReqUI)
cmdAction HumanCmd
cmd
      Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
    Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm

-- * Hint

-- | Display hint or, if already displayed, display help.
hintHuman :: MonadClientUI m
          => (HumanCmd -> m (Either MError ReqUI))
          -> m (Either MError ReqUI)
hintHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
hintHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  HintMode
hintMode <- (SessionUI -> HintMode) -> m HintMode
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> HintMode
shintMode
  if HintMode
hintMode HintMode -> HintMode -> Bool
forall a. Eq a => a -> a -> Bool
== HintMode
HintWiped then
    (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
helpHuman HumanCmd -> m (Either MError ReqUI)
cmdAction
  else do
    (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {shintMode :: HintMode
shintMode = HintMode
HintShown}
    m ()
forall (m :: * -> *). MonadClientUI m => m ()
promptMainKeys
    Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing

-- * Dashboard

-- | Display the dashboard.
dashboardHuman :: MonadClientUI m
               => (HumanCmd -> m (Either MError ReqUI))
               -> m (Either MError ReqUI)
dashboardHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
dashboardHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  CCUI{InputContent
coinput :: InputContent
coinput :: CCUI -> InputContent
coinput, coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth, X
rheight :: X
rheight :: ScreenContent -> X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  let keyL :: X
keyL = 2
      (ov0 :: Overlay
ov0, kxs0 :: [KYX]
kxs0) = InputContent
-> X
-> X
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> [Text]
-> [Text]
-> OKX
okxsN InputContent
coinput 1 X
keyL (Bool -> HumanCmd -> Bool
forall a b. a -> b -> a
const Bool
False) Bool
False
                          CmdCategory
CmdDashboard [] []
      al1 :: AttrLine
al1 = Text -> AttrLine
textToAL "Dashboard"
      splitHelp :: (AttrLine, OKX) -> [OKX]
splitHelp (al :: AttrLine
al, okx :: OKX
okx) = X -> X -> AttrLine -> [KM] -> OKX -> [OKX]
splitOKX X
rwidth (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) AttrLine
al [KM
K.escKM] OKX
okx
      sli :: Slideshow
sli = [OKX] -> Slideshow
toSlideshow ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ (AttrLine, OKX) -> [OKX]
splitHelp (AttrLine
al1, (Overlay
ov0, [KYX]
kxs0))
      extraKeys :: [KM]
extraKeys = [KM
K.escKM]
  Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "dashboard" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
extraKeys
  case Either KM SlotChar
ekm of
    Left km :: KM
km -> case KM
km KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InputContent -> Map KM CmdTriple
bcmdMap InputContent
coinput of
      _ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
      Just (_desc :: [CmdCategory]
_desc, _cats :: Text
_cats, cmd :: HumanCmd
cmd) -> HumanCmd -> m (Either MError ReqUI)
cmdAction HumanCmd
cmd
      Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
    Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm

-- * ItemMenu

itemMenuHuman :: MonadClientUI m
              => (HumanCmd -> m (Either MError ReqUI))
              -> m (Either MError ReqUI)
itemMenuHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
itemMenuHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
  case Maybe (ItemId, CStore, Bool)
itemSel of
    Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) -> do
      ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
      Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
      ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
      ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
      case ItemId
iid ItemId -> ItemBag -> Maybe ItemQuant
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
        Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to open item menu for"
        Just kit :: ItemQuant
kit -> do
          CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth, X
rheight :: X
rheight :: ScreenContent -> X
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
          Skills
actorMaxSk <- (State -> Skills) -> m Skills
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Skills) -> m Skills) -> (State -> Skills) -> m Skills
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Skills
getActorMaxSkills ActorId
leader
          ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
          Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
          [(ActorId, (Actor, CStore))]
found <- (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, (Actor, CStore))])
 -> m [(ActorId, (Actor, CStore))])
-> (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall a b. (a -> b) -> a -> b
$ ActorId
-> FactionId -> ItemId -> State -> [(ActorId, (Actor, CStore))]
findIid ActorId
leader (Actor -> FactionId
bfid Actor
b) ItemId
iid
          EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
          ActorDictUI
sactorUI <- (SessionUI -> ActorDictUI) -> m ActorDictUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ActorDictUI
sactorUI
          LevelId
jlid <- (SessionUI -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> LevelId) -> m LevelId)
-> (SessionUI -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemId LevelId -> ItemId -> LevelId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (EnumMap ItemId LevelId -> LevelId)
-> (SessionUI -> EnumMap ItemId LevelId) -> SessionUI -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ItemId LevelId
sitemUI
          let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not ([(ActorId, (Actor, CStore))] -> Bool
forall a. [a] -> Bool
null [(ActorId, (Actor, CStore))]
found) Bool -> Bool -> Bool
|| CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround
                            Bool -> (ItemId, ActorId) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ItemId
iid, ActorId
leader)) ()
              fAlt :: (ActorId, (Actor, CStore)) -> Bool
fAlt (aid :: ActorId
aid, (_, store :: CStore
store)) = ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
leader Bool -> Bool -> Bool
|| CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
fromCStore
              foundAlt :: [(ActorId, (Actor, CStore))]
foundAlt = ((ActorId, (Actor, CStore)) -> Bool)
-> [(ActorId, (Actor, CStore))] -> [(ActorId, (Actor, CStore))]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, (Actor, CStore)) -> Bool
fAlt [(ActorId, (Actor, CStore))]
found
              foundUI :: [(ActorId, (Actor, CStore), ActorUI)]
foundUI = ((ActorId, (Actor, CStore)) -> (ActorId, (Actor, CStore), ActorUI))
-> [(ActorId, (Actor, CStore))]
-> [(ActorId, (Actor, CStore), ActorUI)]
forall a b. (a -> b) -> [a] -> [b]
map (\(aid :: ActorId
aid, bs :: (Actor, CStore)
bs) ->
                               (ActorId
aid, (Actor, CStore)
bs, ActorDictUI
sactorUI ActorDictUI -> ActorId -> ActorUI
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ActorId
aid)) [(ActorId, (Actor, CStore))]
foundAlt
              foundKeys :: [KM]
foundKeys = (X -> KM) -> [X] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier (Key -> KM) -> (X -> Key) -> X -> KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> Key
K.Fun)
                              [1 .. [(ActorId, (Actor, CStore), ActorUI)] -> X
forall a. [a] -> X
length [(ActorId, (Actor, CStore), ActorUI)]
foundUI]  -- starting from 1!
              ppLoc :: ActorUI -> CStore -> String
ppLoc bUI2 :: ActorUI
bUI2 store :: CStore
store =
                let phr :: Text
phr = [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$ Bool -> CStore -> Part -> [Part]
ppCStoreWownW Bool
False CStore
store
                                     (Part -> [Part]) -> Part -> [Part]
forall a b. (a -> b) -> a -> b
$ ActorUI -> Part
partActor ActorUI
bUI2
                in "[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack Text
phr String -> String -> String
forall a. [a] -> [a] -> [a]
++ "]"
              foundTexts :: [String]
foundTexts = ((ActorId, (Actor, CStore), ActorUI) -> String)
-> [(ActorId, (Actor, CStore), ActorUI)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, (_, store :: CStore
store), bUI2 :: ActorUI
bUI2) ->
                                  ActorUI -> CStore -> String
ppLoc ActorUI
bUI2 CStore
store) [(ActorId, (Actor, CStore), ActorUI)]
foundUI
              foundPrefix :: AttrLine
foundPrefix = Text -> AttrLine
textToAL (Text -> AttrLine) -> Text -> AttrLine
forall a b. (a -> b) -> a -> b
$
                if [String] -> Bool
forall a. [a] -> Bool
null [String]
foundTexts then "" else "The item is also in:"
              markParagraphs :: Bool
markParagraphs = X
rheight X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= 45
              desc :: AttrLine
desc = Bool
-> FactionId
-> EnumMap FactionId Faction
-> X
-> CStore
-> Time
-> LevelId
-> ItemFull
-> ItemQuant
-> AttrLine
itemDesc Bool
markParagraphs (Actor -> FactionId
bfid Actor
b) EnumMap FactionId Faction
factionD
                              (Skill -> Skills -> X
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorMaxSk)
                              CStore
fromCStore Time
localTime LevelId
jlid ItemFull
itemFull ItemQuant
kit
              alPrefix :: Overlay
alPrefix = X -> AttrLine -> Overlay
splitAttrLine X
rwidth (AttrLine -> Overlay) -> AttrLine -> Overlay
forall a b. (a -> b) -> a -> b
$ AttrLine
desc AttrLine -> AttrLine -> AttrLine
<+:> AttrLine
foundPrefix
              ystart :: X
ystart = Overlay -> X
forall a. [a] -> X
length Overlay
alPrefix X -> X -> X
forall a. Num a => a -> a -> a
- 1
              xstart :: X
xstart = AttrLine -> X
forall a. [a] -> X
length (Overlay -> AttrLine
forall a. [a] -> a
last Overlay
alPrefix) X -> X -> X
forall a. Num a => a -> a -> a
+ 1
              ks :: [(KM, String)]
ks = [KM] -> [String] -> [(KM, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [KM]
foundKeys ([String] -> [(KM, String)]) -> [String] -> [(KM, String)]
forall a b. (a -> b) -> a -> b
$ ((ActorId, (Actor, CStore), ActorUI) -> String)
-> [(ActorId, (Actor, CStore), ActorUI)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (\(_, (_, store :: CStore
store), bUI2 :: ActorUI
bUI2) ->
                                          ActorUI -> CStore -> String
ppLoc ActorUI
bUI2 CStore
store) [(ActorId, (Actor, CStore), ActorUI)]
foundUI
              (ovFoundRaw :: Overlay
ovFoundRaw, kxsFound :: [KYX]
kxsFound) = X -> X -> X -> [(KM, String)] -> OKX
wrapOKX X
ystart X
xstart X
rwidth [(KM, String)]
ks
              ovFound :: Overlay
ovFound = Overlay -> Overlay -> Overlay
glueLines Overlay
alPrefix Overlay
ovFoundRaw
          Report
report <- m Report
forall (m :: * -> *). MonadClientUI m => m Report
getReportUI
          CCUI{InputContent
coinput :: InputContent
coinput :: CCUI -> InputContent
coinput} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
          Skills
actorSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
          let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorMaxSk
              greyedOut :: HumanCmd -> Bool
greyedOut cmd :: HumanCmd
cmd = Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CSha Bool -> Bool -> Bool
|| case HumanCmd
cmd of
                ByAimMode AimModeCmd{..} ->
                  HumanCmd -> Bool
greyedOut HumanCmd
exploration Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
aiming
                ComposeIfLocal cmd1 :: HumanCmd
cmd1 cmd2 :: HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
                ComposeUnlessError cmd1 :: HumanCmd
cmd1 cmd2 :: HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
                Compose2ndLocal cmd1 :: HumanCmd
cmd1 cmd2 :: HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
                MoveItem stores :: [CStore]
stores destCStore :: CStore
destCStore _ _ ->
                  CStore
fromCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore]
stores
                  Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& CStore
CSha CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
destCStore
                  Bool -> Bool -> Bool
|| CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Actor -> X -> Bool
eqpOverfull Actor
b 1
                Apply{} ->
                  let skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkApply Skills
actorSk
                  in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id
                     (Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Time
-> X -> Bool -> ItemFull -> ItemQuant -> Either ReqFailure Bool
permittedApply Time
localTime X
skill Bool
calmE ItemFull
itemFull ItemQuant
kit
                Project{} ->
                  let skill :: X
skill = Skill -> Skills -> X
Ability.getSk Skill
Ability.SkProject Skills
actorSk
                  in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id
                     (Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> X -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
False X
skill Bool
calmE ItemFull
itemFull
                _ -> Bool
False
              fmt :: X -> Text -> Text -> Text
fmt n :: X
n k :: Text
k h :: Text
h = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Char -> Text -> Text
T.justifyLeft X
n ' ' Text
k Text -> Text -> Text
<+> Text
h
              keyL :: X
keyL = 11
              keyCaption :: Text
keyCaption = X -> Text -> Text -> Text
fmt X
keyL "keys" "command"
              offset :: X
offset = 1 X -> X -> X
forall a. Num a => a -> a -> a
+ Overlay -> X
forall a. [a] -> X
length Overlay
ovFound
              (ov0 :: Overlay
ov0, kxs0 :: [KYX]
kxs0) = InputContent
-> X
-> X
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> [Text]
-> [Text]
-> OKX
okxsN InputContent
coinput X
offset X
keyL HumanCmd -> Bool
greyedOut Bool
True
                                  CmdCategory
CmdItemMenu [Text
keyCaption] []
              t0 :: Text
t0 = [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) "choose"
                                , "an item", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
fromCStore ]
              al1 :: AttrLine
al1 = Report -> AttrLine
renderReport Report
report AttrLine -> AttrLine -> AttrLine
<+:> Text -> AttrLine
textToAL Text
t0
              splitHelp :: (AttrLine, OKX) -> [OKX]
splitHelp (al :: AttrLine
al, okx :: OKX
okx) =
                X -> X -> AttrLine -> [KM] -> OKX -> [OKX]
splitOKX X
rwidth (X
rheight X -> X -> X
forall a. Num a => a -> a -> a
- 2) AttrLine
al [KM
K.spaceKM, KM
K.escKM] OKX
okx
              sli :: Slideshow
sli = [OKX] -> Slideshow
toSlideshow
                    ([OKX] -> Slideshow) -> [OKX] -> Slideshow
forall a b. (a -> b) -> a -> b
$ (AttrLine, OKX) -> [OKX]
splitHelp (AttrLine
al1, (Overlay
ovFound Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
ov0, [KYX]
kxsFound [KYX] -> [KYX] -> [KYX]
forall a. [a] -> [a] -> [a]
++ [KYX]
kxs0))
              extraKeys :: [KM]
extraKeys = [KM
K.spaceKM, KM
K.escKM] [KM] -> [KM] -> [KM]
forall a. [a] -> [a] -> [a]
++ [KM]
foundKeys
          m ()
forall (m :: * -> *). MonadClientUI m => m ()
recordHistory  -- report shown (e.g., leader switch), save to history
          Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "item menu" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
extraKeys
          case Either KM SlotChar
ekm of
            Left km :: KM
km -> case KM
km KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InputContent -> Map KM CmdTriple
bcmdMap InputContent
coinput of
              _ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
              _ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
              _ | KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
foundKeys -> case KM
km of
                K.KM{key :: KM -> Key
key=K.Fun n :: X
n} -> do
                  let (newAid :: ActorId
newAid, (bNew :: Actor
bNew, newCStore :: CStore
newCStore)) = [(ActorId, (Actor, CStore))]
foundAlt [(ActorId, (Actor, CStore))] -> X -> (ActorId, (Actor, CStore))
forall a. [a] -> X -> a
!! (X
n X -> X -> X
forall a. Num a => a -> a -> a
- 1)
                  Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
bNew) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
                  let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
                  if | Actor -> LevelId
blid Actor
bNew LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b Bool -> Bool -> Bool
&& Bool
autoDun ->
                       FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReqFailure -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
NoChangeDunLeader
                     | Bool
otherwise -> do
                       m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *). MonadClientUI m => Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
newAid
                       (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
                         SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
newCStore, Bool
False)}
                       (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
itemMenuHuman HumanCmd -> m (Either MError ReqUI)
cmdAction
                _ -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
              Just (_desc :: [CmdCategory]
_desc, _cats :: Text
_cats, cmd :: HumanCmd
cmd) -> do
                (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
                  SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
True)}
                Either MError ReqUI
res <- HumanCmd -> m (Either MError ReqUI)
cmdAction HumanCmd
cmd
                (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
                  SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
                Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
res
              Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
            Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm
    Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to open item menu for"

-- * ChooseItemMenu

chooseItemMenuHuman :: MonadClientUI m
                    => (HumanCmd -> m (Either MError ReqUI))
                    -> ItemDialogMode
                    -> m (Either MError ReqUI)
chooseItemMenuHuman :: (HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode -> m (Either MError ReqUI)
chooseItemMenuHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction c :: ItemDialogMode
c = do
  FailOrCmd ItemDialogMode
res <- ItemDialogMode -> m (FailOrCmd ItemDialogMode)
forall (m :: * -> *).
MonadClientUI m =>
ItemDialogMode -> m (FailOrCmd ItemDialogMode)
chooseItemDialogMode ItemDialogMode
c
  case FailOrCmd ItemDialogMode
res of
    Right c2 :: ItemDialogMode
c2 -> do
      Either MError ReqUI
res2 <- (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
itemMenuHuman HumanCmd -> m (Either MError ReqUI)
cmdAction
      case Either MError ReqUI
res2 of
        Left Nothing -> (HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode -> m (Either MError ReqUI)
chooseItemMenuHuman HumanCmd -> m (Either MError ReqUI)
cmdAction ItemDialogMode
c2
        _ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
res2
    Left err :: FailError
err -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
forall a b. (a -> b) -> a -> b
$ FailError -> MError
forall a. a -> Maybe a
Just FailError
err

-- * MainMenu

artAtSize :: MonadClientUI m => m [Text]
artAtSize :: m [Text]
artAtSize = do
  CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{X
rwidth :: X
rwidth :: ScreenContent -> X
rwidth, X
rheight :: X
rheight :: ScreenContent -> X
rheight, Text
rmainMenuArt :: ScreenContent -> Text
rmainMenuArt :: Text
rmainMenuArt}} <-
    (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  let tlines :: [Text]
tlines = Text -> [Text]
T.lines Text
rmainMenuArt
      xoffset :: X
xoffset = (80 X -> X -> X
forall a. Num a => a -> a -> a
- X
rwidth) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
      yoffset :: X
yoffset = ([Text] -> X
forall a. [a] -> X
length [Text]
tlines X -> X -> X
forall a. Num a => a -> a -> a
- X
rheight) X -> X -> X
forall a. Integral a => a -> a -> a
`div` 2
      f :: Text -> Text
f = X -> Text -> Text
T.take X
rwidth (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. X -> Text -> Text
T.drop X
xoffset
  [Text] -> m [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> m [Text]) -> [Text] -> m [Text]
forall a b. (a -> b) -> a -> b
$! (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
f ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ X -> [Text] -> [Text]
forall a. X -> [a] -> [a]
take X
rheight ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ X -> [Text] -> [Text]
forall a. X -> [a] -> [a]
drop X
yoffset [Text]
tlines

-- We detect the place for the version string by searching for 'Version'
-- in the last line of the picture. If it doesn't fit, we shift, if everything
-- else fails, only then we crop. We don't assume any line length.
artWithVersion :: MonadClientUI m => m [String]
artWithVersion :: m [String]
artWithVersion = do
  COps{RuleContent
corule :: RuleContent
corule :: COps -> RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  let pasteVersion :: [Text] -> [String]
      pasteVersion :: [Text] -> [String]
pasteVersion art :: [Text]
art =
        let exeVersion :: Version
exeVersion = RuleContent -> Version
rexeVersion RuleContent
corule
            libVersion :: Version
libVersion = Version
Self.version
            version :: String
version = " Version " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
exeVersion
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ " (frontend: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
frontendName
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ ", engine: LambdaHack " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion Version
libVersion
                      String -> String -> String
forall a. [a] -> [a] -> [a]
++ ") "
            versionLen :: X
versionLen = String -> X
forall a. [a] -> X
length String
version
            f :: Text -> String
f line :: Text
line =
              let (prefix :: Text
prefix, versionSuffix :: Text
versionSuffix) = Text -> Text -> (Text, Text)
T.breakOn "Version" Text
line
              in if Text -> Bool
T.null Text
versionSuffix then Text -> String
T.unpack Text
line else
                let suffix :: String
suffix = X -> String -> String
forall a. X -> [a] -> [a]
drop X
versionLen (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
versionSuffix
                    overfillLen :: X
overfillLen = X
versionLen X -> X -> X
forall a. Num a => a -> a -> a
- Text -> X
T.length Text
versionSuffix
                    prefixModified :: String
prefixModified = Text -> String
T.unpack (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ X -> Text -> Text
T.dropEnd X
overfillLen Text
prefix
                in String
prefixModified String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
version String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
suffix
        in (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
f [Text]
art
  [Text]
mainMenuArt <- m [Text]
forall (m :: * -> *). MonadClientUI m => m [Text]
artAtSize
  [String] -> m [String]
forall (m :: * -> *) a. Monad m => a -> m a
return ([String] -> m [String]) -> [String] -> m [String]
forall a b. (a -> b) -> a -> b
$! [Text] -> [String]
pasteVersion [Text]
mainMenuArt

generateMenu :: MonadClientUI m
             => (HumanCmd -> m (Either MError ReqUI))
             -> [(K.KM, (Text, HumanCmd))] -> [String] -> String
             -> m (Either MError ReqUI)
generateMenu :: (HumanCmd -> m (Either MError ReqUI))
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction kds :: [(KM, (Text, HumanCmd))]
kds gameInfo :: [String]
gameInfo menuName :: String
menuName = do
  [String]
art <- m [String]
forall (m :: * -> *). MonadClientUI m => m [String]
artWithVersion
  let bindingLen :: X
bindingLen = 35
      emptyInfo :: [String]
emptyInfo = String -> [String]
forall a. a -> [a]
repeat (String -> [String]) -> String -> [String]
forall a b. (a -> b) -> a -> b
$ X -> Char -> String
forall a. X -> a -> [a]
replicate X
bindingLen ' '
      bindings :: [(Maybe KM, String)]
bindings =  -- key bindings to display
        let fmt :: (KM, (Text, HumanCmd)) -> (Maybe KM, String)
fmt (k :: KM
k, (d :: Text
d, _)) =
              ( KM -> Maybe KM
forall a. a -> Maybe a
Just KM
k
              , Text -> String
T.unpack
                (Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' '
                    (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> X -> Char -> Text -> Text
T.justifyLeft 4 ' ' (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KM -> String
K.showKM KM
k)
                      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d )
        in ((KM, (Text, HumanCmd)) -> (Maybe KM, String))
-> [(KM, (Text, HumanCmd))] -> [(Maybe KM, String)]
forall a b. (a -> b) -> [a] -> [b]
map (KM, (Text, HumanCmd)) -> (Maybe KM, String)
fmt [(KM, (Text, HumanCmd))]
kds
      overwrite :: [(Int, String)] -> [(String, Maybe KYX)]
      overwrite :: [(X, String)] -> [(String, Maybe KYX)]
overwrite =  -- overwrite the art with key bindings and other lines
        let over :: [(Maybe KM, String)]
-> (X, String) -> ([(Maybe KM, String)], (String, Maybe KYX))
over [] (_, line :: String
line) = ([], (String
line, Maybe KYX
forall a. Maybe a
Nothing))
            over bs :: [(Maybe KM, String)]
bs@((mkey :: Maybe KM
mkey, binding :: String
binding) : bsRest :: [(Maybe KM, String)]
bsRest) (y :: X
y, line :: String
line) =
              let (prefix :: String
prefix, lineRest :: String
lineRest) = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='{') String
line
                  (braces :: String
braces, suffix :: String
suffix)   = (Char -> Bool) -> String -> (String, String)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span  (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
=='{') String
lineRest
              in if String -> X
forall a. [a] -> X
length String
braces X -> X -> Bool
forall a. Ord a => a -> a -> Bool
>= X
bindingLen
                 then
                   let lenB :: X
lenB = String -> X
forall a. [a] -> X
length String
binding
                       post :: String
post = X -> String -> String
forall a. X -> [a] -> [a]
drop (X
lenB X -> X -> X
forall a. Num a => a -> a -> a
- String -> X
forall a. [a] -> X
length String
braces) String
suffix
                       len :: X
len = String -> X
forall a. [a] -> X
length String
prefix
                       yxx :: KM -> KYX
yxx key :: KM
key = ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
key], (X
y, X
len, X
len X -> X -> X
forall a. Num a => a -> a -> a
+ X
lenB))
                       myxx :: Maybe KYX
myxx = KM -> KYX
yxx (KM -> KYX) -> Maybe KM -> Maybe KYX
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe KM
mkey
                   in ([(Maybe KM, String)]
bsRest, (String
prefix String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
binding String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
post, Maybe KYX
myxx))
                 else ([(Maybe KM, String)]
bs, (String
line, Maybe KYX
forall a. Maybe a
Nothing))
        in ([(Maybe KM, String)], [(String, Maybe KYX)])
-> [(String, Maybe KYX)]
forall a b. (a, b) -> b
snd (([(Maybe KM, String)], [(String, Maybe KYX)])
 -> [(String, Maybe KYX)])
-> ([(X, String)] -> ([(Maybe KM, String)], [(String, Maybe KYX)]))
-> [(X, String)]
-> [(String, Maybe KYX)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([(Maybe KM, String)]
 -> (X, String) -> ([(Maybe KM, String)], (String, Maybe KYX)))
-> [(Maybe KM, String)]
-> [(X, String)]
-> ([(Maybe KM, String)], [(String, Maybe KYX)])
forall (t :: * -> *) a b c.
Traversable t =>
(a -> b -> (a, c)) -> a -> t b -> (a, t c)
mapAccumL [(Maybe KM, String)]
-> (X, String) -> ([(Maybe KM, String)], (String, Maybe KYX))
over ([Maybe KM] -> [String] -> [(Maybe KM, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe KM -> [Maybe KM]
forall a. a -> [a]
repeat Maybe KM
forall a. Maybe a
Nothing) [String]
gameInfo
                                 [(Maybe KM, String)]
-> [(Maybe KM, String)] -> [(Maybe KM, String)]
forall a. [a] -> [a] -> [a]
++ [(Maybe KM, String)]
bindings
                                 [(Maybe KM, String)]
-> [(Maybe KM, String)] -> [(Maybe KM, String)]
forall a. [a] -> [a] -> [a]
++ [Maybe KM] -> [String] -> [(Maybe KM, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe KM -> [Maybe KM]
forall a. a -> [a]
repeat Maybe KM
forall a. Maybe a
Nothing) [String]
emptyInfo)
      menuOverwritten :: [(String, Maybe KYX)]
menuOverwritten = [(X, String)] -> [(String, Maybe KYX)]
overwrite ([(X, String)] -> [(String, Maybe KYX)])
-> [(X, String)] -> [(String, Maybe KYX)]
forall a b. (a -> b) -> a -> b
$ [X] -> [String] -> [(X, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [0..] [String]
art
      (menuOvLines :: [String]
menuOvLines, mkyxs :: [Maybe KYX]
mkyxs) = [(String, Maybe KYX)] -> ([String], [Maybe KYX])
forall a b. [(a, b)] -> ([a], [b])
unzip [(String, Maybe KYX)]
menuOverwritten
      kyxs :: [KYX]
kyxs = [Maybe KYX] -> [KYX]
forall a. [Maybe a] -> [a]
catMaybes [Maybe KYX]
mkyxs
      ov :: Overlay
ov = (String -> AttrLine) -> [String] -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map String -> AttrLine
stringToAL [String]
menuOvLines
  Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
MonadClientUI m =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen String
menuName ColorMode
ColorFull Bool
True
                                      (OKX -> Slideshow
menuToSlideshow (Overlay
ov, [KYX]
kyxs)) [KM
K.escKM]
  case Either KM SlotChar
ekm of
    Left km :: KM
km -> case KM
km KM -> [(KM, (Text, HumanCmd))] -> Maybe (Text, HumanCmd)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KM, (Text, HumanCmd))]
kds of
      Just (_desc :: Text
_desc, cmd :: HumanCmd
cmd) -> HumanCmd -> m (Either MError ReqUI)
cmdAction HumanCmd
cmd
      Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
    Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm

-- | Display the main menu.
mainMenuHuman :: MonadClientUI m
              => (HumanCmd -> m (Either MError ReqUI))
              -> m (Either MError ReqUI)
mainMenuHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
mainMenuHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  CCUI{coinput :: CCUI -> InputContent
coinput=InputContent{[(KM, CmdTriple)]
bcmdList :: InputContent -> [(KM, CmdTriple)]
bcmdList :: [(KM, CmdTriple)]
bcmdList}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
  ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
  X
snxtScenario <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
snxtScenario
  let nxtGameName :: Text
nxtGameName = ModeKind -> Text
mname (ModeKind -> Text) -> ModeKind -> Text
forall a b. (a -> b) -> a -> b
$ COps -> X -> ModeKind
nxtGameMode COps
cops X
snxtScenario
      tnextScenario :: Text
tnextScenario = "pick next:" Text -> Text -> Text
<+> Text
nxtGameName
      -- Key-description-command tuples.
      kds :: [(KM, (Text, HumanCmd))]
kds = (String -> KM
K.mkKM "p", (Text
tnextScenario, HumanCmd
GameScenarioIncr))
            (KM, (Text, HumanCmd))
-> [(KM, (Text, HumanCmd))] -> [(KM, (Text, HumanCmd))]
forall a. a -> [a] -> [a]
: [ (KM
km, (Text
desc, HumanCmd
cmd))
              | (km :: KM
km, ([CmdMainMenu], desc :: Text
desc, cmd :: HumanCmd
cmd)) <- [(KM, CmdTriple)]
bcmdList ]
      bindingLen :: X
bindingLen = 35
      gameName :: Text
gameName = ModeKind -> Text
mname ModeKind
gameMode
      gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
                   [ X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' ""
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' '
                     (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ " Now playing:" Text -> Text -> Text
<+> Text
gameName
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' "" ]
  (HumanCmd -> m (Either MError ReqUI))
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI))
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu HumanCmd -> m (Either MError ReqUI)
cmdAction [(KM, (Text, HumanCmd))]
kds [String]
gameInfo "main"

-- * MainMenuAutoOn

-- | Display the main menu and set @swasAutomated@.
mainMenuAutoOnHuman :: MonadClientUI m
                    => (HumanCmd -> m (Either MError ReqUI))
                    -> m (Either MError ReqUI)
mainMenuAutoOnHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
mainMenuAutoOnHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {swasAutomated :: Bool
swasAutomated = Bool
True}
  (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
mainMenuHuman HumanCmd -> m (Either MError ReqUI)
cmdAction

-- * MainMenuAutoOff

-- | Display the main menu and unset @swasAutomated@.
mainMenuAutoOffHuman :: MonadClientUI m
                     => (HumanCmd -> m (Either MError ReqUI))
                     -> m (Either MError ReqUI)
mainMenuAutoOffHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
mainMenuAutoOffHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {swasAutomated :: Bool
swasAutomated = Bool
False}
  (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
mainMenuHuman HumanCmd -> m (Either MError ReqUI)
cmdAction

-- * SettingsMenu

-- | Display the settings menu.
settingsMenuHuman :: MonadClientUI m
                  => (HumanCmd -> m (Either MError ReqUI))
                  -> m (Either MError ReqUI)
settingsMenuHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
settingsMenuHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  X
markSuspect <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
smarkSuspect
  Bool
markVision <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smarkVision
  Bool
markSmell <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smarkSmell
  FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Tactic
factTactic <- (State -> Tactic) -> m Tactic
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Tactic) -> m Tactic) -> (State -> Tactic) -> m Tactic
forall a b. (a -> b) -> a -> b
$ Player -> Tactic
ftactic (Player -> Tactic) -> (State -> Player) -> State -> Tactic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player) -> (State -> Faction) -> State -> Player
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let offOn :: Bool -> p
offOn b :: Bool
b = if Bool
b then "on" else "off"
      offOnAll :: v -> p
offOnAll n :: v
n = case v
n of
        0 -> "none"
        1 -> "untried"
        2 -> "all"
        _ -> String -> p
forall a. (?callStack::CallStack) => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ "" String -> v -> String
forall v. Show v => String -> v -> String
`showFailure` v
n
      tsuspect :: Text
tsuspect = "mark suspect terrain:" Text -> Text -> Text
<+> X -> Text
forall v p. (Eq v, Num v, IsString p, Show v) => v -> p
offOnAll X
markSuspect
      tvisible :: Text
tvisible = "show visible zone:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn Bool
markVision
      tsmell :: Text
tsmell = "display smell clues:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn Bool
markSmell
      thenchmen :: Text
thenchmen = "henchmen tactic:" Text -> Text -> Text
<+> Tactic -> Text
Ability.nameTactic Tactic
factTactic
      -- Key-description-command tuples.
      kds :: [(KM, (Text, HumanCmd))]
kds = [ (String -> KM
K.mkKM "s", (Text
tsuspect, HumanCmd
MarkSuspect))
            , (String -> KM
K.mkKM "v", (Text
tvisible, HumanCmd
MarkVision))
            , (String -> KM
K.mkKM "c", (Text
tsmell, HumanCmd
MarkSmell))
            , (String -> KM
K.mkKM "t", (Text
thenchmen, HumanCmd
Tactic))
            , (String -> KM
K.mkKM "Escape", ("back to main menu", HumanCmd
MainMenu)) ]
      bindingLen :: X
bindingLen = 35
      gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
                   [ X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' ""
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' " Convenience settings:"
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' "" ]
  (HumanCmd -> m (Either MError ReqUI))
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI))
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu HumanCmd -> m (Either MError ReqUI)
cmdAction [(KM, (Text, HumanCmd))]
kds [String]
gameInfo "settings"

-- * ChallengesMenu

-- | Display the challenges menu.
challengesMenuHuman :: MonadClientUI m
                    => (HumanCmd -> m (Either MError ReqUI))
                    -> m (Either MError ReqUI)
challengesMenuHuman :: (HumanCmd -> m (Either MError ReqUI)) -> m (Either MError ReqUI)
challengesMenuHuman cmdAction :: HumanCmd -> m (Either MError ReqUI)
cmdAction = do
  Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
  Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
  let offOn :: Bool -> p
offOn b :: Bool
b = if Bool
b then "on" else "off"
      tcurDiff :: Text
tcurDiff = " *   difficulty:" Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow (Challenge -> X
cdiff Challenge
curChal)
      tnextDiff :: Text
tnextDiff = "difficulty (lower easier):" Text -> Text -> Text
<+> X -> Text
forall a. Show a => a -> Text
tshow (Challenge -> X
cdiff Challenge
nxtChal)
      tcurWolf :: Text
tcurWolf = " *   lone wolf:"
                 Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cwolf Challenge
curChal)
      tnextWolf :: Text
tnextWolf = "lone wolf (very hard):"
                  Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cwolf Challenge
nxtChal)
      tcurFish :: Text
tcurFish = " *   cold fish:"
                 Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cfish Challenge
curChal)
      tnextFish :: Text
tnextFish = "cold fish (hard):"
                  Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cfish Challenge
nxtChal)
      -- Key-description-command tuples.
      kds :: [(KM, (Text, HumanCmd))]
kds = [ (String -> KM
K.mkKM "d", (Text
tnextDiff, HumanCmd
GameDifficultyIncr))
            , (String -> KM
K.mkKM "w", (Text
tnextWolf, HumanCmd
GameWolfToggle))
            , (String -> KM
K.mkKM "f", (Text
tnextFish, HumanCmd
GameFishToggle))
            , (String -> KM
K.mkKM "Escape", ("back to main menu", HumanCmd
MainMenu)) ]
      bindingLen :: X
bindingLen = 35
      gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
                   [ X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' " Current challenges:"
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' ""
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' Text
tcurDiff
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' Text
tcurWolf
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' Text
tcurFish
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' ""
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' " Next game challenges:"
                   , X -> Char -> Text -> Text
T.justifyLeft X
bindingLen ' ' "" ]
  (HumanCmd -> m (Either MError ReqUI))
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(HumanCmd -> m (Either MError ReqUI))
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu HumanCmd -> m (Either MError ReqUI)
cmdAction [(KM, (Text, HumanCmd))]
kds [String]
gameInfo "challenge"

-- * GameScenarioIncr

gameScenarioIncr :: MonadClient m => m ()
gameScenarioIncr :: m ()
gameScenarioIncr =
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {snxtScenario :: X
snxtScenario = StateClient -> X
snxtScenario StateClient
cli X -> X -> X
forall a. Num a => a -> a -> a
+ 1}

-- * GameDifficultyIncr

gameDifficultyIncr :: MonadClient m => m ()
gameDifficultyIncr :: m ()
gameDifficultyIncr = do
  X
nxtDiff <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> X) -> m X) -> (StateClient -> X) -> m X
forall a b. (a -> b) -> a -> b
$ Challenge -> X
cdiff (Challenge -> X) -> (StateClient -> Challenge) -> StateClient -> X
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> Challenge
snxtChal
  let delta :: X
delta = -1
      d :: X
d | X
nxtDiff X -> X -> X
forall a. Num a => a -> a -> a
+ X
delta X -> X -> Bool
forall a. Ord a => a -> a -> Bool
> X
difficultyBound = 1
        | X
nxtDiff X -> X -> X
forall a. Num a => a -> a -> a
+ X
delta X -> X -> Bool
forall a. Ord a => a -> a -> Bool
< 1 = X
difficultyBound
        | Bool
otherwise = X
nxtDiff X -> X -> X
forall a. Num a => a -> a -> a
+ X
delta
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli -> StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {cdiff :: X
cdiff = X
d} }

-- * GameWolfToggle

gameWolfToggle :: MonadClient m => m ()
gameWolfToggle :: m ()
gameWolfToggle =
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli ->
    StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {cwolf :: Bool
cwolf = Bool -> Bool
not (Challenge -> Bool
cwolf (StateClient -> Challenge
snxtChal StateClient
cli))} }

-- * GameFishToggle

gameFishToggle :: MonadClient m => m ()
gameFishToggle :: m ()
gameFishToggle =
  (StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \cli :: StateClient
cli ->
    StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {cfish :: Bool
cfish = Bool -> Bool
not (Challenge -> Bool
cfish (StateClient -> Challenge
snxtChal StateClient
cli))} }

-- * GameRestart

gameRestartHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
gameRestartHuman :: m (FailOrCmd ReqUI)
gameRestartHuman = do
  COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
  Bool
isNoConfirms <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
  ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
  X
snxtScenario <- (StateClient -> X) -> m X
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> X
snxtScenario
  let nxtGameName :: Text
nxtGameName = ModeKind -> Text
mname (ModeKind -> Text) -> ModeKind -> Text
forall a b. (a -> b) -> a -> b
$ COps -> X -> ModeKind
nxtGameMode COps
cops X
snxtScenario
  Bool
b <- if Bool
isNoConfirms
       then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       else ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
            (Text -> m Bool) -> Text -> m Bool
forall a b. (a -> b) -> a -> b
$ "You just requested a new" Text -> Text -> Text
<+> Text
nxtGameName
              Text -> Text -> Text
<+> "game. The progress of the ongoing" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode
              Text -> Text -> Text
<+> "game will be lost! Are you sure?"
  if Bool
b
  then do
    Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
    -- This ignores all but the first word of game mode names picked
    -- via main menu and assumes the fist word of such game modes
    -- is present in their frequencies.
    let nxtGameGroup :: GroupName ModeKind
nxtGameGroup = Text -> GroupName ModeKind
forall a. Text -> GroupName a
toGroupName (Text -> GroupName ModeKind) -> Text -> GroupName ModeKind
forall a b. (a -> b) -> a -> b
$ [Text] -> Text
forall a. [a] -> a
head ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
nxtGameName
    FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd ReqUI -> m (FailOrCmd ReqUI))
-> FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall a b. (a -> b) -> a -> b
$ ReqUI -> FailOrCmd ReqUI
forall a b. b -> Either a b
Right (ReqUI -> FailOrCmd ReqUI) -> ReqUI -> FailOrCmd ReqUI
forall a b. (a -> b) -> a -> b
$ GroupName ModeKind -> Challenge -> ReqUI
ReqUIGameRestart GroupName ModeKind
nxtGameGroup Challenge
snxtChal
  else do
    Text
msg2 <- Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientRead m => Rnd a -> m a
rndToActionForget (Rnd Text -> m Text) -> Rnd Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
              [ "yea, would be a pity to leave them to die"
              , "yea, a shame to get your team stranded" ]
    Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
msg2

nxtGameMode :: COps -> Int -> ModeKind
nxtGameMode :: COps -> X -> ModeKind
nxtGameMode COps{ContentData ModeKind
comode :: COps -> ContentData ModeKind
comode :: ContentData ModeKind
comode} snxtScenario :: X
snxtScenario =
  let f :: [a] -> p -> p -> a -> [a]
f ![a]
acc _p :: p
_p _i :: p
_i !a
a = a
a a -> [a] -> [a]
forall a. a -> [a] -> [a]
: [a]
acc
      campaignModes :: [ModeKind]
campaignModes = ContentData ModeKind
-> GroupName ModeKind
-> ([ModeKind]
    -> X -> ContentId ModeKind -> ModeKind -> [ModeKind])
-> [ModeKind]
-> [ModeKind]
forall a b.
ContentData a
-> GroupName a -> (b -> X -> ContentId a -> a -> b) -> b -> b
ofoldlGroup' ContentData ModeKind
comode "campaign scenario" [ModeKind] -> X -> ContentId ModeKind -> ModeKind -> [ModeKind]
forall a p p. [a] -> p -> p -> a -> [a]
f []
  in [ModeKind]
campaignModes [ModeKind] -> X -> ModeKind
forall a. [a] -> X -> a
!! (X
snxtScenario X -> X -> X
forall a. Integral a => a -> a -> a
`mod` [ModeKind] -> X
forall a. [a] -> X
length [ModeKind]
campaignModes)

-- * GameQuit

-- TODO: deduplicate with gameRestartHuman
gameQuitHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
gameQuitHuman :: m (FailOrCmd ReqUI)
gameQuitHuman = do
  Bool
isNoConfirms <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
  ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
  Bool
b <- if Bool
isNoConfirms
       then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
       else ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
            (Text -> m Bool) -> Text -> m Bool
forall a b. (a -> b) -> a -> b
$ "If you quit, the progress of the ongoing" Text -> Text -> Text
<+> ModeKind -> Text
mname ModeKind
gameMode
              Text -> Text -> Text
<+> "game will be lost! Are you sure?"
  if Bool
b
  then do
    Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
    FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd ReqUI -> m (FailOrCmd ReqUI))
-> FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall a b. (a -> b) -> a -> b
$ ReqUI -> FailOrCmd ReqUI
forall a b. b -> Either a b
Right (ReqUI -> FailOrCmd ReqUI) -> ReqUI -> FailOrCmd ReqUI
forall a b. (a -> b) -> a -> b
$ GroupName ModeKind -> Challenge -> ReqUI
ReqUIGameRestart "insert coin" Challenge
snxtChal
  else do
    Text
msg2 <- Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientRead m => Rnd a -> m a
rndToActionForget (Rnd Text -> m Text) -> Rnd Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
              [ "yea, would be a pity to leave them to die"
              , "yea, a shame to get your team stranded" ]
    Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
msg2

-- * GameDrop

gameDropHuman :: MonadClientUI m => m ReqUI
gameDropHuman :: m ReqUI
gameDropHuman = do
  (SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sallNframes :: X
sallNframes = -1}  -- hack, but we crash anyway
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Interrupt! Trashing the unsaved game. The program exits now."
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI "Interrupt! Trashing the unsaved game. The program exits now."
    -- this is not shown by vty frontend, but at least shown by sdl2 one
  ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameDropAndExit

-- * GameExit

gameExitHuman :: MonadClientUI m => m ReqUI
gameExitHuman :: m ReqUI
gameExitHuman = do
  -- Announce before the saving started, since it can take a while.
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Saving game. The program stops now."
  ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameSaveAndExit

-- * GameSave

gameSaveHuman :: MonadClientUI m => m ReqUI
gameSaveHuman :: m ReqUI
gameSaveHuman = do
  -- Announce before the saving started, since it can take a while.
  Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
promptAdd0 "Saving game backup."
  ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameSave

-- * Tactic

-- Note that the difference between seek-target and follow-the-leader tactic
-- can influence even a faction with passive actors. E.g., if a passive actor
-- has an extra active skill from equipment, he moves every turn.
tacticHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
tacticHuman :: m (FailOrCmd ReqUI)
tacticHuman = do
  FactionId
fid <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
  Tactic
fromT <- (State -> Tactic) -> m Tactic
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Tactic) -> m Tactic) -> (State -> Tactic) -> m Tactic
forall a b. (a -> b) -> a -> b
$ Player -> Tactic
ftactic (Player -> Tactic) -> (State -> Player) -> State -> Tactic
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player) -> (State -> Faction) -> State -> Player
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
  let toT :: Tactic
toT = if Tactic
fromT Tactic -> Tactic -> Bool
forall a. Eq a => a -> a -> Bool
== Tactic
forall a. Bounded a => a
maxBound then Tactic
forall a. Bounded a => a
minBound else Tactic -> Tactic
forall a. Enum a => a -> a
succ Tactic
fromT
  Bool
go <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull
        (Text -> m Bool) -> Text -> m Bool
forall a b. (a -> b) -> a -> b
$ "(Beware, work in progress!)"
          Text -> Text -> Text
<+> "Current henchmen tactic is" Text -> Text -> Text
<+> Tactic -> Text
Ability.nameTactic Tactic
fromT
          Text -> Text -> Text
<+> "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tactic -> Text
Ability.describeTactic Tactic
fromT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")."
          Text -> Text -> Text
<+> "Switching tactic to" Text -> Text -> Text
<+> Tactic -> Text
Ability.nameTactic Tactic
toT
          Text -> Text -> Text
<+> "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Tactic -> Text
Ability.describeTactic Tactic
toT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")."
          Text -> Text -> Text
<+> "This clears targets of all henchmen (non-leader teammates)."
          Text -> Text -> Text
<+> "New targets will be picked according to new tactic."
  if Bool -> Bool
not Bool
go
  then Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "tactic change canceled"
  else FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd ReqUI -> m (FailOrCmd ReqUI))
-> FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall a b. (a -> b) -> a -> b
$ ReqUI -> FailOrCmd ReqUI
forall a b. b -> Either a b
Right (ReqUI -> FailOrCmd ReqUI) -> ReqUI -> FailOrCmd ReqUI
forall a b. (a -> b) -> a -> b
$ Tactic -> ReqUI
ReqUITactic Tactic
toT

-- * Automate

automateHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
automateHuman :: m (FailOrCmd ReqUI)
automateHuman = do
  m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
  Bool
go <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorBW
          "Ceding control to AI (press SPACE to confirm, ESC to cancel)."
  if Bool -> Bool
not Bool
go
  then Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "automation canceled"
  else FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd ReqUI -> m (FailOrCmd ReqUI))
-> FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall a b. (a -> b) -> a -> b
$ ReqUI -> FailOrCmd ReqUI
forall a b. b -> Either a b
Right ReqUI
ReqUIAutomate

-- * AutomateToggle

automateToggleHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
automateToggleHuman :: m (FailOrCmd ReqUI)
automateToggleHuman = do
  Bool
swasAutomated <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
swasAutomated
  if Bool
swasAutomated
  then Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "automation canceled"
  else m (FailOrCmd ReqUI)
forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ReqUI)
automateHuman

-- * AutomateBack

automateBackHuman :: MonadClientUI m => m (Either MError ReqUI)
automateBackHuman :: m (Either MError ReqUI)
automateBackHuman = do
  Bool
swasAutomated <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
swasAutomated
  Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$! if Bool
swasAutomated
            then ReqUI -> Either MError ReqUI
forall a b. b -> Either a b
Right ReqUI
ReqUIAutomate
            else MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing