module Game.LambdaHack.Client.UI.HandleHumanGlobalM
(
byAreaHuman, byAimModeHuman
, composeIfLocalHuman, composeUnlessErrorHuman, compose2ndLocalHuman
, loopOnNothingHuman, executeIfClearHuman
, 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
, gameRestartHuman, gameQuitHuman, gameDropHuman, gameExitHuman, gameSaveHuman
, tacticHuman, automateHuman, automateToggleHuman, automateBackHuman
#ifdef EXPOSE_INTERNAL
, 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
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
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
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
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
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)]
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
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
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
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
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
Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
req
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
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
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
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
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
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
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
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}
let tpos :: Point
tpos = Actor -> Point
bpos Actor
sb Point -> Vector -> Point
`shift` Vector
dir
[(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
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 ->
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 ->
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
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
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"
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
(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
(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
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 ->
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
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
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
tpos :: Point
tpos = Point
spos Point -> Vector -> Point
`shift` Vector
dir
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
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
FailOrCmd RequestTimed
runStopOrCmd <-
if
| 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
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
| Bool
run -> do
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]
| 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
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
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 ->
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterBlockActor
| Bool
otherwise -> do
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
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
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
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
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
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
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 ->
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"
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
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
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
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}
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 ->
[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
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) =
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]
then case CStore
destCStore of
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
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
CEqp | Actor -> X -> Bool
eqpOverfull Actor
b (X
oldN X -> X -> X
forall a. Num a => a -> a -> a
+ X
k) -> do
m ()
issueWarning
[(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
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
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
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)
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"
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
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) ->
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"
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
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
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
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?"
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 ()
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"
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
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"
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
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
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
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
itemMenuHuman :: MonadClientUI m
=> (HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
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]
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
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"
chooseItemMenuHuman :: MonadClientUI m
=> (HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode
-> m (Either MError ReqUI)
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
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
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)
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 =
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 =
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
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
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"
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
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
settingsMenuHuman :: MonadClientUI m
=> (HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
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
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"
challengesMenuHuman :: MonadClientUI m
=> (HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
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)
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 :: 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 :: 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 :: 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 :: 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))} }
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
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)
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
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}
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."
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameDropAndExit
gameExitHuman :: MonadClientUI m => m ReqUI
gameExitHuman :: m ReqUI
gameExitHuman = do
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
gameSaveHuman :: MonadClientUI m => m ReqUI
gameSaveHuman :: m ReqUI
gameSaveHuman = do
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
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
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
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
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