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, closeDirHuman
, helpHuman, hintHuman, dashboardHuman, itemMenuHuman, chooseItemMenuHuman
, mainMenuHuman, mainMenuAutoOnHuman, mainMenuAutoOffHuman
, settingsMenuHuman, challengeMenuHuman, gameDifficultyIncr
, gameFishToggle, gameGoodsToggle, gameWolfToggle, gameKeeperToggle
, gameScenarioIncr
, gameExitWithHuman, ExitStrategy(..), gameDropHuman, gameExitHuman
, gameSaveHuman, doctrineHuman, automateHuman, automateToggleHuman
, automateBackHuman
#ifdef EXPOSE_INTERNAL
, areaToRectangles, meleeAid, displaceAid, moveSearchAlter, alterCommon
, goToXhair, goToXhairExplorationMode, goToXhairGoTo
, multiActorGoTo, moveOrSelectItem, selectItemsToMove, moveItems
, projectItem, applyItem, alterTileAtPos, verifyAlters, processTileActions
, verifyEscape, verifyToolEffect, closeTileAtPos, msgAddDone, pickPoint
, generateMenu
#endif
) where
import Prelude ()
import Game.LambdaHack.Core.Prelude
import qualified Data.Char as Char
import Data.Either
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.Frame
import Game.LambdaHack.Client.UI.FrameM
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.PointUI
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.ClientOptions
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.FactionKind as FK
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.ModeKind as MK
import Game.LambdaHack.Content.RuleKind
import qualified Game.LambdaHack.Content.TileKind as TK
import qualified Game.LambdaHack.Core.Dice as Dice
import Game.LambdaHack.Core.Random
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import Game.LambdaHack.Definition.Defs
import qualified Game.LambdaHack.Definition.DefsInternal as DefsInternal
byAreaHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> [(CmdArea, HumanCmd)]
-> m (Either MError ReqUI)
byAreaHuman :: (KM -> HumanCmd -> m (Either MError ReqUI))
-> [(CmdArea, HumanCmd)] -> m (Either MError ReqUI)
byAreaHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM [(CmdArea, HumanCmd)]
l = do
CCUI{coinput :: CCUI -> InputContent
coinput=InputContent{Map HumanCmd [KM]
brevMap :: InputContent -> Map HumanCmd [KM]
brevMap :: Map HumanCmd [KM]
brevMap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let PointSquare Int
px Int
py = PointUI -> PointSquare
uiToSquare PointUI
pUI
p :: Point
p = Point :: Int -> Int -> Point
Point {Int
py :: Int
px :: Int
py :: Int
px :: Int
..}
pointerInArea :: CmdArea -> m Bool
pointerInArea 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 (Area -> Point -> Bool
`inside` Point
p) ([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
(CmdArea
_, HumanCmd
cmd) : [(CmdArea, HumanCmd)]
_ -> do
let kmFound :: KM
kmFound = case HumanCmd -> Map HumanCmd [KM] -> Maybe [KM]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup HumanCmd
cmd Map HumanCmd [KM]
brevMap of
Just (KM
km : [KM]
_) -> KM
km
Maybe [KM]
_ -> KM
K.escKM
KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
kmFound HumanCmd
cmd
areaToRectangles :: MonadClientUI m => CmdArea -> m [Maybe Area]
areaToRectangles :: CmdArea -> m [Maybe Area]
areaToRectangles CmdArea
ca = ((Int, Int, Int, Int) -> Maybe Area)
-> [(Int, Int, Int, Int)] -> [Maybe Area]
forall a b. (a -> b) -> [a] -> [b]
map (Int, Int, Int, Int) -> Maybe Area
toArea ([(Int, Int, Int, Int)] -> [Maybe Area])
-> m [(Int, Int, Int, Int)] -> m [Maybe Area]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: ScreenContent -> Int
rwidth :: Int
rwidth, Int
rheight :: ScreenContent -> Int
rheight :: Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
case CmdArea
ca of
CmdArea
CaMessage -> [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
0, Int
0, Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
0)]
CmdArea
CaMapLeader -> do
Maybe ActorId
mleader <- (StateClient -> Maybe ActorId) -> m (Maybe ActorId)
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Maybe ActorId
sleader
case Maybe ActorId
mleader of
Maybe ActorId
Nothing -> [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
Just ActorId
leader -> do
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 PointSquare Int
x Int
y = Point -> PointSquare
mapToSquare (Point -> PointSquare) -> Point -> PointSquare
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b
[(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x, Int
y, Int
x, Int
y)]
CmdArea
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 -> (Int, Int, Int, Int)
rectFromB Point
p = let PointSquare Int
x Int
y = Point -> PointSquare
mapToSquare Point
p
in (Int
x, Int
y, Int
x, Int
y)
[(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)])
-> [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall a b. (a -> b) -> a -> b
$! (Actor -> (Int, Int, Int, Int))
-> [Actor] -> [(Int, Int, Int, Int)]
forall a b. (a -> b) -> [a] -> [b]
map (Point -> (Int, Int, Int, Int)
rectFromB (Point -> (Int, Int, Int, Int))
-> (Actor -> Point) -> Actor -> (Int, Int, Int, Int)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Actor -> Point
bpos) [Actor]
ours
CmdArea
CaMap ->
let PointSquare Int
xo Int
yo = Point -> PointSquare
mapToSquare Point
originPoint
PointSquare Int
xe Int
ye = Point -> PointSquare
mapToSquare (Point -> PointSquare) -> Point -> PointSquare
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Point
Point (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
4)
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
xo, Int
yo, Int
xe, Int
ye)]
CmdArea
CaLevelNumber -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
0, Int
y, Int
1, Int
y)]
CmdArea
CaArenaName -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
11
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
3, Int
y, Int
x, Int
y)]
CmdArea
CaPercentSeen -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9, Int
y, Int
x, Int
y)]
CmdArea
CaXhairDesc -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x, Int
y, Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
y)]
CmdArea
CaSelected -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
0, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
24, Int
y)]
CmdArea
CaCalmGauge -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
22, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
18, Int
y)]
CmdArea
CaCalmValue -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
17, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
11, Int
y)]
CmdArea
CaHPGauge -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
9, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6, Int
y)]
CmdArea
CaHPValue -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
6, Int
y, Int
x, Int
y)]
CmdArea
CaLeaderDesc -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(Int
x, Int
y, Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
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 m (Either MError ReqUI)
cmdNotAimingM 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 m (Either MError ReqUI)
c1 m (Either MError ReqUI)
c2 = do
Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
case Either MError ReqUI
slideOrCmd1 of
Left MError
merr1 -> do
Either MError ReqUI
slideOrCmd2 <- m (Either MError ReqUI)
c2
case Either MError ReqUI
slideOrCmd2 of
Left 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
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd2
Either MError ReqUI
_ -> 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 m (Either MError ReqUI)
c1 m (Either MError ReqUI)
c2 = do
Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
case Either MError ReqUI
slideOrCmd1 of
Left MError
Nothing -> m (Either MError ReqUI)
c2
Either MError ReqUI
_ -> 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 m (Either MError ReqUI)
c1 m (Either MError ReqUI)
c2 = do
Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
case Either MError ReqUI
slideOrCmd1 of
Left MError
merr1 -> do
Either MError ReqUI
slideOrCmd2 <- m (Either MError ReqUI)
c2
case Either MError ReqUI
slideOrCmd2 of
Left 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
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd1
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 m (Either MError ReqUI)
cmd = do
Either MError ReqUI
res <- m (Either MError ReqUI)
cmd
case Either MError ReqUI
res of
Left MError
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
_ -> 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 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
ReqDelay
sreqDelay <- (SessionUI -> ReqDelay) -> m ReqDelay
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> ReqDelay
sreqDelay
if Bool
sreportNull Bool -> Bool -> Bool
|| ReqDelay
sreqDelay ReqDelay -> ReqDelay -> Bool
forall a. Eq a => a -> a -> Bool
== ReqDelay
ReqDelayHandled
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 => ActorId -> m (FailOrCmd RequestTimed)
waitHuman :: ActorId -> m (FailOrCmd RequestTimed)
waitHuman ActorId
leader = do
Skills
actorCurAndMaxSk <- (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
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
$ \SessionUI
sess -> SessionUI
sess {swaitTimes :: Int
swaitTimes = Int -> Int
forall a. Num a => a -> a
abs (SessionUI -> Int
swaitTimes SessionUI
sess) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 => ActorId -> m (FailOrCmd RequestTimed)
waitHuman10 :: ActorId -> m (FailOrCmd RequestTimed)
waitHuman10 ActorId
leader = do
Skills
actorCurAndMaxSk <- (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
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
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
$ \SessionUI
sess -> SessionUI
sess {swaitTimes :: Int
swaitTimes = Int -> Int
forall a. Num a => a -> a
abs (SessionUI -> Int
swaitTimes SessionUI
sess) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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 => ActorId -> m (FailOrCmd RequestTimed)
yellHuman :: ActorId -> m (FailOrCmd RequestTimed)
yellHuman ActorId
leader = do
Skills
actorCurAndMaxSk <- (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
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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)
=> ActorId -> Bool -> Bool -> Bool -> Bool -> Vector
-> m (FailOrCmd RequestTimed)
moveRunHuman :: ActorId
-> Bool
-> Bool
-> Bool
-> Bool
-> Vector
-> m (FailOrCmd RequestTimed)
moveRunHuman ActorId
leader Bool
initialStep Bool
finalGoal Bool
run Bool
runAhead Vector
dir = do
Skills
actorCurAndMaxSk <- (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
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
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.elems (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 = RunParams :: ActorId -> [ActorId] -> Bool -> Maybe Text -> Int -> 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 :: Int
runWaiting = Int
0 }
initRunning :: m ()
initRunning = 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
$ \SessionUI
sess ->
SessionUI
sess {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
$ [String] -> m ()
forall (m :: * -> *). MonadClientUI m => [String] -> m ()
macroHuman [String]
macroRun25
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 <- ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter ActorId
leader Bool
run Vector
dir
case FailOrCmd RequestTimed
runStopOrCmd of
Left 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 RequestTimed
runCmd -> do
m ()
initRunning
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
[(ActorId
target, Actor
_)] | Bool
run
Bool -> Bool -> Bool
&& Bool
initialStep
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
ActorId -> ActorId -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> ActorId -> m (FailOrCmd RequestTimed)
displaceAid ActorId
leader ActorId
target
(ActorId, Actor)
_ : (ActorId, Actor)
_ : [(ActorId, Actor)]
_ | Bool
run
Bool -> Bool -> Bool
&& Bool
initialStep
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceMultiple
(ActorId
target, Actor
tb) : [(ActorId, Actor)]
_ | 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` String
"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 Text
"the pointman switched by bumping"
(ActorId
target, Actor
tb) : [(ActorId, Actor)]
_ | 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) -> do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
stopPlayBack
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then
ActorId -> ActorId -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> ActorId -> m (FailOrCmd RequestTimed)
meleeAid ActorId
leader ActorId
target
else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MeleeUnskilled
(ActorId, Actor)
_ : [(ActorId, Actor)]
_ -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"actor in the way"
meleeAid :: (MonadClient m, MonadClientUI m)
=> ActorId -> ActorId -> m (FailOrCmd RequestTimed)
meleeAid :: ActorId -> ActorId -> m (FailOrCmd RequestTimed)
meleeAid ActorId
leader ActorId
target = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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.! 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
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
Maybe RequestTimed
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"nothing to melee with"
Just 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
$ \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 FactionId
side Faction
sfact (Actor -> FactionId
bfid Actor
tb) = m (FailOrCmd RequestTimed)
returnCmd
| FactionId -> Faction -> FactionId -> Bool
isFriend FactionId
side Faction
sfact (Actor -> FactionId
bfid Actor
tb) = do
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (FactionId
side 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
Text
"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 Text
"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
Text
"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 Text
"attack canceled" else m (FailOrCmd RequestTimed)
returnCmd
m (FailOrCmd RequestTimed)
res
displaceAid :: MonadClientUI m
=> ActorId -> ActorId -> m (FailOrCmd RequestTimed)
displaceAid :: ActorId -> ActorId -> m (FailOrCmd RequestTimed)
displaceAid ActorId
leader 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
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
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 -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 ->
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
"" String -> (ActorId, Actor, ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
leader, Actor
sb, ActorId
target, Actor
tb)
[ActorId
_] -> 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
[ActorId]
_ -> 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
=> ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter :: ActorId -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter ActorId
leader Bool
run Vector
dir = 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
Skills
actorCurAndMaxSk <- (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
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
let moveSkill :: Int
moveSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorCurAndMaxSk
spos :: Point
spos = Actor -> Point
bpos Actor
sb
tpos :: Point
tpos = Point
spos Point -> Vector -> Point
`shift` Vector
dir
Bool
alterable <- (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
$ LevelId -> Point -> State -> Bool
tileAlterable (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
let t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
FailOrCmd RequestTimed
runStopOrCmd <-
if TileSpeedup -> ContentId TileKind -> Bool
Tile.isWalkable TileSpeedup
coTileSpeedup ContentId TileKind
t then
if | Int
moveSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
$ 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
| Actor -> Watchfulness
bwatch Actor
sb Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MoveUnskilledAsleep
| Bool
otherwise -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MoveUnskilled
else do
let 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
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown (Actor -> LevelId
blid Actor
sb) Point
tpos
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
if Bool
run then do
[(MsgClassShow, Text)]
blurb <- Point -> LevelId -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition Point
tpos (Actor -> LevelId
blid Actor
sb)
((MsgClassShow, Text) -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((MsgClassShow -> Text -> m ()) -> (MsgClassShow, Text) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd) [(MsgClassShow, 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
$ Text
"the terrain is" Text -> Text -> Text
<+>
if | TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
t -> Text
"potentially modifiable"
| Bool
alterable -> Text
"potentially triggerable"
| Bool
otherwise -> Text
"completely inert"
else ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon ActorId
leader Bool
True Point
tpos
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
alterCommon :: MonadClientUI m
=> ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon :: ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon ActorId
leader Bool
bumping Point
tpos = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
cops :: COps
cops@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
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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
Skills
actorCurAndMaxSk <- (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
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
let alterSkill :: Int
alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorCurAndMaxSk
spos :: Point
spos = Actor -> Point
bpos Actor
sb
Bool
alterable <- (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
$ LevelId -> Point -> State -> Bool
tileAlterable (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
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
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
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 t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
underFeet :: Bool
underFeet = Point
tpos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
spos
modificationFailureHint :: m ()
modificationFailureHint = MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint Text
"Some doors can be opened, stairs unbarred, treasures recovered, only if you find tools that increase your terrain modification ability and act as keys to the puzzle. To gather clues about the keys, listen to what's around you, examine items, inspect terrain, trigger, bump and harass. Once you uncover a likely tool, wield it, return and try to break through again."
if | 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
itemLook :: (ItemId, (Int, ItemTimers)) -> Part
itemLook (ItemId
iid, kit :: (Int, ItemTimers)
kit@(Int
k, ItemTimers
_)) =
let itemFull :: ItemFull
itemFull = ItemId -> ItemFull
itemToF ItemId
iid
in Int
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> Time
-> ItemFull
-> (Int, ItemTimers)
-> Part
partItemWsShort Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Int
k Time
localTime ItemFull
itemFull (Int, ItemTimers)
kit
embedKindList :: [(ItemKind, (ItemId, (Int, ItemTimers)))]
embedKindList =
((ItemId, (Int, ItemTimers))
-> (ItemKind, (ItemId, (Int, ItemTimers))))
-> [(ItemId, (Int, ItemTimers))]
-> [(ItemKind, (ItemId, (Int, ItemTimers)))]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemId
iid, (Int, ItemTimers)
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, (Int, ItemTimers)
kit))) (ItemBag -> [(ItemId, (Int, ItemTimers))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
ilooks :: [Part]
ilooks = ((ItemId, (Int, ItemTimers)) -> Part)
-> [(ItemId, (Int, ItemTimers))] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (ItemId, (Int, ItemTimers)) -> Part
itemLook ([(ItemId, (Int, ItemTimers))] -> [Part])
-> [(ItemId, (Int, ItemTimers))] -> [Part]
forall a b. (a -> b) -> a -> b
$ COps
-> ContentId TileKind
-> [(ItemKind, (ItemId, (Int, ItemTimers)))]
-> [(ItemId, (Int, ItemTimers))]
sortEmbeds COps
cops ContentId TileKind
t [(ItemKind, (ItemId, (Int, ItemTimers)))]
embedKindList
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 ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
[Part
"there is no point kicking", Part -> Part
MU.AW Part
name]
[Part] -> [Part] -> [Part]
forall a. [a] -> [a] -> [a]
++ if ItemBag -> Bool
forall k a. EnumMap k a -> Bool
EM.null ItemBag
embeds
then []
else [Part
"with", [Part] -> Part
MU.WWandW [Part]
ilooks]
| TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup ContentId TileKind
t
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underFeet
Bool -> Bool -> Bool
&& Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 -> do
m ()
modificationFailureHint
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
&& Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinSkill TileSpeedup
coTileSpeedup ContentId TileKind
t -> do
[(MsgClassShow, Text)]
blurb <- Point -> LevelId -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition Point
tpos (Actor -> LevelId
blid Actor
sb)
((MsgClassShow, Text) -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((MsgClassShow -> Text -> m ()) -> (MsgClassShow, Text) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd) [(MsgClassShow, Text)]
blurb
m ()
modificationFailureHint
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterUnwalked
| Point -> Point -> Int
chessDist Point
tpos (Actor -> Point
bpos Actor
sb) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1 ->
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterDistant
| Bool -> Bool
not Bool
underFeet
Bool -> Bool -> Bool
&& (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 <- ActorId -> Bool -> Point -> m (FailOrCmd ())
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Point -> m (FailOrCmd ())
verifyAlters ActorId
leader Bool
bumping Point
tpos
case FailOrCmd ()
verAlters of
Right () ->
if Bool
bumping 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 -> RequestTimed) -> Vector -> RequestTimed
forall a b. (a -> b) -> a -> b
$ Point -> Point -> Vector
vectorToFrom Point
tpos Point
spos
else do
Bool -> ActorId -> Point -> Text -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Point -> Text -> m ()
msgAddDone Bool
False ActorId
leader Point
tpos Text
"modify"
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 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
runOnceAheadHuman :: MonadClientUI m
=> ActorId -> m (Either MError RequestTimed)
runOnceAheadHuman :: ActorId -> m (Either MError RequestTimed)
runOnceAheadHuman ActorId
leader = 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
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
Maybe RunParams
Nothing -> do
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason Text
"run stop: nothing to do"
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
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason Text
"run stop: automatic pointman 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 | Bool
keyPressed -> do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
discardPressedKey
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason Text
"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 Text
"interrupted"
Just 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 Text
stopMsg -> do
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason (Text
"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 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)
=> ActorId -> m (FailOrCmd RequestTimed)
moveOnceToXhairHuman :: ActorId -> m (FailOrCmd RequestTimed)
moveOnceToXhairHuman ActorId
leader = ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair ActorId
leader Bool
True Bool
False
goToXhair :: (MonadClient m, MonadClientUI m)
=> ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair :: ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair ActorId
leader Bool
initialStep 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 Text
"cannot move in aiming mode"
else ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairExplorationMode ActorId
leader Bool
initialStep Bool
run
goToXhairExplorationMode :: (MonadClient m, MonadClientUI m)
=> ActorId -> Bool -> Bool
-> m (FailOrCmd RequestTimed)
goToXhairExplorationMode :: ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairExplorationMode ActorId
leader Bool
initialStep Bool
run = do
Skills
actorCurAndMaxSk <- (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
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
let moveSkill :: Int
moveSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorCurAndMaxSk
if | Int
moveSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> do
Maybe Target
xhair <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhair
Maybe Target
xhairGoTo <- (SessionUI -> Maybe Target) -> m (Maybe Target)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Target
sxhairGoTo
FailOrCmd RequestTimed
mfail <-
if Maybe Target -> Bool
forall a. Maybe a -> Bool
isJust Maybe Target
xhairGoTo Bool -> Bool -> Bool
&& Maybe Target
xhairGoTo Maybe Target -> Maybe Target -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe Target
xhair
then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"crosshair position changed"
else do
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Maybe Target -> Bool
forall a. Maybe a -> Bool
isNothing Maybe Target
xhairGoTo) (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
$ \SessionUI
sess -> SessionUI
sess {sxhairGoTo :: Maybe Target
sxhairGoTo = Maybe Target
xhair}
ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairGoTo ActorId
leader Bool
initialStep Bool
run
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (FailOrCmd RequestTimed -> Bool
forall a b. Either a b -> Bool
isLeft FailOrCmd RequestTimed
mfail) (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
$ \SessionUI
sess -> SessionUI
sess {sxhairGoTo :: Maybe Target
sxhairGoTo = Maybe Target
forall a. Maybe a
Nothing}
FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return FailOrCmd RequestTimed
mfail
| Actor -> Watchfulness
bwatch Actor
sb Watchfulness -> Watchfulness -> Bool
forall a. Eq a => a -> a -> Bool
== Watchfulness
WSleep -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MoveUnskilledAsleep
| Bool
otherwise -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MoveUnskilled
goToXhairGoTo :: (MonadClient m, MonadClientUI m)
=> ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairGoTo :: ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairGoTo ActorId
leader Bool
initialStep Bool
run = do
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
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
case Maybe Point
mxhairPos of
Maybe Point
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"crosshair position invalid"
Just 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 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 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 (Bool
finalGoal, Vector
dir) ->
ActorId
-> Bool
-> Bool
-> Bool
-> Bool
-> Vector
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> Bool
-> Bool
-> Bool
-> Bool
-> Vector
-> m (FailOrCmd RequestTimed)
moveRunHuman ActorId
leader Bool
initialStep Bool
finalGoal Bool
run Bool
False Vector
dir
Maybe RunParams
_ | 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 Text
"position reached"
Maybe RunParams
_ -> do
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
initialStep Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
run) ()
(Array BfsDistance
bfs, 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
Maybe AndPath
_ | Bool
xhairMoused Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
c) ->
Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith
Text
"no route to crosshair (press again to go there anyway)"
Maybe AndPath
_ | 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
ActorId
-> Bool
-> Bool
-> Bool
-> Bool
-> Vector
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> Bool
-> Bool
-> Bool
-> Bool
-> Vector
-> m (FailOrCmd RequestTimed)
moveRunHuman ActorId
leader Bool
initialStep Bool
True Bool
run Bool
False Vector
dir
Maybe AndPath
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"no route to crosshair"
Just AndPath{pathList :: AndPath -> [Point]
pathList=[]} -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"almost there"
Just AndPath{pathList :: AndPath -> [Point]
pathList = Point
p1 : [Point]
_} -> 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
-> Bool
-> Bool
-> Bool
-> Bool
-> Vector
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> Bool
-> Bool
-> Bool
-> Bool
-> Vector
-> m (FailOrCmd RequestTimed)
moveRunHuman ActorId
leader 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 LevelId
arena Point
c 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 Text
"selected actors no longer there"
RunParams{runMembers :: RunParams -> [ActorId]
runMembers = ActorId
r : [ActorId]
rs, Int
runWaiting :: Int
runWaiting :: RunParams -> Int
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
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
Maybe Point
mxhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
mxhairToPos
if Bool -> Bool
not Bool
onLevel Bool -> Bool -> Bool
|| Maybe Point
mxhairPos Maybe Point -> Maybe Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point -> Maybe Point
forall a. a -> Maybe a
Just (Actor -> Point
bpos Actor
b) 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 :: Int
runWaiting = Int
0}
(Array BfsDistance
bfs, 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
Maybe AndPath
_ | Bool
xhairMoused Bool -> Bool -> Bool
&& Maybe Int -> Bool
forall a. Maybe a -> Bool
isNothing (Array BfsDistance -> Point -> Maybe Int
accessBfs Array BfsDistance
bfs Point
c) ->
Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"no route to crosshair (press again to go there anyway)"
Maybe AndPath
Nothing -> Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"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 Text
"almost there"
Just AndPath{pathList :: AndPath -> [Point]
pathList = Point
p1 : [Point]
_} -> 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
$ \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)
[ActorId
target] | ActorId
target ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActorId]
rs Bool -> Bool -> Bool
|| Int
runWaiting Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= [ActorId] -> Int
forall a. [a] -> Int
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 :: Int
runWaiting=Int
runWaiting Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1}
[ActorId]
_ ->
Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"collective running finished"
runOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
=> ActorId -> m (FailOrCmd RequestTimed)
runOnceToXhairHuman :: ActorId -> m (FailOrCmd RequestTimed)
runOnceToXhairHuman ActorId
leader = ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair ActorId
leader Bool
True Bool
True
continueToXhairHuman :: (MonadClient m, MonadClientUI m)
=> ActorId -> m (FailOrCmd RequestTimed)
continueToXhairHuman :: ActorId -> m (FailOrCmd RequestTimed)
continueToXhairHuman ActorId
leader = ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair ActorId
leader Bool
False Bool
False
moveItemHuman :: forall m. MonadClientUI m
=> ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
-> m (FailOrCmd RequestTimed)
moveItemHuman :: ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
moveItemHuman ActorId
leader [CStore]
stores CStore
destCStore Maybe Text
mverb 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]
stores) ()
Skills
actorCurAndMaxSk <- (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
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0
then ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
moveOrSelectItem ActorId
leader [CStore]
stores CStore
destCStore Maybe Text
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
=> ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
-> m (FailOrCmd RequestTimed)
moveOrSelectItem :: ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
moveOrSelectItem ActorId
leader [CStore]
storesRaw CStore
destCStore Maybe Text
mverb Bool
auto = do
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
actorCurAndMaxSk <- (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 (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
let calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
overStash :: Bool
overStash = Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
stores :: [CStore]
stores = case [CStore]
storesRaw of
CStore
CEqp : rest :: [CStore]
rest@(CStore
_ : [CStore]
_) | Bool -> Bool
not Bool
calmE -> [CStore]
rest [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CEqp]
CStore
CGround : rest :: [CStore]
rest@(CStore
_ : [CStore]
_) | Bool
overStash -> [CStore]
rest [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CGround]
[CStore]
_ -> [CStore]
storesRaw
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
$ \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
Maybe (ItemId, CStore, Bool)
_ | [CStore]
stores [CStore] -> [CStore] -> Bool
forall a. Eq a => a -> a -> Bool
== [CStore
CGround] Bool -> Bool -> Bool
&& Bool
overStash ->
Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"you can't loot items from your own stash"
Just (ItemId
_, fromCStore :: CStore
fromCStore@CStore
CEqp, Bool
_) | 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]
stores
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE ->
Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"neither the selected item nor any other can be unequipped"
Just (ItemId
_, fromCStore :: CStore
fromCStore@CStore
CGround, Bool
_) | 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]
stores
Bool -> Bool -> Bool
&& Bool
overStash ->
Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"you vainly paw through your own hoard"
Just (ItemId
iid, CStore
fromCStore, Bool
_) | 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]
stores -> do
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 (Int, ItemTimers)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Maybe (Int, ItemTimers)
Nothing ->
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
moveOrSelectItem ActorId
leader [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
Just (Int
k, ItemTimers
it) -> Bool -> m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed)
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed))
-> m (FailOrCmd RequestTimed) -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ do
let eqpFree :: Int
eqpFree = Actor -> Int
eqpFreeN Actor
b
kToPick :: Int
kToPick | CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
eqpFree Int
k
| Bool
otherwise = Int
k
if | CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemNotCalm
| CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround Bool -> Bool -> Bool
&& Bool
overStash -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemOverStash
| Int
kToPick Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"no more items can be equipped"
| Bool
otherwise -> do
Either MError Int
socK <- Bool -> Int -> m (Either MError Int)
forall (m :: * -> *).
MonadClientUI m =>
Bool -> Int -> m (Either MError Int)
pickNumber (Bool -> Bool
not Bool
auto) Int
kToPick
case Either MError Int
socK of
Left MError
Nothing ->
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
moveOrSelectItem ActorId
leader [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
Left (Just 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 Int
kChosen ->
let is :: (CStore, [(ItemId, (Int, ItemTimers))])
is = (CStore
fromCStore, [(ItemId
iid, (Int
kChosen, Int -> ItemTimers -> ItemTimers
forall a. Int -> [a] -> [a]
take Int
kChosen ItemTimers
it))])
in RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> m RequestTimed -> m (FailOrCmd RequestTimed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId
-> [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
moveItems ActorId
leader [CStore]
stores (CStore, [(ItemId, (Int, ItemTimers))])
is CStore
destCStore
Maybe (ItemId, CStore, Bool)
_ -> do
FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
mis <- ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
selectItemsToMove ActorId
leader [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
case FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
mis of
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
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
Right (CStore
fromCStore, [(ItemId
iid, (Int, ItemTimers)
_)]) | [CStore]
stores [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
$ \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)}
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd RequestTimed)
moveOrSelectItem ActorId
leader [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
Right is :: (CStore, [(ItemId, (Int, ItemTimers))])
is@(CStore
fromCStore, [(ItemId, (Int, ItemTimers))]
_) ->
if | CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemNotCalm
| CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround Bool -> Bool -> Bool
&& Bool
overStash -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemOverStash
| Bool
otherwise -> RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> m RequestTimed -> m (FailOrCmd RequestTimed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ActorId
-> [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
moveItems ActorId
leader [CStore]
stores (CStore, [(ItemId, (Int, ItemTimers))])
is CStore
destCStore
selectItemsToMove :: forall m. MonadClientUI m
=> ActorId -> [CStore] -> CStore -> Maybe Text -> Bool
-> m (FailOrCmd (CStore, [(ItemId, ItemQuant)]))
selectItemsToMove :: ActorId
-> [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
selectItemsToMove ActorId
leader [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto = do
let verb :: Text
verb = Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe (CStore -> Text
verbCStore CStore
destCStore) Maybe Text
mverb
Skills
actorCurAndMaxSk <- (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
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 (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
b
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
actorCurAndMaxSk
overStash :: Bool
overStash = Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
if | CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE -> ReqFailure -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemNotCalm
| CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround Bool -> Bool -> Bool
&& Bool
overStash -> ReqFailure -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemOverStash
| CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Actor -> Int -> Bool
eqpOverfull Actor
b Int
1 -> ReqFailure -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
EqpOverfull
| Bool
otherwise -> do
let storesLast :: [CStore]
storesLast = case Maybe (CStore, CStore)
lastItemMove of
Just (CStore
lastFrom, 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]
stores ->
CStore
lastFrom CStore -> [CStore] -> [CStore]
forall a. a -> [a] -> [a]
: CStore -> [CStore] -> [CStore]
forall a. Eq a => a -> [a] -> [a]
delete CStore
lastFrom [CStore]
stores
Maybe (CStore, CStore)
_ -> [CStore]
stores
prompt :: Text
prompt = Text
"What to"
promptEqp :: Text
promptEqp = Text
"What consumable to"
eqpItemsN :: Actor -> Text
eqpItemsN Actor
body =
let n :: Int
n = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((Int, ItemTimers) -> Int) -> [(Int, ItemTimers)] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map (Int, ItemTimers) -> Int
forall a b. (a, b) -> a
fst ([(Int, ItemTimers)] -> [Int]) -> [(Int, ItemTimers)] -> [Int]
forall a b. (a -> b) -> a -> b
$ ItemBag -> [(Int, ItemTimers)]
forall k a. EnumMap k a -> [a]
EM.elems (ItemBag -> [(Int, ItemTimers)]) -> ItemBag -> [(Int, ItemTimers)]
forall a b. (a -> b) -> a -> b
$ Actor -> ItemBag
beqp Actor
body
in Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs Int
n Part
"item"]
ppItemDialogBody :: Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Actor
body Skills
actorSk ItemDialogMode
cCur = case ItemDialogMode
cCur of
MStore CStore
CEqp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorSk ->
Text
"distractedly paw at" Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
MStore CStore
CGround | Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body) ->
Text
"greedily fondle" Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
ItemDialogMode
_ -> case CStore
destCStore of
CStore
CEqp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorSk ->
Text
"distractedly attempt to" Text -> Text -> Text
<+> Text
verb
Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
CStore
CEqp | Actor -> Int -> Bool
eqpOverfull Actor
body Int
1 ->
Text
"attempt to fit into equipment" Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
CStore
CGround | Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
body, Actor -> Point
bpos Actor
body) ->
Text
"greedily attempt to" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
CStore
CEqp -> Text
verb
Text -> Text -> Text
<+> Actor -> Text
eqpItemsN Actor
body Text -> Text -> Text
<+> Text
"so far)"
Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
CStore
_ -> Text
verb Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
Text -> Text -> Text
<+> if ItemDialogMode
cCur ItemDialogMode -> ItemDialogMode -> Bool
forall a. Eq a => a -> a -> Bool
== CStore -> ItemDialogMode
MStore CStore
CEqp
then Actor -> Text
eqpItemsN Actor
body Text -> Text -> Text
<+> Text
"now)"
else Text
""
(Text
promptGeneric, m Suitability
psuit) =
if CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp
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
$ (Maybe CStore -> ItemFull -> (Int, ItemTimers) -> Bool)
-> Suitability
SuitsSomething ((Maybe CStore -> ItemFull -> (Int, ItemTimers) -> Bool)
-> Suitability)
-> (Maybe CStore -> ItemFull -> (Int, ItemTimers) -> Bool)
-> Suitability
forall a b. (a -> b) -> a -> b
$ \Maybe CStore
_ ItemFull
itemFull (Int, ItemTimers)
_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 (CStore, [(ItemId, (Int, ItemTimers))])
ggi <-
ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> m Suitability
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> (Actor -> ActorUI -> Skills -> ItemDialogMode -> State -> Text)
-> [CStore]
-> Bool
-> Bool
-> m (Either Text (CStore, [(ItemId, (Int, ItemTimers))]))
getFull ActorId
leader m Suitability
psuit
(\Actor
body ActorUI
_ Skills
actorSk ItemDialogMode
cCur State
_ ->
Text
prompt Text -> Text -> Text
<+> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Actor
body Skills
actorSk ItemDialogMode
cCur)
(\Actor
body ActorUI
_ Skills
actorSk ItemDialogMode
cCur State
_ ->
Text
promptGeneric Text -> Text -> Text
<+> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Actor
body Skills
actorSk ItemDialogMode
cCur)
[CStore]
storesLast (Bool -> Bool
not Bool
auto) Bool
True
case Either Text (CStore, [(ItemId, (Int, ItemTimers))])
ggi of
Right (CStore
fromCStore, [(ItemId, (Int, ItemTimers))]
l) -> 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
$ \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, (Int, ItemTimers))])
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])))
-> FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall a b. (a -> b) -> a -> b
$ (CStore, [(ItemId, (Int, ItemTimers))])
-> FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
forall a b. b -> Either a b
Right (CStore
fromCStore, [(ItemId, (Int, ItemTimers))]
l)
Left Text
err -> Text -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
moveItems :: forall m. MonadClientUI m
=> ActorId -> [CStore] -> (CStore, [(ItemId, ItemQuant)]) -> CStore
-> m RequestTimed
moveItems :: ActorId
-> [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
moveItems ActorId
leader [CStore]
stores (CStore
fromCStore, [(ItemId, (Int, ItemTimers))]
l) CStore
destCStore = do
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (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]
stores) ()
Skills
actorCurAndMaxSk <- (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
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
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
actorCurAndMaxSk
ret4 :: [(ItemId, ItemQuant)] -> Int -> m [(ItemId, Int, CStore, CStore)]
ret4 :: [(ItemId, (Int, ItemTimers))]
-> Int -> m [(ItemId, Int, CStore, CStore)]
ret4 [] Int
_ = [(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
ret4 ((ItemId
iid, (Int
k, ItemTimers
_)) : [(ItemId, (Int, ItemTimers))]
rest) Int
oldN = do
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) ()
retRec :: CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
toCStore = do
let n :: Int
n = Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if CStore
toCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp then Int
k else Int
0
[(ItemId, Int, CStore, CStore)]
l4 <- [(ItemId, (Int, ItemTimers))]
-> Int -> m [(ItemId, Int, CStore, CStore)]
ret4 [(ItemId, (Int, ItemTimers))]
rest Int
n
[(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return ([(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)])
-> [(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall a b. (a -> b) -> a -> b
$ (ItemId
iid, Int
k, CStore
fromCStore, CStore
toCStore) (ItemId, Int, CStore, CStore)
-> [(ItemId, Int, CStore, CStore)]
-> [(ItemId, Int, CStore, CStore)]
forall a. a -> [a] -> [a]
: [(ItemId, Int, CStore, CStore)]
l4
if [CStore]
stores [CStore] -> [CStore] -> Bool
forall a. Eq a => a -> a -> Bool
== [CStore
CGround] Bool -> Bool -> Bool
&& CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CStash
then
if | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ 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 -> CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
CStash
| Actor -> Int -> Bool
eqpOverfull Actor
b (Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) -> do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Warning:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpOverfull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
CStash
| Actor -> Int -> Bool
eqpOverfull Actor
b (Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) -> do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Warning:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpStackFull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
CStash
| Bool -> Bool
not Bool
calmE -> do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Warning:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
ItemNotCalm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
CStash
| Bool
otherwise ->
CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
CEqp
else case CStore
destCStore of
CStore
CEqp | Actor -> Int -> Bool
eqpOverfull Actor
b (Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) -> do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptItems (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Failure:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpOverfull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
[(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
CStore
CEqp | Actor -> Int -> Bool
eqpOverfull Actor
b (Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) -> do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptItems (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
Text
"Failure:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpStackFull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
[(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
CStore
_ -> CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
destCStore
[(ItemId, Int, CStore, CStore)]
l4 <- [(ItemId, (Int, ItemTimers))]
-> Int -> m [(ItemId, Int, CStore, CStore)]
ret4 [(ItemId, (Int, ItemTimers))]
l Int
0
if [(ItemId, Int, CStore, CStore)] -> Bool
forall a. [a] -> Bool
null [(ItemId, Int, CStore, CStore)]
l4
then String -> m RequestTimed
forall a. (?callStack::CallStack) => String -> a
error (String -> m RequestTimed) -> String -> m RequestTimed
forall a b. (a -> b) -> a -> b
$ String
"" String
-> ([CStore], CStore, [(ItemId, (Int, ItemTimers))], CStore)
-> String
forall v. Show v => String -> v -> String
`showFailure` ([CStore]
stores, CStore
fromCStore, [(ItemId, (Int, ItemTimers))]
l, CStore
destCStore)
else RequestTimed -> m RequestTimed
forall (m :: * -> *) a. Monad m => a -> m a
return (RequestTimed -> m RequestTimed) -> RequestTimed -> m RequestTimed
forall a b. (a -> b) -> a -> b
$! [(ItemId, Int, CStore, CStore)] -> RequestTimed
ReqMoveItems [(ItemId, Int, CStore, CStore)]
l4
projectHuman :: (MonadClient m, MonadClientUI m)
=> ActorId -> m (FailOrCmd RequestTimed)
projectHuman :: ActorId -> m (FailOrCmd RequestTimed)
projectHuman ActorId
leader = do
Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
Skills
actorCurAndMaxSk <- (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
if | Challenge -> Bool
ckeeper Challenge
curChal ->
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ProjectFinderKeeper
| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 ->
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ProjectUnskilled
| Bool
otherwise -> 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 (ItemId
_, CStore
COrgan, Bool
_) -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"can't fling an organ"
Just (ItemId
iid, CStore
fromCStore, Bool
_) -> do
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 (Int, ItemTimers)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Maybe (Int, ItemTimers)
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"no item to fling"
Just (Int, ItemTimers)
_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))
ActorId
-> (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
projectItem ActorId
leader (CStore, (ItemId, ItemFull))
i
Maybe (ItemId, CStore, Bool)
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"no item to fling"
projectItem :: (MonadClient m, MonadClientUI m)
=> ActorId -> (CStore, (ItemId, ItemFull))
-> m (FailOrCmd RequestTimed)
projectItem :: ActorId
-> (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
projectItem ActorId
leader (CStore
fromCStore, (ItemId
iid, ItemFull
itemFull)) = do
Skills
actorCurAndMaxSk <- (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
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 calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
if CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE 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 <- ActorId
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId
-> m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq ActorId
leader
case Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq of
Left Text
err -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
Right ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ->
case ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull of
Left ReqFailure
reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
reqFail
Right (Point
pos, Bool
_) -> 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
>= Double
0
then ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
Text
"The item may be 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)
Int
eps <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
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 -> Int -> ItemId -> CStore -> RequestTimed
ReqProject Point
pos Int
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
$ \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 Text
"never mind"
applyHuman :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
applyHuman :: ActorId -> m (FailOrCmd RequestTimed)
applyHuman ActorId
leader = do
Skills
actorCurAndMaxSk <- (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
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply
Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
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 (ItemId
iid, CStore
fromCStore, Bool
_) -> do
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 (Int, ItemTimers)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Maybe (Int, ItemTimers)
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"no item to trigger"
Just (Int, ItemTimers)
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
ActorId
-> (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)
applyItem ActorId
leader (CStore
fromCStore, (ItemId
iid, (ItemFull
itemFull, (Int, ItemTimers)
kit)))
Maybe (ItemId, CStore, Bool)
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"no item to trigger"
applyItem :: MonadClientUI m
=> ActorId -> (CStore, (ItemId, ItemFullKit))
-> m (FailOrCmd RequestTimed)
applyItem :: ActorId
-> (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)
applyItem ActorId
leader (CStore
fromCStore, (ItemId
iid, (ItemFull
itemFull, (Int, ItemTimers)
kit))) = do
COps{RuleContent
corule :: COps -> RuleContent
corule :: RuleContent
corule} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Skills
actorCurAndMaxSk <- (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
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)
let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
actorCurAndMaxSk
calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
if CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE then ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ItemNotCalm
else case RuleContent
-> Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> (Int, ItemTimers)
-> Either ReqFailure Bool
permittedApply RuleContent
corule Time
localTime Int
skill Bool
calmE (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
fromCStore)
ItemFull
itemFull (Int, ItemTimers)
kit of
Left ReqFailure
reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
reqFail
Right Bool
_ -> 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
Text
"Triggering this periodic item may not produce all its effects (check item description) 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
< Double
0 ->
ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
Text
"The item appears harmful. Do you really want to trigger 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
$ \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 Text
"never mind"
alterDirHuman :: MonadClientUI m => ActorId -> m (FailOrCmd RequestTimed)
alterDirHuman :: ActorId -> m (FailOrCmd RequestTimed)
alterDirHuman ActorId
leader = ActorId -> Text -> m (Maybe Point)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Text -> m (Maybe Point)
pickPoint ActorId
leader Text
"modify" m (Maybe Point)
-> (Maybe Point -> m (FailOrCmd RequestTimed))
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Just Point
p -> ActorId -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (FailOrCmd RequestTimed)
alterTileAtPos ActorId
leader Point
p
Maybe Point
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
alterTileAtPos :: MonadClientUI m
=> ActorId -> Point -> m (FailOrCmd RequestTimed)
alterTileAtPos :: ActorId -> Point -> m (FailOrCmd RequestTimed)
alterTileAtPos ActorId
leader Point
pos = do
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
let 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
$ TGoal -> LevelId -> Point -> Target
TPoint TGoal
TUnknown (Actor -> LevelId
blid Actor
sb) Point
pos
Maybe Target -> m ()
forall (m :: * -> *). MonadClientUI m => Maybe Target -> m ()
setXHairFromGUI Maybe Target
sxhair
ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon ActorId
leader Bool
False Point
pos
verifyAlters :: forall m. MonadClientUI m
=> ActorId -> Bool -> Point -> m (FailOrCmd ())
verifyAlters :: ActorId -> Bool -> Point -> m (FailOrCmd ())
verifyAlters ActorId
leader Bool
bumping Point
tpos = do
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
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
AspectRecord
arItem <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid (ItemId -> State -> AspectRecord)
-> ItemId -> State -> AspectRecord
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk 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
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 embedKindList :: [(ItemKind, (ItemId, (Int, ItemTimers)))]
embedKindList =
if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
arItem
then []
else ((ItemId, (Int, ItemTimers))
-> (ItemKind, (ItemId, (Int, ItemTimers))))
-> [(ItemId, (Int, ItemTimers))]
-> [(ItemKind, (ItemId, (Int, ItemTimers)))]
forall a b. (a -> b) -> [a] -> [b]
map (\(ItemId
iid, (Int, ItemTimers)
kit) -> (ItemId -> ItemKind
getKind ItemId
iid, (ItemId
iid, (Int, ItemTimers)
kit))) (ItemBag -> [(ItemId, (Int, ItemTimers))]
forall k a. Enum k => EnumMap k a -> [(k, a)]
EM.assocs ItemBag
embeds)
underFeet :: Bool
underFeet = Point
tpos Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
sb
blockedByItem :: Bool
blockedByItem = Point -> EnumMap Point ItemBag -> Bool
forall k a. Enum k => k -> EnumMap k a -> Bool
EM.member Point
tpos (Level -> EnumMap Point ItemBag
lfloor Level
lvl)
tile :: ContentId TileKind
tile = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
feats :: [Feature]
feats = TileKind -> [Feature]
TK.tfeature (TileKind -> [Feature]) -> TileKind -> [Feature]
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
tile
tileActions :: [TileAction]
tileActions =
(Feature -> Maybe TileAction) -> [Feature] -> [TileAction]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe (Bool
-> Bool
-> [(ItemKind, (ItemId, (Int, ItemTimers)))]
-> Feature
-> Maybe TileAction
parseTileAction
(Actor -> Bool
bproj Actor
sb)
(Bool
underFeet Bool -> Bool -> Bool
|| Bool
blockedByItem)
[(ItemKind, (ItemId, (Int, ItemTimers)))]
embedKindList)
[Feature]
feats
if [TileAction] -> Bool
forall a. [a] -> Bool
null [TileAction]
tileActions
Bool -> Bool -> Bool
&& Bool
blockedByItem
Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
underFeet
Bool -> Bool -> Bool
&& TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
tile
then ReqFailure -> m (FailOrCmd ())
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterBlockItem
else ActorId -> Bool -> Point -> [TileAction] -> m (FailOrCmd ())
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> Point -> [TileAction] -> m (FailOrCmd ())
processTileActions ActorId
leader Bool
bumping Point
tpos [TileAction]
tileActions
processTileActions :: forall m. MonadClientUI m
=> ActorId -> Bool -> Point -> [TileAction]
-> m (FailOrCmd ())
processTileActions :: ActorId -> Bool -> Point -> [TileAction] -> m (FailOrCmd ())
processTileActions ActorId
leader Bool
bumping Point
tpos [TileAction]
tas = 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
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
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
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
AspectRecord
sar <- (State -> AspectRecord) -> m AspectRecord
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> AspectRecord) -> m AspectRecord)
-> (State -> AspectRecord) -> m AspectRecord
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> AspectRecord
aspectRecordFromIid (ItemId -> State -> AspectRecord)
-> ItemId -> State -> AspectRecord
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
sb
let leaderIsMist :: Bool
leaderIsMist = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Blast AspectRecord
sar
Bool -> Bool -> Bool
&& Dice -> Int
Dice.infDice (ItemKind -> Dice
IK.idamage (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind (ItemId -> ItemKind) -> ItemId -> ItemKind
forall a b. (a -> b) -> a -> b
$ Actor -> ItemId
btrunk Actor
sb) Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0
tileMinSkill :: Int
tileMinSkill = TileSpeedup -> ContentId TileKind -> Int
Tile.alterMinSkill TileSpeedup
coTileSpeedup (ContentId TileKind -> Int) -> ContentId TileKind -> Int
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
processTA :: Maybe Bool -> [TileAction] -> Bool
-> m (FailOrCmd (Maybe (Bool, Bool)))
processTA :: Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA Maybe Bool
museResult [] Bool
bumpFailed = do
let useResult :: Bool
useResult = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
museResult
FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool))))
-> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall a b. (a -> b) -> a -> b
$ Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
forall a b. b -> Either a b
Right (Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool)))
-> Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
forall a b. (a -> b) -> a -> b
$ if TileSpeedup -> ContentId TileKind -> Bool
Tile.isSuspect TileSpeedup
coTileSpeedup (Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos)
Bool -> Bool -> Bool
|| Bool
useResult Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
bumpFailed
then Maybe (Bool, Bool)
forall a. Maybe a
Nothing
else (Bool, Bool) -> Maybe (Bool, Bool)
forall a. a -> Maybe a
Just (Bool
useResult, Bool
bumpFailed)
processTA Maybe Bool
museResult (TileAction
ta : [TileAction]
rest) Bool
bumpFailed = case TileAction
ta of
EmbedAction (ItemId
iid, (Int, ItemTimers)
_) -> do
let useResult :: Bool
useResult = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
museResult
if | Bool
leaderIsMist
Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Int
tileMinSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 ->
Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
useResult) [TileAction]
rest Bool
bumpFailed
| (Bool -> Bool
not (Bool -> Bool) -> ([Effect] -> Bool) -> [Effect] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
IK.isEffEscape) (ItemKind -> [Effect]
IK.ieffects (ItemKind -> [Effect]) -> ItemKind -> [Effect]
forall a b. (a -> b) -> a -> b
$ ItemId -> ItemKind
getKind ItemId
iid) ->
Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) [TileAction]
rest Bool
False
| Bool
otherwise -> do
FailOrCmd ()
mfail <- m (FailOrCmd ())
forall (m :: * -> *). MonadClientUI m => m (FailOrCmd ())
verifyEscape
case FailOrCmd ()
mfail of
Left FailError
err -> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool))))
-> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd (Maybe (Bool, Bool))
forall a b. a -> Either a b
Left FailError
err
Right () -> Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA (Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True) [TileAction]
rest Bool
False
ToAction{} ->
if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
museResult
Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Int
tileMinSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0)
then FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool))))
-> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall a b. (a -> b) -> a -> b
$ Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
forall a b. b -> Either a b
Right Maybe (Bool, Bool)
forall a. Maybe a
Nothing
else Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA Maybe Bool
museResult [TileAction]
rest Bool
bumpFailed
WithAction [(Int, GroupName ItemKind)]
tools0 GroupName TileKind
_ ->
if Bool -> Bool
not Bool
bumping Bool -> Bool -> Bool
|| [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Int, GroupName ItemKind)]
tools0 then
if Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
True Maybe Bool
museResult then do
[(ItemId, ItemFullKit)]
kitAssG <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
leader [CStore
CGround]
[(ItemId, ItemFullKit)]
kitAssE <- (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)])
-> (State -> [(ItemId, ItemFullKit)]) -> m [(ItemId, ItemFullKit)]
forall a b. (a -> b) -> a -> b
$ ActorId -> [CStore] -> State -> [(ItemId, ItemFullKit)]
kitAssocs ActorId
leader [CStore
CEqp]
let kitAss :: [((CStore, Bool), (ItemId, ItemFullKit))]
kitAss = [(ItemId, ItemFullKit)]
-> [(ItemId, ItemFullKit)]
-> [((CStore, Bool), (ItemId, ItemFullKit))]
listToolsToConsume [(ItemId, ItemFullKit)]
kitAssG [(ItemId, ItemFullKit)]
kitAssE
grps0 :: [(Bool, Int, GroupName ItemKind)]
grps0 = ((Int, GroupName ItemKind) -> (Bool, Int, GroupName ItemKind))
-> [(Int, GroupName ItemKind)] -> [(Bool, Int, GroupName ItemKind)]
forall a b. (a -> b) -> [a] -> [b]
map (\(Int
x, GroupName ItemKind
y) -> (Bool
False, Int
x, GroupName ItemKind
y)) [(Int, GroupName ItemKind)]
tools0
(EnumMap CStore ItemBag
_, [(CStore, (ItemId, ItemFull))]
iidsToApply, [(Bool, Int, GroupName ItemKind)]
grps) =
((EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
[(Bool, Int, GroupName ItemKind)])
-> ((CStore, Bool), (ItemId, ItemFullKit))
-> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
[(Bool, Int, GroupName ItemKind)]))
-> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
[(Bool, Int, GroupName ItemKind)])
-> [((CStore, Bool), (ItemId, ItemFullKit))]
-> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
[(Bool, Int, GroupName ItemKind)])
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
[(Bool, Int, GroupName ItemKind)])
-> ((CStore, Bool), (ItemId, ItemFullKit))
-> (EnumMap CStore ItemBag, [(CStore, (ItemId, ItemFull))],
[(Bool, Int, GroupName ItemKind)])
subtractIidfromGrps (EnumMap CStore ItemBag
forall k a. EnumMap k a
EM.empty, [], [(Bool, Int, GroupName ItemKind)]
grps0) [((CStore, Bool), (ItemId, ItemFullKit))]
kitAss
if [(Bool, Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Bool, Int, GroupName ItemKind)]
grps then do
let hasEffectOrDmg :: (a, (a, ItemFull)) -> Bool
hasEffectOrDmg (a
_, (a
_, ItemFull{ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind})) =
ItemKind -> Dice
IK.idamage ItemKind
itemKind Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
/= Dice
0
Bool -> Bool -> Bool
|| (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Effect -> Bool
IK.forApplyEffect (ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
FailOrCmd ()
mfail <- case ((CStore, (ItemId, ItemFull)) -> Bool)
-> [(CStore, (ItemId, ItemFull))] -> [(CStore, (ItemId, ItemFull))]
forall a. (a -> Bool) -> [a] -> [a]
filter (CStore, (ItemId, ItemFull)) -> Bool
forall a a. (a, (a, ItemFull)) -> Bool
hasEffectOrDmg [(CStore, (ItemId, ItemFull))]
iidsToApply of
[] -> 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 ()
(CStore
store, (ItemId
_, ItemFull
itemFull)) : [(CStore, (ItemId, ItemFull))]
_ ->
LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
verifyToolEffect (Actor -> LevelId
blid Actor
sb) CStore
store ItemFull
itemFull
case FailOrCmd ()
mfail of
Left FailError
err -> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool))))
-> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd (Maybe (Bool, Bool))
forall a b. a -> Either a b
Left FailError
err
Right () -> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool))))
-> FailOrCmd (Maybe (Bool, Bool))
-> m (FailOrCmd (Maybe (Bool, Bool)))
forall a b. (a -> b) -> a -> b
$ Maybe (Bool, Bool) -> FailOrCmd (Maybe (Bool, Bool))
forall a b. b -> Either a b
Right Maybe (Bool, Bool)
forall a. Maybe a
Nothing
else Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA Maybe Bool
museResult [TileAction]
rest Bool
bumpFailed
else Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA Maybe Bool
museResult [TileAction]
rest Bool
bumpFailed
else Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA Maybe Bool
museResult [TileAction]
rest Bool
True
FailOrCmd (Maybe (Bool, Bool))
mfail <- Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA Maybe Bool
forall a. Maybe a
Nothing [TileAction]
tas Bool
False
case FailOrCmd (Maybe (Bool, Bool))
mfail of
Left FailError
err -> 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
$ FailError -> FailOrCmd ()
forall a b. a -> Either a b
Left FailError
err
Right Maybe (Bool, Bool)
Nothing -> 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 ()
Right (Just (Bool
useResult, Bool
bumpFailed)) -> do
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not Bool
useResult Bool -> Bool -> Bool
|| Bool
bumpFailed) ()
[(MsgClassShow, Text)]
blurb <- Point -> LevelId -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
Point -> LevelId -> m [(MsgClassShow, Text)]
lookAtPosition Point
tpos (Actor -> LevelId
blid Actor
sb)
((MsgClassShow, Text) -> m ()) -> [(MsgClassShow, Text)] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
(a -> m ()) -> t a -> m ()
mapM_ ((MsgClassShow -> Text -> m ()) -> (MsgClassShow, Text) -> m ()
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd) [(MsgClassShow, Text)]
blurb
if Bool
bumpFailed then do
HumanCmd -> KM
revCmd <- m (HumanCmd -> KM)
forall (m :: * -> *). MonadClientUI m => m (HumanCmd -> KM)
revCmdMap
let km :: KM
km = HumanCmd -> KM
revCmd HumanCmd
AlterDir
msg :: Text
msg = Text
"bumping is not enough to transform this terrain; modify with the '"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (KM -> String
K.showKM KM
km)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' command instead"
if Bool
useResult then do
MError
merr <- Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg Text
msg
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptAction (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ FailError -> Text
showFailError (FailError -> Text) -> FailError -> Text
forall a b. (a -> b) -> a -> b
$ MError -> FailError
forall a. (?callStack::CallStack) => Maybe a -> a
fromJust MError
merr
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 ()
else Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
msg
else Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"unable to activate nor modify at this time"
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 (FactionKind -> Bool
FK.fcanEscape (FactionKind -> Bool) -> FactionKind -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> FactionKind
gkind Faction
fact)
then Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith
Text
"This is the way out, but where would you go in this alien world?"
else do
(ItemBag
_, Int
total) <- (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> (ItemBag, Int)) -> m (ItemBag, Int))
-> (State -> (ItemBag, Int)) -> m (ItemBag, Int)
forall a b. (a -> b) -> a -> b
$ FactionId -> State -> (ItemBag, Int)
calculateTotal FactionId
side
Int
dungeonTotal <- (State -> Int) -> m Int
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> Int
sgold
let prompt :: Text
prompt | Int
dungeonTotal Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
Text
"You finally reached your goal. Really leave now?"
| Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
Text
"Afraid of the challenge? Leaving so soon and without any treasure? Are you sure?"
| Int
total Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
dungeonTotal =
Text
"You've finally found the way out, but you didn't gather all valuables rumoured to be laying around. Really leave already?"
| Bool
otherwise =
Text
"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 Text
"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 ()
verifyToolEffect :: MonadClientUI m
=> LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
verifyToolEffect :: LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
verifyToolEffect LevelId
lid CStore
store ItemFull
itemFull = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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 LevelId
lid
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
let (Part
name1, Part
powers) = Int
-> FactionId
-> EnumMap FactionId Faction
-> Time
-> ItemFull
-> (Int, ItemTimers)
-> (Part, Part)
partItemShort Int
rwidth FactionId
side EnumMap FactionId Faction
factionD Time
localTime
ItemFull
itemFull (Int, ItemTimers)
quantSingle
objectA :: Text
objectA = [Part] -> Text
makePhrase [Part -> Part
MU.AW Part
name1, Part
powers]
prompt :: Text
prompt = Text
"Do you really want to transform the terrain potentially using"
Text -> Text -> Text
<+> Text
objectA Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
store
Text -> Text -> Text
<+> Text
"that may cause substantial side-effects?"
objectThe :: Text
objectThe = [Part] -> Text
makePhrase [Part
"the", Part
name1]
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 (Text -> m (FailOrCmd ())) -> Text -> m (FailOrCmd ())
forall a b. (a -> b) -> a -> b
$ Text
"replace" Text -> Text -> Text
<+> Text
objectThe Text -> Text -> Text
<+> Text
"and try again"
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 ()
alterWithPointerHuman :: MonadClientUI m
=> ActorId -> m (FailOrCmd RequestTimed)
alterWithPointerHuman :: ActorId -> m (FailOrCmd RequestTimed)
alterWithPointerHuman ActorId
leader = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rWidthMax :: RuleContent -> Int
rWidthMax :: Int
rWidthMax, Int
rHeightMax :: RuleContent -> Int
rHeightMax :: Int
rHeightMax}} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let p :: Point
p = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
if (Int, Int, Int, Int) -> Point -> Bool
insideP (Int
0, Int
0, Int
rWidthMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1, Int
rHeightMax Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Point
p
then ActorId -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (FailOrCmd RequestTimed)
alterTileAtPos ActorId
leader Point
p
else Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
closeDirHuman :: MonadClientUI m
=> ActorId -> m (FailOrCmd RequestTimed)
closeDirHuman :: ActorId -> m (FailOrCmd RequestTimed)
closeDirHuman ActorId
leader = 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
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
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
let vPts :: [Point]
vPts = Point -> [Point]
vicinityUnsafe (Point -> [Point]) -> Point -> [Point]
forall a b. (a -> b) -> a -> b
$ Actor -> Point
bpos Actor
b
openPts :: [Point]
openPts = (Point -> Bool) -> [Point] -> [Point]
forall a. (a -> Bool) -> [a] -> [a]
filter (TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup (ContentId TileKind -> Bool)
-> (Point -> ContentId TileKind) -> Point -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Level -> Point -> ContentId TileKind
at Level
lvl) [Point]
vPts
case [Point]
openPts of
[] -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseNothing
[Point
o] -> ActorId -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (FailOrCmd RequestTimed)
closeTileAtPos ActorId
leader Point
o
[Point]
_ -> ActorId -> Text -> m (Maybe Point)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Text -> m (Maybe Point)
pickPoint ActorId
leader Text
"close" m (Maybe Point)
-> (Maybe Point -> m (FailOrCmd RequestTimed))
-> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Maybe Point
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"never mind"
Just Point
p -> ActorId -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Point -> m (FailOrCmd RequestTimed)
closeTileAtPos ActorId
leader Point
p
closeTileAtPos :: MonadClientUI m
=> ActorId -> Point -> m (FailOrCmd RequestTimed)
closeTileAtPos :: ActorId -> Point -> m (FailOrCmd RequestTimed)
closeTileAtPos ActorId
leader Point
tpos = 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
Skills
actorCurAndMaxSk <- (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
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
Bool
alterable <- (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
$ LevelId -> Point -> State -> Bool
tileAlterable (Actor -> LevelId
blid Actor
b) 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
b
let alterSkill :: Int
alterSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkAlter Skills
actorCurAndMaxSk
t :: ContentId TileKind
t = Level
lvl Level -> Point -> ContentId TileKind
`at` Point
tpos
isOpen :: Bool
isOpen = TileSpeedup -> ContentId TileKind -> Bool
Tile.isClosable TileSpeedup
coTileSpeedup ContentId TileKind
t
isClosed :: Bool
isClosed = TileSpeedup -> ContentId TileKind -> Bool
Tile.isOpenable TileSpeedup
coTileSpeedup ContentId TileKind
t
case (Bool
alterable, Bool
isClosed, Bool
isOpen) of
(Bool
False, Bool
_, Bool
_) -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseNothing
(Bool
True, Bool
False, Bool
False) -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseNonClosable
(Bool
True, Bool
True, Bool
False) -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseClosed
(Bool
True, Bool
True, Bool
True) -> String -> m (FailOrCmd RequestTimed)
forall a. (?callStack::CallStack) => String -> a
error String
"TileKind content validation"
(Bool
True, Bool
False, Bool
True) ->
if | Point
tpos Point -> Point -> Int
`chessDist` Actor -> Point
bpos Actor
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
1
-> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseDistant
| Int
alterSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1
-> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
AlterUnskilled
| 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
Bool -> ActorId -> Point -> Text -> m ()
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ActorId -> Point -> Text -> m ()
msgAddDone Bool
True ActorId
leader Point
tpos Text
"close"
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 (Point -> RequestTimed
ReqAlter Point
tpos)
msgAddDone :: MonadClientUI m => Bool -> ActorId -> Point -> Text -> m ()
msgAddDone :: Bool -> ActorId -> Point -> Text -> m ()
msgAddDone Bool
mentionTile ActorId
leader Point
p Text
verb = do
COps{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
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
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
let tname :: Text
tname = 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 -> TileKind) -> ContentId TileKind -> TileKind
forall a b. (a -> b) -> a -> b
$ Level
lvl Level -> Point -> ContentId TileKind
`at` Point
p
s :: Text
s = case Text -> [Text]
T.words Text
tname of
[] -> Text
"thing"
(Text
"open" : [Text]
xs) -> [Text] -> Text
T.unwords [Text]
xs
[Text]
_ -> Text
tname
object :: Text
object | Bool
mentionTile = Text
"the" Text -> Text -> Text
<+> Text
s
| Bool
otherwise = Text
""
v :: Vector
v = Point
p Point -> Point -> Vector
`vectorToFrom` Actor -> Point
bpos Actor
b
dir :: Text
dir | Vector
v Vector -> Vector -> Bool
forall a. Eq a => a -> a -> Bool
== Int -> Int -> Vector
Vector Int
0 Int
0 = Text
"underneath"
| Bool
otherwise = Vector -> Text
compassText Vector
v
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionComplete (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"You" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
<+> Text
object Text -> Text -> Text
<+> Text
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"."
pickPoint :: MonadClientUI m => ActorId -> Text -> m (Maybe Point)
pickPoint :: ActorId -> Text -> m (Maybe Point)
pickPoint ActorId
leader Text
verb = do
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
UIOptions{Bool
uVi :: UIOptions -> Bool
uVi :: Bool
uVi, Bool
uLeftHand :: UIOptions -> Bool
uLeftHand :: Bool
uLeftHand} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
let dirKeys :: [Key]
dirKeys = Bool -> Bool -> [Key]
K.dirAllKey Bool
uVi Bool
uLeftHand
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) [Key]
dirKeys
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Text
"Where to" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"? [movement key] [pointer]"
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
Key
K.LeftButtonRelease -> do
PointUI
pUI <- (SessionUI -> PointUI) -> m PointUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> PointUI
spointer
let p :: Point
p = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
Maybe Point -> m (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Point -> m (Maybe Point)) -> Maybe Point -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Maybe Point
forall a. a -> Maybe a
Just Point
p
Key
_ -> Maybe Point -> m (Maybe Point)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Point -> m (Maybe Point)) -> Maybe Point -> m (Maybe Point)
forall a b. (a -> b) -> a -> b
$ Point -> Vector -> Point
shift (Actor -> Point
bpos Actor
b) (Vector -> Point) -> Maybe Vector -> Maybe Point
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Key] -> KM -> Maybe Vector
K.handleDir [Key]
dirKeys KM
km
helpHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
helpHuman :: (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
helpHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
ccui :: CCUI
ccui@CCUI{InputContent
coinput :: InputContent
coinput :: CCUI -> InputContent
coinput, coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight, ([String], [[String]])
rintroScreen :: ScreenContent -> ([String], [[String]])
rintroScreen :: ([String], [[String]])
rintroScreen}}
<- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
fontSetup :: FontSetup
fontSetup@FontSetup{DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
ContentId ModeKind
gameModeId <- (State -> ContentId ModeKind) -> m (ContentId ModeKind)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> ContentId ModeKind
sgameModeId
EnumMap DisplayFont Overlay
modeOv <- Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool -> ContentId ModeKind -> m (EnumMap DisplayFont Overlay)
describeMode Bool
True ContentId ModeKind
gameModeId
Bool
curTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
scurTutorial
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
let displayTutorialHints :: Bool
displayTutorialHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
modeH :: (Text, (EnumMap DisplayFont Overlay, [KYX]))
modeH = ( Text
"Press SPACE or PGDN to advance or ESC to see the map again."
, (EnumMap DisplayFont Overlay
modeOv, []) )
keyH :: [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
keyH = CCUI -> FontSetup -> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
keyHelp CCUI
ccui FontSetup
fontSetup
packIntoScreens :: [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens :: [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens [] [[String]]
acc Int
_ = [[String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String
""] ([[String]] -> [[String]]
forall a. [a] -> [a]
reverse [[String]]
acc)]
packIntoScreens ([] : [[String]]
ls) [] Int
_ =
[[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens [[String]]
ls [] Int
0
packIntoScreens ([String]
l : [[String]]
ls) [] Int
h = Bool -> [[String]] -> [[String]]
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Int
h Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) ([[String]] -> [[String]]) -> [[String]] -> [[String]]
forall a b. (a -> b) -> a -> b
$
if [String] -> Int
forall a. [a] -> Int
length [String]
l Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3
then [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens [[String]]
ls [[String]
l] ([String] -> Int
forall a. [a] -> Int
length [String]
l)
else let ([String]
screen, [String]
rest) = Int -> [String] -> ([String], [String])
forall a. Int -> [a] -> ([a], [a])
splitAt (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3) [String]
l
in [String]
screen [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens ([String]
rest [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [[String]]
ls) [] Int
0
packIntoScreens ([String]
l : [[String]]
ls) [[String]]
acc Int
h =
if [String] -> Int
forall a. [a] -> Int
length [String]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
3
then [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens [[String]]
ls ([String]
l [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [[String]]
acc) ([String] -> Int
forall a. [a] -> Int
length [String]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
h)
else [String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [String
""] ([[String]] -> [[String]]
forall a. [a] -> [a]
reverse [[String]]
acc) [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens ([String]
l [String] -> [[String]] -> [[String]]
forall a. a -> [a] -> [a]
: [[String]]
ls) [] Int
0
manualScreens :: [[String]]
manualScreens = [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens (([String], [[String]]) -> [[String]]
forall a b. (a, b) -> b
snd ([String], [[String]])
rintroScreen) [] Int
0
sideBySide :: ([AttrLine], [AttrLine]) -> [Overlay]
sideBySide =
if DisplayFont -> Bool
isSquareFont DisplayFont
monoFont
then \([AttrLine]
screen1, [AttrLine]
screen2) ->
([AttrLine] -> Overlay) -> [[AttrLine]] -> [Overlay]
forall a b. (a -> b) -> [a] -> [b]
map [AttrLine] -> Overlay
offsetOverlay ([[AttrLine]] -> [Overlay]) -> [[AttrLine]] -> [Overlay]
forall a b. (a -> b) -> a -> b
$ ([AttrLine] -> Bool) -> [[AttrLine]] -> [[AttrLine]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> ([AttrLine] -> Bool) -> [AttrLine] -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [AttrLine] -> Bool
forall a. [a] -> Bool
null) [[AttrLine]
screen1, [AttrLine]
screen2]
else \([AttrLine]
screen1, [AttrLine]
screen2) ->
[[AttrLine] -> Overlay
offsetOverlay [AttrLine]
screen1
Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Int -> Overlay -> Overlay
xtranslateOverlay Int
rwidth ([AttrLine] -> Overlay
offsetOverlay [AttrLine]
screen2)]
listPairs :: [[a]] -> [([a], [a])]
listPairs ([a]
a : [a]
b : [[a]]
rest) = ([a]
a, [a]
b) ([a], [a]) -> [([a], [a])] -> [([a], [a])]
forall a. a -> [a] -> [a]
: [[a]] -> [([a], [a])]
listPairs [[a]]
rest
listPairs [[a]
a] = [([a]
a, [])]
listPairs [] = []
manualOvs :: [EnumMap DisplayFont Overlay]
manualOvs = (Overlay -> EnumMap DisplayFont Overlay)
-> [Overlay] -> [EnumMap DisplayFont Overlay]
forall a b. (a -> b) -> [a] -> [b]
map (DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
monoFont)
([Overlay] -> [EnumMap DisplayFont Overlay])
-> [Overlay] -> [EnumMap DisplayFont Overlay]
forall a b. (a -> b) -> a -> b
$ (([AttrLine], [AttrLine]) -> [Overlay])
-> [([AttrLine], [AttrLine])] -> [Overlay]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([AttrLine], [AttrLine]) -> [Overlay]
sideBySide ([([AttrLine], [AttrLine])] -> [Overlay])
-> [([AttrLine], [AttrLine])] -> [Overlay]
forall a b. (a -> b) -> a -> b
$ [[AttrLine]] -> [([AttrLine], [AttrLine])]
forall a. [[a]] -> [([a], [a])]
listPairs
([[AttrLine]] -> [([AttrLine], [AttrLine])])
-> [[AttrLine]] -> [([AttrLine], [AttrLine])]
forall a b. (a -> b) -> a -> b
$ ([String] -> [AttrLine]) -> [[String]] -> [[AttrLine]]
forall a b. (a -> b) -> [a] -> [b]
map ((AttrLine
emptyAttrLine AttrLine -> [AttrLine] -> [AttrLine]
forall a. a -> [a] -> [a]
:) ([AttrLine] -> [AttrLine])
-> ([String] -> [AttrLine]) -> [String] -> [AttrLine]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> AttrLine) -> [String] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map String -> AttrLine
stringToAL) [[String]]
manualScreens
addMnualHeader :: a -> (a, (a, [a]))
addMnualHeader a
ov =
( a
"Showing PLAYING.md (best viewed in the browser)."
, (a
ov, []) )
manualH :: [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
manualH = (EnumMap DisplayFont Overlay
-> (Text, (EnumMap DisplayFont Overlay, [KYX])))
-> [EnumMap DisplayFont Overlay]
-> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
forall a b. (a -> b) -> [a] -> [b]
map EnumMap DisplayFont Overlay
-> (Text, (EnumMap DisplayFont Overlay, [KYX]))
forall a a a. IsString a => a -> (a, (a, [a]))
addMnualHeader [EnumMap DisplayFont Overlay]
manualOvs
splitHelp :: (Text, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitHelp (Text
t, (EnumMap DisplayFont Overlay, [KYX])
okx) =
FontSetup
-> Bool
-> Int
-> Int
-> Int
-> AttrString
-> [KM]
-> (EnumMap DisplayFont Overlay, [KYX])
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitOKX FontSetup
fontSetup Bool
True Int
rwidth Int
rheight Int
rwidth (Text -> AttrString
textToAS Text
t)
[KM
K.spaceKM, KM
K.returnKM, KM
K.escKM] (EnumMap DisplayFont Overlay, [KYX])
okx
sli :: Slideshow
sli = FontSetup
-> Bool -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
toSlideshow FontSetup
fontSetup Bool
displayTutorialHints
([(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow)
-> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
forall a b. (a -> b) -> a -> b
$ ((Text, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])])
-> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
-> [(EnumMap DisplayFont Overlay, [KYX])]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (Text, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitHelp ([(Text, (EnumMap DisplayFont Overlay, [KYX]))]
-> [(EnumMap DisplayFont Overlay, [KYX])])
-> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
-> [(EnumMap DisplayFont Overlay, [KYX])]
forall a b. (a -> b) -> a -> b
$ (Text, (EnumMap DisplayFont Overlay, [KYX]))
modeH (Text, (EnumMap DisplayFont Overlay, [KYX]))
-> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
-> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
forall a. a -> [a] -> [a]
: [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
keyH [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
-> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
-> [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
forall a. [a] -> [a] -> [a]
++ [(Text, (EnumMap DisplayFont Overlay, [KYX]))]
manualH
KeyOrSlot
ekm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
"help" ColorMode
ColorFull Bool
True Slideshow
sli
[KM
K.spaceKM, KM
K.returnKM, KM
K.escKM]
case KeyOrSlot
ekm of
Left KM
km | 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
Left KM
km | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.returnKM -> do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Press RET when a command help text is selected to invoke the command."
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
Left 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
Just ([CmdCategory]
_desc, Text
_cats, HumanCmd
cmd) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Maybe CmdTriple
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 Text
"never mind"
Right MenuSlot
_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
"" String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm
hintHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
hintHuman :: (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
hintHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
Bool
sreportNull <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sreportNull
if Bool
sreportNull then do
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
else
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
helpHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
dashboardHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
dashboardHuman :: (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
dashboardHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
CCUI{InputContent
coinput :: InputContent
coinput :: CCUI -> InputContent
coinput, coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
fontSetup :: FontSetup
fontSetup@FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
Bool
curTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
scurTutorial
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
let displayTutorialHints :: Bool
displayTutorialHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
offsetCol2 :: Int
offsetCol2 = Int
3
(EnumMap DisplayFont Overlay
ov0, [KYX]
kxs0) = InputContent
-> DisplayFont
-> DisplayFont
-> Int
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> (EnumMap DisplayFont Overlay, [KYX])
okxsN InputContent
coinput DisplayFont
monoFont DisplayFont
propFont Int
offsetCol2 (Bool -> HumanCmd -> Bool
forall a b. a -> b -> a
const Bool
False)
Bool
False CmdCategory
CmdDashboard ([], [], []) ([], [])
al1 :: AttrString
al1 = Text -> AttrString
textToAS Text
"Dashboard"
splitHelp :: (AttrString, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitHelp (AttrString
al, (EnumMap DisplayFont Overlay, [KYX])
okx) = FontSetup
-> Bool
-> Int
-> Int
-> Int
-> AttrString
-> [KM]
-> (EnumMap DisplayFont Overlay, [KYX])
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitOKX FontSetup
fontSetup Bool
False Int
rwidth (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
rwidth
AttrString
al [KM
K.returnKM, KM
K.escKM] (EnumMap DisplayFont Overlay, [KYX])
okx
sli :: Slideshow
sli = FontSetup
-> Bool -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
toSlideshow FontSetup
fontSetup Bool
displayTutorialHints
([(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow)
-> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
forall a b. (a -> b) -> a -> b
$ (AttrString, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitHelp (AttrString
al1, (EnumMap DisplayFont Overlay
ov0, [KYX]
kxs0))
extraKeys :: [KM]
extraKeys = [KM
K.returnKM, KM
K.escKM]
KeyOrSlot
ekm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
"dashboard" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
extraKeys
case KeyOrSlot
ekm of
Left 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
Maybe CmdTriple
_ | 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 Text
"never mind"
Maybe CmdTriple
_ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.returnKM -> do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Press RET when a menu name is selected to browse the menu."
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 ([CmdCategory]
_desc, Text
_cats, HumanCmd
cmd) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Maybe CmdTriple
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 Text
"never mind"
Right MenuSlot
_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
"" String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm
itemMenuHuman :: MonadClientUI m
=> ActorId
-> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
ActorId
leader KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = 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
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
fontSetup :: FontSetup
fontSetup@FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
case Maybe (ItemId, CStore, Bool)
itemSel of
Just (ItemId
iid, CStore
fromCStore, Bool
_) -> do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
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 (Int, ItemTimers)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Maybe (Int, ItemTimers)
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 Text
"no item to open item menu for"
Just (Int, ItemTimers)
kit -> do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
Skills
actorCurAndMaxSk <- (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 FactionId
side ItemId
iid
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 (ActorId
aid, (Actor
_, 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
markParagraphs :: Bool
markParagraphs = Int
rheight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
45
meleeSkill :: Int
meleeSkill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee Skills
actorCurAndMaxSk
partRawActor :: ActorId -> m Part
partRawActor ActorId
aid = (SessionUI -> Part) -> m Part
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession (ActorUI -> Part
partActor (ActorUI -> Part) -> (SessionUI -> ActorUI) -> SessionUI -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ActorId -> SessionUI -> ActorUI
getActorUI ActorId
aid)
ppLoc :: ActorId -> CStore -> m String
ppLoc ActorId
aid CStore
store = do
[Part]
parts <- (ActorId -> m Part) -> Bool -> Container -> m [Part]
forall (m :: * -> *).
MonadClientUI m =>
(ActorId -> m Part) -> Bool -> Container -> m [Part]
ppContainerWownW ActorId -> m Part
forall (m :: * -> *). MonadClientUI m => ActorId -> m Part
partRawActor
Bool
False
(ActorId -> CStore -> Container
CActor ActorId
aid CStore
store)
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
$! String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack ([Part] -> Text
makePhrase [Part]
parts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
dmode :: ItemDialogMode
dmode = CStore -> ItemDialogMode
MStore CStore
fromCStore
[String]
foundTexts <- ((ActorId, (Actor, CStore)) -> m String)
-> [(ActorId, (Actor, CStore))] -> m [String]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (\(ActorId
aid, (Actor
_, CStore
store)) -> ActorId -> CStore -> m String
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> CStore -> m String
ppLoc ActorId
aid CStore
store) [(ActorId, (Actor, CStore))]
foundAlt
(Overlay
ovLab, Overlay
ovDesc) <-
Bool
-> Int
-> ItemDialogMode
-> ItemId
-> (Int, ItemTimers)
-> ItemFull
-> Int
-> m (Overlay, Overlay)
forall (m :: * -> *).
MonadClientUI m =>
Bool
-> Int
-> ItemDialogMode
-> ItemId
-> (Int, ItemTimers)
-> ItemFull
-> Int
-> m (Overlay, Overlay)
itemDescOverlays Bool
markParagraphs Int
meleeSkill ItemDialogMode
dmode ItemId
iid (Int, ItemTimers)
kit
ItemFull
itemFull Int
rwidth
let foundPrefix :: AttrString
foundPrefix = Text -> AttrString
textToAS (Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$
if [String] -> Bool
forall a. [a] -> Bool
null [String]
foundTexts then Text
"" else Text
"The item is also in:"
ovPrefix :: Overlay
ovPrefix = Int -> Overlay -> Overlay
ytranslateOverlay (Overlay -> Int
forall a. [a] -> Int
length Overlay
ovDesc)
(Overlay -> Overlay) -> Overlay -> Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay
([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth AttrString
foundPrefix
ystart :: Int
ystart = Overlay -> Int
forall a. [a] -> Int
length Overlay
ovDesc Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
ovPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
xstart :: Int
xstart = DisplayFont -> AttrString -> Int
forall a. DisplayFont -> [a] -> Int
textSize DisplayFont
monoFont (AttrCharW32
Color.spaceAttrW32
AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrLine -> AttrString
attrLine ((PointUI, AttrLine) -> AttrLine
forall a b. (a, b) -> b
snd ((PointUI, AttrLine) -> AttrLine)
-> (PointUI, AttrLine) -> AttrLine
forall a b. (a -> b) -> a -> b
$ Overlay -> (PointUI, AttrLine)
forall a. [a] -> a
last Overlay
ovPrefix))
foundKeys :: [KM]
foundKeys = (Int -> KM) -> [Int] -> [KM]
forall a b. (a -> b) -> [a] -> [b]
map (Modifier -> Key -> KM
K.KM Modifier
K.NoModifier (Key -> KM) -> (Int -> Key) -> Int -> KM
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Key
K.Fun)
[Int
1 .. [(ActorId, (Actor, CStore))] -> Int
forall a. [a] -> Int
length [(ActorId, (Actor, CStore))]
foundAlt]
let ks :: [(KM, String)]
ks = [KM] -> [String] -> [(KM, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip [KM]
foundKeys [String]
foundTexts
width :: Int
width = if DisplayFont -> Bool
isSquareFont DisplayFont
monoFont then Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth else Int
rwidth
(Overlay
ovFoundRaw, [KYX]
kxsFound) = DisplayFont
-> Int -> Int -> Int -> [(KM, String)] -> (Overlay, [KYX])
wrapOKX DisplayFont
monoFont Int
ystart Int
xstart Int
width [(KM, String)]
ks
ovFound :: Overlay
ovFound = Overlay
ovPrefix Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
ovFoundRaw
Report
report <- Bool -> m Report
forall (m :: * -> *). MonadClientUI m => Bool -> m Report
getReportUI Bool
True
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
Maybe (LevelId, Point)
mstash <- (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point)))
-> (State -> Maybe (LevelId, Point)) -> m (Maybe (LevelId, Point))
forall a b. (a -> b) -> a -> b
$ \State
s -> Faction -> Maybe (LevelId, Point)
gstash (Faction -> Maybe (LevelId, Point))
-> Faction -> Maybe (LevelId, Point)
forall a b. (a -> b) -> a -> b
$ State -> EnumMap FactionId Faction
sfactionD State
s EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side
Bool
curTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
scurTutorial
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
let displayTutorialHints :: Bool
displayTutorialHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
calmE :: Bool
calmE = Actor -> Skills -> Bool
calmEnough Actor
b Skills
actorCurAndMaxSk
greyedOut :: HumanCmd -> Bool
greyedOut HumanCmd
cmd = Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp
Bool -> Bool -> Bool
|| Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround
Bool -> Bool -> Bool
|| case HumanCmd
cmd of
ByAimMode AimModeCmd{HumanCmd
aiming :: AimModeCmd -> HumanCmd
exploration :: AimModeCmd -> HumanCmd
aiming :: HumanCmd
exploration :: HumanCmd
..} ->
HumanCmd -> Bool
greyedOut HumanCmd
exploration Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
aiming
ComposeIfLocal HumanCmd
cmd1 HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
ComposeUnlessError HumanCmd
cmd1 HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
Compose2ndLocal HumanCmd
cmd1 HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
MoveItem [CStore]
stores CStore
destCStore Maybe Text
_ Bool
_ ->
CStore
fromCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore]
stores
Bool -> Bool -> Bool
|| CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CEqp Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
|| Actor -> Int -> Bool
eqpOverfull Actor
b Int
1)
Bool -> Bool -> Bool
|| CStore
destCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround Bool -> Bool -> Bool
&& Maybe (LevelId, Point)
mstash Maybe (LevelId, Point) -> Maybe (LevelId, Point) -> Bool
forall a. Eq a => a -> a -> Bool
== (LevelId, Point) -> Maybe (LevelId, Point)
forall a. a -> Maybe a
Just (Actor -> LevelId
blid Actor
b, Actor -> Point
bpos Actor
b)
Apply{} ->
let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply Skills
actorCurAndMaxSk
in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False
(Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ RuleContent
-> Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> (Int, ItemTimers)
-> Either ReqFailure Bool
permittedApply RuleContent
corule Time
localTime Int
skill Bool
calmE
(CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
fromCStore) ItemFull
itemFull (Int, ItemTimers)
kit
Project{} ->
let skill :: Int
skill = Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkProject Skills
actorCurAndMaxSk
in Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Either ReqFailure Bool -> Bool
forall b a. b -> Either a b -> b
fromRight Bool
False
(Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
False Int
skill Bool
calmE ItemFull
itemFull
HumanCmd
_ -> Bool
False
fmt :: Int -> Text -> Text -> Text
fmt Int
n Text
k Text
h = Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyLeft Int
n Char
' ' Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h
offsetCol2 :: Int
offsetCol2 = Int
11
keyCaption :: Text
keyCaption = Int -> Text -> Text -> Text
fmt Int
offsetCol2 Text
"keys" Text
"command"
offset :: Int
offset = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
maxYofOverlay (Overlay
ovDesc Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
ovFound)
(EnumMap DisplayFont Overlay
ov0, [KYX]
kxs0) = Int
-> Int
-> (EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX])
xytranslateOKX Int
0 Int
offset ((EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX]))
-> (EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX])
forall a b. (a -> b) -> a -> b
$
InputContent
-> DisplayFont
-> DisplayFont
-> Int
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> (EnumMap DisplayFont Overlay, [KYX])
okxsN InputContent
coinput DisplayFont
monoFont DisplayFont
propFont Int
offsetCol2 HumanCmd -> Bool
greyedOut
Bool
True CmdCategory
CmdItemMenu ([], [], [Text
"", Text
keyCaption]) ([], [])
t0 :: Text
t0 = [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) Part
"choose"
, Part
"an item", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
fromCStore ]
alRep :: AttrString
alRep = (AttrString -> AttrString -> AttrString)
-> AttrString -> [AttrString] -> AttrString
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr AttrString -> AttrString -> AttrString
(<+:>) [] ([AttrString] -> AttrString) -> [AttrString] -> AttrString
forall a b. (a -> b) -> a -> b
$ Bool -> Report -> [AttrString]
renderReport Bool
True Report
report
al1 :: AttrString
al1 | AttrString -> Bool
forall a. [a] -> Bool
null AttrString
alRep = Text -> AttrString
textToAS Text
t0
| Bool
otherwise = AttrString
alRep AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ String -> AttrString
stringToAS String
"\n" AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ Text -> AttrString
textToAS Text
t0
splitHelp :: (AttrString, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitHelp (AttrString
al, (EnumMap DisplayFont Overlay, [KYX])
okx) =
FontSetup
-> Bool
-> Int
-> Int
-> Int
-> AttrString
-> [KM]
-> (EnumMap DisplayFont Overlay, [KYX])
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitOKX FontSetup
fontSetup Bool
False Int
rwidth (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2) Int
rwidth AttrString
al
[KM
K.spaceKM, KM
K.escKM] (EnumMap DisplayFont Overlay, [KYX])
okx
sli :: Slideshow
sli = FontSetup
-> Bool -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
toSlideshow FontSetup
fontSetup Bool
displayTutorialHints
([(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow)
-> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
forall a b. (a -> b) -> a -> b
$ (AttrString, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitHelp ( AttrString
al1
, ( (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
squareFont Overlay
ovLab
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
propFont Overlay
ovDesc
(EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ (Overlay -> Overlay -> Overlay)
-> DisplayFont
-> Overlay
-> EnumMap DisplayFont Overlay
-> EnumMap DisplayFont Overlay
forall k a.
Enum k =>
(a -> a -> a) -> k -> a -> EnumMap k a -> EnumMap k a
EM.insertWith Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
(++) DisplayFont
monoFont Overlay
ovFound EnumMap DisplayFont 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
KeyOrSlot
ekm <- String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
forall (m :: * -> *).
MonadClientUI m =>
String -> ColorMode -> Bool -> Slideshow -> [KM] -> m KeyOrSlot
displayChoiceScreen String
"item menu" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
extraKeys
case KeyOrSlot
ekm of
Left 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
Maybe CmdTriple
_ | 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 Text
"never mind"
Maybe CmdTriple
_ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM ->
ActorId
-> (KM -> HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> (KM -> HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode
-> m (Either MError ReqUI)
chooseItemMenuHuman ActorId
leader KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM ItemDialogMode
dmode
Maybe CmdTriple
_ | 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 Int
n} -> do
let (ActorId
newAid, (Actor
bNew, CStore
newCStore)) = [(ActorId, (Actor, CStore))]
foundAlt [(ActorId, (Actor, CStore))] -> Int -> (ActorId, (Actor, CStore))
forall a. [a] -> Int -> a
!! (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
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.! 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 banned :: Bool
banned = Faction -> Bool
bannedPointmanSwitchBetweenLevels 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
banned
then 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
else 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
False 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
$ \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)}
ActorId
-> (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
itemMenuHuman ActorId
newAid KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
KM
_ -> 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
"" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
Just ([CmdCategory]
_desc, Text
_cats, 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
$ \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)}
KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Maybe CmdTriple
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 Text
"never mind"
Right MenuSlot
_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
"" String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm
Maybe (ItemId, CStore, Bool)
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 Text
"no item to open item menu for"
chooseItemMenuHuman :: MonadClientUI m
=> ActorId
-> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode
-> m (Either MError ReqUI)
ActorId
leader1 KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM ItemDialogMode
c1 = do
FailOrCmd ActorId
res2 <- ActorId -> Bool -> ItemDialogMode -> m (FailOrCmd ActorId)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> Bool -> ItemDialogMode -> m (FailOrCmd ActorId)
chooseItemDialogMode ActorId
leader1 Bool
True ItemDialogMode
c1
case FailOrCmd ActorId
res2 of
Right ActorId
leader2 -> ActorId
-> (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
ActorId
-> (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
itemMenuHuman ActorId
leader2 KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
Left 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
generateMenu :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> FontOverlayMap
-> [(Text, HumanCmd, Maybe HumanCmd, Maybe FontOverlayMap)]
-> [String]
-> String
-> m (Either MError ReqUI)
KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM EnumMap DisplayFont Overlay
blurb [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
kdsRaw [String]
gameInfo String
menuName = 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
CCUI{ coinput :: CCUI -> InputContent
coinput=InputContent{Map HumanCmd [KM]
brevMap :: Map HumanCmd [KM]
brevMap :: InputContent -> Map HumanCmd [KM]
brevMap}
, coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rheight :: Int
rheight :: ScreenContent -> Int
rheight, String
rwebAddress :: ScreenContent -> String
rwebAddress :: String
rwebAddress} } <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let matchKM :: MenuSlot
-> (Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
-> (KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))
matchKM MenuSlot
slot kd :: (Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
kd@(Text
_, HumanCmd
cmd, Maybe HumanCmd
_, Maybe (EnumMap DisplayFont Overlay)
_) = case HumanCmd -> Map HumanCmd [KM] -> Maybe [KM]
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup HumanCmd
cmd Map HumanCmd [KM]
brevMap of
Just (KM
km : [KM]
_) -> (KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km, (Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
kd)
Maybe [KM]
_ -> (MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
slot, (Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
kd)
kds :: [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
kds = (MenuSlot
-> (Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
-> (KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))))
-> [MenuSlot]
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith MenuSlot
-> (Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
-> (KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))
matchKM [MenuSlot]
natSlots [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
kdsRaw
bindings :: [(KeyOrSlot, AttrString)]
bindings =
let attrCursor :: Attr
attrCursor = Attr
Color.defAttr {bg :: Highlight
Color.bg = Highlight
Color.HighlightNoneCursor}
highAttr :: AttrChar -> AttrChar
highAttr AttrChar
ac = AttrChar
ac {acAttr :: Attr
Color.acAttr = Attr
attrCursor}
highW32 :: AttrCharW32 -> AttrCharW32
highW32 = AttrChar -> AttrCharW32
Color.attrCharToW32 (AttrChar -> AttrCharW32)
-> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrCharW32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrChar -> AttrChar
highAttr (AttrChar -> AttrChar)
-> (AttrCharW32 -> AttrChar) -> AttrCharW32 -> AttrChar
forall b c a. (b -> c) -> (a -> b) -> a -> c
. AttrCharW32 -> AttrChar
Color.attrCharFromW32
markFirst :: Text -> AttrString
markFirst Text
d = AttrString -> AttrString
markFirstAS (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS Text
d
markFirstAS :: AttrString -> AttrString
markFirstAS [] = []
markFirstAS (AttrCharW32
ac : AttrString
rest) = AttrCharW32 -> AttrCharW32
highW32 AttrCharW32
ac AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: AttrString
rest
fmt :: (a, (Text, b, c, d)) -> (a, AttrString)
fmt (a
ekm, (Text
d, b
_, c
_, d
_)) = (a
ekm, Text -> AttrString
markFirst Text
d)
in ((KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))
-> (KeyOrSlot, AttrString))
-> [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
-> [(KeyOrSlot, AttrString)]
forall a b. (a -> b) -> [a] -> [b]
map (KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))
-> (KeyOrSlot, AttrString)
forall a b c d. (a, (Text, b, c, d)) -> (a, AttrString)
fmt [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
kds
generate :: Int -> (KeyOrSlot, AttrString) -> KYX
generate :: Int -> (KeyOrSlot, AttrString) -> KYX
generate Int
y (KeyOrSlot
ekm, AttrString
binding) =
(KeyOrSlot
ekm, (Int -> Int -> PointUI
PointUI Int
0 Int
y, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
squareFont (AttrString -> Int
forall a. [a] -> Int
length AttrString
binding)))
okxBindings :: (EnumMap DisplayFont Overlay, [KYX])
okxBindings = ( DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont
(Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ ((KeyOrSlot, AttrString) -> AttrLine)
-> [(KeyOrSlot, AttrString)] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine)
-> ((KeyOrSlot, AttrString) -> AttrString)
-> (KeyOrSlot, AttrString)
-> AttrLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (KeyOrSlot, AttrString) -> AttrString
forall a b. (a, b) -> b
snd) [(KeyOrSlot, AttrString)]
bindings
, (Int -> (KeyOrSlot, AttrString) -> KYX)
-> [Int] -> [(KeyOrSlot, AttrString)] -> [KYX]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (KeyOrSlot, AttrString) -> KYX
generate [Int
0..] [(KeyOrSlot, AttrString)]
bindings )
titleLine :: String
titleLine =
RuleContent -> String
rtitle RuleContent
corule String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion (RuleContent -> Version
rexeVersion RuleContent
corule) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" "
titleAndInfo :: [AttrLine]
titleAndInfo = (String -> AttrLine) -> [String] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map String -> AttrLine
stringToAL
([ String
""
, String
titleLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rwebAddress String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"]"
, String
"" ]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
gameInfo)
webButton :: KYX
webButton = ( KM -> KeyOrSlot
forall a b. a -> Either a b
Left (KM -> KeyOrSlot) -> KM -> KeyOrSlot
forall a b. (a -> b) -> a -> b
$ Char -> KM
K.mkChar Char
'@'
, ( Int -> Int -> PointUI
PointUI (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* String -> Int
forall a. [a] -> Int
length String
titleLine) Int
1
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
squareFont (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
length String
rwebAddress) ) )
okxTitle :: (EnumMap DisplayFont Overlay, [KYX])
okxTitle = ( DisplayFont -> Overlay -> EnumMap DisplayFont Overlay
forall k a. Enum k => k -> a -> EnumMap k a
EM.singleton DisplayFont
squareFont (Overlay -> EnumMap DisplayFont Overlay)
-> Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ [AttrLine] -> Overlay
offsetOverlay [AttrLine]
titleAndInfo
, [KYX
webButton] )
okx :: (EnumMap DisplayFont Overlay, [KYX])
okx = Int
-> Int
-> (EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX])
xytranslateOKX Int
2 Int
0
((EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX]))
-> (EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX])
forall a b. (a -> b) -> a -> b
$ Int
-> Int
-> (EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX])
-> (EnumMap DisplayFont Overlay, [KYX])
sideBySideOKX Int
2 ([AttrLine] -> Int
forall a. [a] -> Int
length [AttrLine]
titleAndInfo) (EnumMap DisplayFont Overlay, [KYX])
okxTitle (EnumMap DisplayFont Overlay, [KYX])
okxBindings
prepareBlurb :: EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
prepareBlurb EnumMap DisplayFont Overlay
ovs =
let introLen :: Int
introLen = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ EnumMap DisplayFont Overlay -> Int
maxYofFontOverlayMap EnumMap DisplayFont Overlay
ovs
start0 :: Int
start0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
0 (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
introLen
Int -> Int -> Int
forall a. Num a => a -> a -> a
- if DisplayFont -> Bool
isSquareFont DisplayFont
propFont then Int
1 else Int
2)
in (Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (Int -> Int -> Overlay -> Overlay
xytranslateOverlay (-Int
2) (Int
start0 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)) EnumMap DisplayFont Overlay
ovs
returnDefaultOKS :: m (EnumMap DisplayFont Overlay, [KYX])
returnDefaultOKS = (EnumMap DisplayFont Overlay, [KYX])
-> m (EnumMap DisplayFont Overlay, [KYX])
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
prepareBlurb EnumMap DisplayFont Overlay
blurb, [])
displayInRightPane :: KeyOrSlot -> m (EnumMap DisplayFont Overlay, [KYX])
displayInRightPane KeyOrSlot
ekm = case KeyOrSlot
ekm KeyOrSlot
-> [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
-> Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
kds of
Just (Text
_, HumanCmd
_, Maybe HumanCmd
_, Maybe (EnumMap DisplayFont Overlay)
mblurbRight) -> case Maybe (EnumMap DisplayFont Overlay)
mblurbRight of
Maybe (EnumMap DisplayFont Overlay)
Nothing -> m (EnumMap DisplayFont Overlay, [KYX])
returnDefaultOKS
Just EnumMap DisplayFont Overlay
blurbRight -> (EnumMap DisplayFont Overlay, [KYX])
-> m (EnumMap DisplayFont Overlay, [KYX])
forall (m :: * -> *) a. Monad m => a -> m a
return (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
prepareBlurb EnumMap DisplayFont Overlay
blurbRight, [])
Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
Nothing | KeyOrSlot
ekm KeyOrSlot -> KeyOrSlot -> Bool
forall a. Eq a => a -> a -> Bool
== KM -> KeyOrSlot
forall a b. a -> Either a b
Left (Char -> KM
K.mkChar Char
'@') -> m (EnumMap DisplayFont Overlay, [KYX])
returnDefaultOKS
Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
Nothing -> String -> m (EnumMap DisplayFont Overlay, [KYX])
forall a. (?callStack::CallStack) => String -> a
error (String -> m (EnumMap DisplayFont Overlay, [KYX]))
-> String -> m (EnumMap DisplayFont Overlay, [KYX])
forall a b. (a -> b) -> a -> b
$ String
"generateMenu: unexpected key:"
String -> KeyOrSlot -> String
forall v. Show v => String -> v -> String
`showFailure` KeyOrSlot
ekm
keys :: [KM]
keys = [KM
K.leftKM, KM
K.rightKM, KM
K.escKM, Char -> KM
K.mkChar Char
'@']
loop :: m (Either MError ReqUI)
loop = do
Either (KM, KeyOrSlot) MenuSlot
kmkm <- (KeyOrSlot -> m (EnumMap DisplayFont Overlay, [KYX]))
-> Bool
-> String
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m (Either (KM, KeyOrSlot) MenuSlot)
forall (m :: * -> *).
MonadClientUI m =>
(KeyOrSlot -> m (EnumMap DisplayFont Overlay, [KYX]))
-> Bool
-> String
-> ColorMode
-> Bool
-> Slideshow
-> [KM]
-> m (Either (KM, KeyOrSlot) MenuSlot)
displayChoiceScreenWithRightPaneKMKM KeyOrSlot -> m (EnumMap DisplayFont Overlay, [KYX])
displayInRightPane Bool
True
String
menuName ColorMode
ColorFull Bool
True
((EnumMap DisplayFont Overlay, [KYX]) -> Slideshow
menuToSlideshow (EnumMap DisplayFont Overlay, [KYX])
okx) [KM]
keys
case Either (KM, KeyOrSlot) MenuSlot
kmkm of
Left (km :: KM
km@(K.KM {key :: KM -> Key
key=Key
K.Left}), KeyOrSlot
ekm) -> case KeyOrSlot
ekm KeyOrSlot
-> [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
-> Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
kds of
Just (Text
_, HumanCmd
_, Maybe HumanCmd
Nothing, Maybe (EnumMap DisplayFont Overlay)
_) -> m (Either MError ReqUI)
loop
Just (Text
_, HumanCmd
_, Just HumanCmd
cmdReverse, Maybe (EnumMap DisplayFont Overlay)
_) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmdReverse
Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
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 Text
"never mind"
Left (km :: KM
km@(K.KM {key :: KM -> Key
key=Key
K.Right}), KeyOrSlot
ekm) -> case KeyOrSlot
ekm KeyOrSlot
-> [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
-> Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
kds of
Just (Text
_, HumanCmd
cmd, Maybe HumanCmd
_, Maybe (EnumMap DisplayFont Overlay)
_) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
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 Text
"never mind"
Left (K.KM {key :: KM -> Key
key=K.Char Char
'@'}, KeyOrSlot
_)-> do
Bool
success <- String -> m Bool
forall (m :: * -> *). MonadClientUI m => String -> m Bool
tryOpenBrowser String
rwebAddress
if Bool
success
then (KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM EnumMap DisplayFont Overlay
blurb [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
kdsRaw [String]
gameInfo String
menuName
else 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 Text
"failed to open web browser"
Left (KM
km, KeyOrSlot
_) -> case KM -> KeyOrSlot
forall a b. a -> Either a b
Left KM
km KeyOrSlot
-> [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
-> Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
kds of
Just (Text
_, HumanCmd
cmd, Maybe HumanCmd
_, Maybe (EnumMap DisplayFont Overlay)
_) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
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 Text
"never mind"
Right MenuSlot
slot -> case MenuSlot -> KeyOrSlot
forall a b. b -> Either a b
Right MenuSlot
slot KeyOrSlot
-> [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
-> Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KeyOrSlot,
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay)))]
kds of
Just (Text
_, HumanCmd
cmd, Maybe HumanCmd
_, Maybe (EnumMap DisplayFont Overlay)
_) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
K.escKM HumanCmd
cmd
Maybe
(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))
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 Text
"never mind"
m (Either MError ReqUI)
loop
mainMenuHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuHuman :: (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{([String], [[String]])
rintroScreen :: ([String], [[String]])
rintroScreen :: ScreenContent -> ([String], [[String]])
rintroScreen}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{DisplayFont
propFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
propFont} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
Bool
curTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
scurTutorial
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
let offOn :: Bool -> p
offOn Bool
b = if Bool
b then p
"on" else p
"off"
kds :: [(Text, HumanCmd, Maybe a, Maybe a)]
kds = [ (Text
"+ setup and start new game>", HumanCmd
ChallengeMenu, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
, (Text
"@ save and exit to desktop", HumanCmd
GameExit, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
, (Text
"+ tweak convenience settings>", HumanCmd
SettingsMenu, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
, (Text
"@ toggle autoplay", HumanCmd
AutomateToggle, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
, (Text
"@ see command help", HumanCmd
Help, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
, (Text
"@ switch to dashboard", HumanCmd
Dashboard, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing)
, (Text
"^ back to playing", HumanCmd
AutomateBack, Maybe a
forall a. Maybe a
Nothing, Maybe a
forall a. Maybe a
Nothing) ]
gameName :: Text
gameName = ModeKind -> Text
MK.mname ModeKind
gameMode
displayTutorialHints :: Bool
displayTutorialHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
curTutorial Maybe Bool
overrideTut
gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
[ Text
"Now playing:" Text -> Text -> Text
<+> Text
gameName
, Text
""
, Text
" with difficulty:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Challenge -> Int
cdiff Challenge
curChal)
, Text
" cold fish:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cfish Challenge
curChal)
, Text
" ready goods:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cgoods Challenge
curChal)
, Text
" lone wolf:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cwolf Challenge
curChal)
, Text
" finder keeper:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
ckeeper Challenge
curChal)
, Text
" tutorial hints:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn Bool
displayTutorialHints
, Text
"" ]
glueLines :: [[a]] -> [[a]]
glueLines ([a]
l1 : [a]
l2 : [[a]]
rest) =
if | [a] -> Bool
forall a. [a] -> Bool
null [a]
l1 -> [a]
l1 [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
glueLines ([a]
l2 [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]]
rest)
| [a] -> Bool
forall a. [a] -> Bool
null [a]
l2 -> [a]
l1 [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [a]
l2 [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
glueLines [[a]]
rest
| Bool
otherwise -> ([a]
l1 [a] -> [a] -> [a]
forall a. [a] -> [a] -> [a]
++ [a]
l2) [a] -> [[a]] -> [[a]]
forall a. a -> [a] -> [a]
: [[a]] -> [[a]]
glueLines [[a]]
rest
glueLines [[a]]
ll = [[a]]
ll
backstory :: [String]
backstory | DisplayFont -> Bool
isSquareFont DisplayFont
propFont = ([String], [[String]]) -> [String]
forall a b. (a, b) -> a
fst ([String], [[String]])
rintroScreen
| Bool
otherwise = [String] -> [String]
forall a. [[a]] -> [[a]]
glueLines ([String] -> [String]) -> [String] -> [String]
forall a b. (a -> b) -> a -> b
$ ([String], [[String]]) -> [String]
forall a b. (a, b) -> a
fst ([String], [[String]])
rintroScreen
backstoryAL :: [AttrLine]
backstoryAL = (String -> AttrLine) -> [String] -> [AttrLine]
forall a b. (a -> b) -> [a] -> [b]
map (String -> AttrLine
stringToAL (String -> AttrLine) -> (String -> String) -> String -> AttrLine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')) [String]
backstory
blurb :: EnumMap DisplayFont Overlay
blurb = [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap [(DisplayFont
propFont, [AttrLine]
backstoryAL)]
(KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM EnumMap DisplayFont Overlay
blurb [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
forall a a. [(Text, HumanCmd, Maybe a, Maybe a)]
kds [String]
gameInfo String
"main"
mainMenuAutoOnHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuAutoOnHuman :: (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuAutoOnHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = 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
$ \SessionUI
sess -> SessionUI
sess {swasAutomated :: Bool
swasAutomated = Bool
True}
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
mainMenuAutoOffHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuAutoOffHuman :: (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuAutoOffHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = 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
$ \SessionUI
sess -> SessionUI
sess {swasAutomated :: Bool
swasAutomated = Bool
False}
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
settingsMenuHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
UIOptions{Int
uMsgWrapColumn :: UIOptions -> Int
uMsgWrapColumn :: Int
uMsgWrapColumn} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
Int
markSuspect <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
smarkSuspect
Int
markVision <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
smarkVision
Bool
markSmell <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smarkSmell
Bool
noAnim <- (StateClient -> Bool) -> m Bool
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Bool) -> m Bool)
-> (StateClient -> Bool) -> m Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False (Maybe Bool -> Bool)
-> (StateClient -> Maybe Bool) -> StateClient -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ClientOptions -> Maybe Bool
snoAnim (ClientOptions -> Maybe Bool)
-> (StateClient -> ClientOptions) -> StateClient -> Maybe Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> ClientOptions
soptions
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Doctrine
factDoctrine <- (State -> Doctrine) -> m Doctrine
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Doctrine) -> m Doctrine)
-> (State -> Doctrine) -> m Doctrine
forall a b. (a -> b) -> a -> b
$ Faction -> Doctrine
gdoctrine (Faction -> Doctrine) -> (State -> Faction) -> State -> Doctrine
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
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
let offOn :: Bool -> p
offOn Bool
b = if Bool
b then p
"on" else p
"off"
offOnAll :: v -> p
offOnAll v
n = case v
n of
v
0 -> p
"none"
v
1 -> p
"untried"
v
2 -> p
"all"
v
_ -> String -> p
forall a. (?callStack::CallStack) => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"" String -> v -> String
forall v. Show v => String -> v -> String
`showFailure` v
n
neverEver :: v -> p
neverEver v
n = case v
n of
v
0 -> p
"never"
v
1 -> p
"aiming"
v
2 -> p
"always"
v
_ -> String -> p
forall a. (?callStack::CallStack) => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ String
"" String -> v -> String
forall v. Show v => String -> v -> String
`showFailure` v
n
offOnUnset :: Maybe Bool -> p
offOnUnset Maybe Bool
mb = case Maybe Bool
mb of
Maybe Bool
Nothing -> p
"pass"
Just Bool
b -> if Bool
b then p
"force on" else p
"force off"
tsuspect :: Text
tsuspect = Text
"@ mark suspect terrain:" Text -> Text -> Text
<+> Int -> Text
forall v p. (Eq v, Num v, IsString p, Show v) => v -> p
offOnAll Int
markSuspect
tvisible :: Text
tvisible = Text
"@ show visible zone:" Text -> Text -> Text
<+> Int -> Text
forall v p. (Eq v, Num v, IsString p, Show v) => v -> p
neverEver Int
markVision
tsmell :: Text
tsmell = Text
"@ display smell clues:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn Bool
markSmell
tanim :: Text
tanim = Text
"@ play animations:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Bool -> Bool
not Bool
noAnim)
tdoctrine :: Text
tdoctrine = Text
"@ squad doctrine:" Text -> Text -> Text
<+> Doctrine -> Text
Ability.nameDoctrine Doctrine
factDoctrine
toverride :: Text
toverride = Text
"@ override tutorial hints:" Text -> Text -> Text
<+> Maybe Bool -> Text
forall p. IsString p => Maybe Bool -> p
offOnUnset Maybe Bool
overrideTut
width :: Int
width = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont
then Int
rwidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
uMsgWrapColumn (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
textToBlurb :: Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
t = EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
forall a. a -> Maybe a
Just (EnumMap DisplayFont Overlay
-> Maybe (EnumMap DisplayFont Overlay))
-> EnumMap DisplayFont Overlay
-> Maybe (EnumMap DisplayFont Overlay)
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
[ ( DisplayFont
propFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
(AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS Text
t ) ]
kds :: [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
kds = [ ( Text
tsuspect, Int -> HumanCmd
MarkSuspect Int
1, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just (Int -> HumanCmd
MarkSuspect (-Int
1))
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* mark suspect terrain\nThis setting affects the ongoing and the next games. It determines which suspect terrain is marked in special color on the map: none, untried (not searched nor revealed), all. It correspondingly determines which, if any, suspect tiles are considered for mouse go-to, auto-explore and for the command that marks the nearest unexplored position." )
, ( Text
tvisible, Int -> HumanCmd
MarkVision Int
1, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just (Int -> HumanCmd
MarkVision (-Int
1))
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* show visible zone\nThis setting affects the ongoing and the next games. It determines the conditions under which the area visible to the party is marked on the map via a gray background: never, when aiming, always." )
, ( Text
tsmell, HumanCmd
MarkSmell, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just HumanCmd
MarkSmell
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* display smell clues\nThis setting affects the ongoing and the next games. It determines whether the map displays any smell traces (regardless of who left them) detected by a party member that can track via smell (as determined by the smell radius skill; not common among humans)." )
, ( Text
tanim, HumanCmd
MarkAnim, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just HumanCmd
MarkAnim
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* play animations\nThis setting affects the ongoing and the next games. It determines whether important events, such combat, are highlighted by animations. This overrides the corresponding config file setting." )
, ( Text
tdoctrine, HumanCmd
Doctrine, Maybe HumanCmd
forall a. Maybe a
Nothing
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* squad doctrine\nThis setting affects the ongoing game, but does not persist to the next games. It determines the behaviour of henchmen (non-pointman characters) in the party and, in particular, if they are permitted to move autonomously or fire opportunistically (assuming they are able to, usually due to rare equipment). This setting has a poor UI that will be improved in the future." )
, ( Text
toverride, Int -> HumanCmd
OverrideTut Int
1, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just (Int -> HumanCmd
OverrideTut (-Int
1))
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* override tutorial hints\nThis setting affects the ongoing and the next games. It determines whether tutorial hints are, respectively, not overridden with respect to the default game mode setting, forced to be off, forced to be on. Tutorial hints are rendered as pink messages and can afterwards be re-read from message history." )
, ( Text
"^ back to main menu", HumanCmd
MainMenu, Maybe HumanCmd
forall a. Maybe a
Nothing, EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
forall a. a -> Maybe a
Just EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty ) ]
gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
[ Text
"Tweak convenience settings:"
, Text
"" ]
(KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
kds [String]
gameInfo String
"settings"
challengeMenuHuman :: MonadClientUI m
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
CCUI{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
UIOptions{Int
uMsgWrapColumn :: Int
uMsgWrapColumn :: UIOptions -> Int
uMsgWrapColumn} <- (SessionUI -> UIOptions) -> m UIOptions
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> UIOptions
sUIOptions
FontSetup{DisplayFont
propFont :: DisplayFont
monoFont :: DisplayFont
squareFont :: DisplayFont
propFont :: FontSetup -> DisplayFont
monoFont :: FontSetup -> DisplayFont
squareFont :: FontSetup -> DisplayFont
..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories
Int
snxtScenario <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
snxtScenario
Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
let (ContentId ModeKind
gameModeId, ModeKind
gameMode) = COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps
cops Int
snxtScenario
victories :: Int
victories = case ContentId ModeKind
-> EnumMap (ContentId ModeKind) (Map Challenge Int)
-> Maybe (Map Challenge Int)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
EM.lookup ContentId ModeKind
gameModeId EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories of
Maybe (Map Challenge Int)
Nothing -> Int
0
Just Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe Int
0 (Challenge -> Map Challenge Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
M.lookup Challenge
nxtChal Map Challenge Int
cm)
star :: Text -> Text
star Text
t = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Text
"*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t else Text
t
tnextScenario :: Text
tnextScenario = Text
"@ adventure:" Text -> Text -> Text
<+> Text -> Text
star (ModeKind -> Text
MK.mname ModeKind
gameMode)
offOn :: Bool -> p
offOn Bool
b = if Bool
b then p
"on" else p
"off"
tnextDiff :: Text
tnextDiff = Text
"@ difficulty level:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Challenge -> Int
cdiff Challenge
nxtChal)
tnextFish :: Text
tnextFish = Text
"@ cold fish (rather hard):" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cfish Challenge
nxtChal)
tnextGoods :: Text
tnextGoods = Text
"@ ready goods (hard):" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cgoods Challenge
nxtChal)
tnextWolf :: Text
tnextWolf = Text
"@ lone wolf (very hard):" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cwolf Challenge
nxtChal)
tnextKeeper :: Text
tnextKeeper = Text
"@ finder keeper (hard):" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
ckeeper Challenge
nxtChal)
width :: Int
width = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont
then Int
rwidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
uMsgWrapColumn (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2)
widthFull :: Int
widthFull = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont
then Int
rwidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
2
else Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
2
duplicateEOL :: Char -> Text
duplicateEOL Char
'\n' = Text
"\n\n"
duplicateEOL Char
c = Char -> Text
T.singleton Char
c
blurb :: Maybe (EnumMap DisplayFont Overlay)
blurb = EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
forall a. a -> Maybe a
Just (EnumMap DisplayFont Overlay
-> Maybe (EnumMap DisplayFont Overlay))
-> EnumMap DisplayFont Overlay
-> Maybe (EnumMap DisplayFont Overlay)
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
[ ( DisplayFont
propFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
(AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Color -> Text -> AttrString
textFgToAS Color
Color.BrBlack
(Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mdesc ModeKind
gameMode)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" )
, ( DisplayFont
propFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
widthFull Int
widthFull
(AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS
(Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ ModeKind -> Text
MK.mrules ModeKind
gameMode
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" )
, ( DisplayFont
propFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
(AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS
(Text -> AttrString) -> Text -> AttrString
forall a b. (a -> b) -> a -> b
$ (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
duplicateEOL (ModeKind -> Text
MK.mreason ModeKind
gameMode) )
]
textToBlurb :: Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
t = EnumMap DisplayFont Overlay -> Maybe (EnumMap DisplayFont Overlay)
forall a. a -> Maybe a
Just (EnumMap DisplayFont Overlay
-> Maybe (EnumMap DisplayFont Overlay))
-> EnumMap DisplayFont Overlay
-> Maybe (EnumMap DisplayFont Overlay)
forall a b. (a -> b) -> a -> b
$ [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap
[ ( DisplayFont
propFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
width Int
width
(AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ Text -> AttrString
textToAS Text
t ) ]
kds :: [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
kds = [ ( Text
tnextScenario, Int -> HumanCmd
GameScenarioIncr Int
1, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just (Int -> HumanCmd
GameScenarioIncr (-Int
1))
, Maybe (EnumMap DisplayFont Overlay)
blurb )
, ( Text
tnextDiff, Int -> HumanCmd
GameDifficultyIncr Int
1, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just (Int -> HumanCmd
GameDifficultyIncr (-Int
1))
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* difficulty level\nThis determines the difficulty of survival in the next game that's about to be started. Lower numbers result in easier game. In particular, difficulty below 5 multiplies hitpoints of player characters and difficulty over 5 multiplies hitpoints of their enemies. Game score scales with difficulty.")
, ( Text
tnextFish, HumanCmd
GameFishToggle, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just HumanCmd
GameFishToggle
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* cold fish\nThis challenge mode setting will affect the next game that's about to be started. When on, it makes it impossible for player characters to be healed by actors from other factions (this is a significant restriction in the long crawl adventure).")
, ( Text
tnextGoods, HumanCmd
GameGoodsToggle, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just HumanCmd
GameGoodsToggle
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* ready goods\nThis challenge mode setting will affect the next game that's about to be started. When on, it disables crafting for the player, making the selection of equipment, especially melee weapons, very limited, unless the player has the luck to find the rare powerful ready weapons (this applies only if the chosen adventure supports crafting at all).")
, ( Text
tnextWolf, HumanCmd
GameWolfToggle, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just HumanCmd
GameWolfToggle
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* lone wolf\nThis challenge mode setting will affect the next game that's about to be started. When on, it reduces player's starting actors to exactly one, though later on new heroes may join the party. This makes the game very hard in the long run.")
, ( Text
tnextKeeper, HumanCmd
GameKeeperToggle, HumanCmd -> Maybe HumanCmd
forall a. a -> Maybe a
Just HumanCmd
GameKeeperToggle
, Text -> Maybe (EnumMap DisplayFont Overlay)
textToBlurb Text
"* finder keeper\nThis challenge mode setting will affect the next game that's about to be started. When on, it completely disables flinging projectiles by the player, which affects not only ranged damage dealing, but also throwing of consumables that buff teammates engaged in melee combat, weaken and distract enemies, light dark corners, etc.")
, ( Text
"@ start new game", HumanCmd
GameRestart, Maybe HumanCmd
forall a. Maybe a
Nothing, Maybe (EnumMap DisplayFont Overlay)
blurb )
, ( Text
"^ back to main menu", HumanCmd
MainMenu, Maybe HumanCmd
forall a. Maybe a
Nothing, Maybe (EnumMap DisplayFont Overlay)
forall a. Maybe a
Nothing ) ]
gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [ Text
"Setup and start new game:"
, Text
"" ]
(KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> EnumMap DisplayFont Overlay
-> [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM EnumMap DisplayFont Overlay
forall k a. EnumMap k a
EM.empty [(Text, HumanCmd, Maybe HumanCmd,
Maybe (EnumMap DisplayFont Overlay))]
kds [String]
gameInfo String
"challenge"
gameDifficultyIncr :: MonadClient m => Int -> m ()
gameDifficultyIncr :: Int -> m ()
gameDifficultyIncr Int
delta = do
Int
nxtDiff <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Int) -> m Int) -> (StateClient -> Int) -> m Int
forall a b. (a -> b) -> a -> b
$ Challenge -> Int
cdiff (Challenge -> Int)
-> (StateClient -> Challenge) -> StateClient -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> Challenge
snxtChal
let d :: Int
d | Int
nxtDiff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
difficultyBound = Int
1
| Int
nxtDiff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 = Int
difficultyBound
| Bool
otherwise = Int
nxtDiff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
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
$ \StateClient
cli -> StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {cdiff :: Int
cdiff = Int
d} }
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
$ \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))} }
gameGoodsToggle :: MonadClient m => m ()
gameGoodsToggle :: m ()
gameGoodsToggle =
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {cgoods :: Bool
cgoods = Bool -> Bool
not (Challenge -> Bool
cgoods (StateClient -> Challenge
snxtChal StateClient
cli))} }
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
$ \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))} }
gameKeeperToggle :: MonadClient m => m ()
gameKeeperToggle :: m ()
gameKeeperToggle =
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ \StateClient
cli ->
StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {ckeeper :: Bool
ckeeper = Bool -> Bool
not (Challenge -> Bool
ckeeper (StateClient -> Challenge
snxtChal StateClient
cli))} }
gameScenarioIncr :: MonadClientUI m => Int -> m ()
gameScenarioIncr :: Int -> m ()
gameScenarioIncr Int
delta = do
COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Int
oldScenario <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
snxtScenario
let snxtScenario :: Int
snxtScenario = Int
oldScenario Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
delta
snxtTutorial :: Bool
snxtTutorial = ModeKind -> Bool
MK.mtutorial (ModeKind -> Bool) -> ModeKind -> Bool
forall a b. (a -> b) -> a -> b
$ (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a, b) -> b
snd ((ContentId ModeKind, ModeKind) -> ModeKind)
-> (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a -> b) -> a -> b
$ COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps
cops Int
snxtScenario
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \SessionUI
sess -> SessionUI
sess {Int
snxtScenario :: Int
snxtScenario :: Int
snxtScenario, Bool
snxtTutorial :: Bool
snxtTutorial :: Bool
snxtTutorial}
data ExitStrategy = Restart | Quit
gameExitWithHuman :: MonadClientUI m => ExitStrategy -> m (FailOrCmd ReqUI)
gameExitWithHuman :: ExitStrategy -> m (FailOrCmd ReqUI)
gameExitWithHuman ExitStrategy
exitStrategy = do
Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Bool
noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
Int
snxtScenario <- (SessionUI -> Int) -> m Int
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Int
snxtScenario
let nxtGameName :: Text
nxtGameName = ModeKind -> Text
MK.mname (ModeKind -> Text) -> ModeKind -> Text
forall a b. (a -> b) -> a -> b
$ (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a, b) -> b
snd ((ContentId ModeKind, ModeKind) -> ModeKind)
-> (ContentId ModeKind, ModeKind) -> ModeKind
forall a b. (a -> b) -> a -> b
$ COps -> Int -> (ContentId ModeKind, ModeKind)
nxtGameMode COps
cops Int
snxtScenario
exitReturn :: GroupName ModeKind -> m (FailOrCmd ReqUI)
exitReturn GroupName ModeKind
x = 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
x Challenge
snxtChal
displayExitMessage :: Text -> m Bool
displayExitMessage Text
diff =
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
$ Text
diff Text -> Text -> Text
<+> Text
"progress of the ongoing"
Text -> Text -> Text
<+> ModeKind -> Text
MK.mname ModeKind
gameMode Text -> Text -> Text
<+> Text
"game will be lost! Are you sure?"
m Bool
-> m (FailOrCmd ReqUI)
-> m (FailOrCmd ReqUI)
-> m (FailOrCmd ReqUI)
forall (m :: * -> *) b. Monad m => m Bool -> m b -> m b -> m b
ifM (Bool -> m Bool -> m Bool -> m Bool
forall p. Bool -> p -> p -> p
if' Bool
noConfirmsGame
(Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True)
(Text -> m Bool
displayExitMessage (Text -> m Bool) -> Text -> m Bool
forall a b. (a -> b) -> a -> b
$ case ExitStrategy
exitStrategy of
ExitStrategy
Restart -> Text
"You just requested a new" Text -> Text -> Text
<+> Text
nxtGameName
Text -> Text -> Text
<+> Text
"game. The "
ExitStrategy
Quit -> Text
"If you quit, the "))
(GroupName ModeKind -> m (FailOrCmd ReqUI)
exitReturn (GroupName ModeKind -> m (FailOrCmd ReqUI))
-> GroupName ModeKind -> m (FailOrCmd ReqUI)
forall a b. (a -> b) -> a -> b
$ case ExitStrategy
exitStrategy of
ExitStrategy
Restart ->
let (Text
mainName, Text
_) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\Char
c -> Char -> Bool
Char.isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ')
Text
nxtGameName
in Text -> GroupName ModeKind
forall c. Text -> GroupName c
DefsInternal.GroupName (Text -> GroupName ModeKind) -> Text -> GroupName ModeKind
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
" "
([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
2 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
mainName
ExitStrategy
Quit -> GroupName ModeKind
MK.INSERT_COIN)
(Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI ([Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
[ Text
"yea, would be a pity to leave them to die"
, Text
"yea, a shame to get your team stranded" ])
m Text -> (Text -> m (FailOrCmd ReqUI)) -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith)
ifM :: Monad m => m Bool -> m b -> m b -> m b
ifM :: m Bool -> m b -> m b -> m b
ifM m Bool
b m b
t m b
f = do Bool
b' <- m Bool
b; if Bool
b' then m b
t else m b
f
if' :: Bool -> p -> p -> p
if' :: Bool -> p -> p -> p
if' Bool
b p
t p
f = if Bool
b then p
t else p
f
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
$ \SessionUI
sess -> SessionUI
sess {sallNframes :: Int
sallNframes = -Int
1}
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric Text
"Interrupt! Trashing the unsaved game. The program exits now."
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI Text
"Interrupt! Trashing the unsaved game. The program exits now."
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameDropAndExit
gameExitHuman :: Monad m => m ReqUI
gameExitHuman :: m ReqUI
gameExitHuman =
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameSaveAndExit
gameSaveHuman :: MonadClientUI m => m ReqUI
gameSaveHuman :: m ReqUI
gameSaveHuman = do
MsgClassSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassSave
MsgInnerWorkSpam Text
"Saving game backup."
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameSave
doctrineHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
doctrineHuman :: m (FailOrCmd ReqUI)
doctrineHuman = do
FactionId
fid <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Doctrine
fromT <- (State -> Doctrine) -> m Doctrine
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Doctrine) -> m Doctrine)
-> (State -> Doctrine) -> m Doctrine
forall a b. (a -> b) -> a -> b
$ Faction -> Doctrine
gdoctrine (Faction -> Doctrine) -> (State -> Faction) -> State -> Doctrine
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 :: Doctrine
toT = if Doctrine
fromT Doctrine -> Doctrine -> Bool
forall a. Eq a => a -> a -> Bool
== Doctrine
forall a. Bounded a => a
maxBound then Doctrine
forall a. Bounded a => a
minBound else Doctrine -> Doctrine
forall a. Enum a => a -> a
succ Doctrine
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
$ Text
"(Beware, work in progress!)"
Text -> Text -> Text
<+> Text
"Current squad doctrine is '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doctrine -> Text
Ability.nameDoctrine Doctrine
fromT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
Text -> Text -> Text
<+> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doctrine -> Text
Ability.describeDoctrine Doctrine
fromT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")."
Text -> Text -> Text
<+> Text
"Switching doctrine to '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doctrine -> Text
Ability.nameDoctrine Doctrine
toT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
Text -> Text -> Text
<+> Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Doctrine -> Text
Ability.describeDoctrine Doctrine
toT Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")."
Text -> Text -> Text
<+> Text
"This clears targets of all non-pointmen teammates."
Text -> Text -> Text
<+> Text
"New targets will be picked according to new doctrine."
if Bool -> Bool
not Bool
go
then Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"squad doctrine 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
$ Doctrine -> ReqUI
ReqUIDoctrine Doctrine
toT
automateHuman :: MonadClientUI m => m (FailOrCmd ReqUI)
automateHuman :: m (FailOrCmd ReqUI)
automateHuman = do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
clearAimMode
Bool
proceed <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
MonadClientUI m =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW Text
"Do you really want to cede control to AI?"
if Bool -> Bool
not Bool
proceed
then Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
"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 Text
"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