{-# LANGUAGE TupleSections #-}
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
, gameTutorialToggle, gameDifficultyIncr
, gameFishToggle, gameGoodsToggle, gameWolfToggle, gameKeeperToggle
, gameScenarioIncr
, gameRestartHuman, gameQuitHuman, 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 (isLeft)
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 Game.LambdaHack.Client.UI.ItemSlot (SlotChar (SlotChar))
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.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
byAreaHuman :: (MonadClient m, 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 cmdSemInCxtOfKM :: KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM l :: [(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 px :: Int
px py :: Int
py = PointUI -> PointSquare
uiToSquare PointUI
pUI
p :: Point
p = $WPoint :: Int -> Int -> Point
Point {..}
pointerInArea :: CmdArea -> m Bool
pointerInArea a :: CmdArea
a = do
[Maybe Area]
rs <- CmdArea -> m [Maybe Area]
forall (m :: * -> *). MonadClientUI m => CmdArea -> m [Maybe Area]
areaToRectangles CmdArea
a
Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> m Bool) -> Bool -> m Bool
forall a b. (a -> b) -> a -> b
$! (Area -> Bool) -> [Area] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Point -> Area -> Bool
inside Point
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 :: * -> *). (MonadClient m, MonadClientUI m) => m ()
stopPlayBack
Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
(_, cmd :: HumanCmd
cmd) : _ -> 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
_ -> 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 ca :: 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
CaMessage -> [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(0, 0, Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1, 0)]
CaMapLeader -> do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
let PointSquare x :: Int
x y :: 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)]
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 p :: Point
p =
let PointSquare x :: Int
x y :: 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
CaMap ->
let PointSquare xo :: Int
xo yo :: Int
yo = Point -> PointSquare
mapToSquare Point
originPoint
PointSquare xe :: Int
xe ye :: 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
- 1) (Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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)]
CaLevelNumber -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(0, Int
y, 1, Int
y)]
CaArenaName -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- 11
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(3, Int
y, Int
x, Int
y)]
CaPercentSeen -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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
- 9, Int
y, Int
x, Int
y)]
CaXhairDesc -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
- 1, Int
y)]
CaSelected -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
in [(Int, Int, Int, Int)] -> m [(Int, Int, Int, Int)]
forall (m :: * -> *) a. Monad m => a -> m a
return [(0, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 24, Int
y)]
CaCalmGauge -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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
- 22, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 18, Int
y)]
CaCalmValue -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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
- 17, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 11, Int
y)]
CaHPGauge -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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
- 9, Int
y, Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
- 6, Int
y)]
CaHPValue -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 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
- 6, Int
y, Int
x, Int
y)]
CaLeaderDesc -> let y :: Int
y = Int
rheight Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1
x :: Int
x = (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 1) Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
- 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 cmdNotAimingM :: m (Either MError ReqUI)
cmdNotAimingM cmdAimingM :: m (Either MError ReqUI)
cmdAimingM = do
Maybe AimMode
aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isNothing Maybe AimMode
aimMode then m (Either MError ReqUI)
cmdNotAimingM else m (Either MError ReqUI)
cmdAimingM
composeIfLocalHuman :: MonadClientUI m
=> m (Either MError ReqUI) -> m (Either MError ReqUI)
-> m (Either MError ReqUI)
composeIfLocalHuman :: m (Either MError ReqUI)
-> m (Either MError ReqUI) -> m (Either MError ReqUI)
composeIfLocalHuman c1 :: m (Either MError ReqUI)
c1 c2 :: m (Either MError ReqUI)
c2 = do
Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
case Either MError ReqUI
slideOrCmd1 of
Left merr1 :: MError
merr1 -> do
Either MError ReqUI
slideOrCmd2 <- m (Either MError ReqUI)
c2
case Either MError ReqUI
slideOrCmd2 of
Left merr2 :: MError
merr2 -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
forall a b. (a -> b) -> a -> b
$ MError -> MError -> MError
mergeMError MError
merr1 MError
merr2
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd2
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd1
composeUnlessErrorHuman :: MonadClientUI m
=> m (Either MError ReqUI) -> m (Either MError ReqUI)
-> m (Either MError ReqUI)
composeUnlessErrorHuman :: m (Either MError ReqUI)
-> m (Either MError ReqUI) -> m (Either MError ReqUI)
composeUnlessErrorHuman c1 :: m (Either MError ReqUI)
c1 c2 :: m (Either MError ReqUI)
c2 = do
Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
case Either MError ReqUI
slideOrCmd1 of
Left Nothing -> m (Either MError ReqUI)
c2
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd1
compose2ndLocalHuman :: MonadClientUI m
=> m (Either MError ReqUI) -> m (Either MError ReqUI)
-> m (Either MError ReqUI)
compose2ndLocalHuman :: m (Either MError ReqUI)
-> m (Either MError ReqUI) -> m (Either MError ReqUI)
compose2ndLocalHuman c1 :: m (Either MError ReqUI)
c1 c2 :: m (Either MError ReqUI)
c2 = do
Either MError ReqUI
slideOrCmd1 <- m (Either MError ReqUI)
c1
case Either MError ReqUI
slideOrCmd1 of
Left merr1 :: MError
merr1 -> do
Either MError ReqUI
slideOrCmd2 <- m (Either MError ReqUI)
c2
case Either MError ReqUI
slideOrCmd2 of
Left merr2 :: MError
merr2 -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
forall a b. (a -> b) -> a -> b
$ MError -> MError -> MError
mergeMError MError
merr1 MError
merr2
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
slideOrCmd1
req :: Either MError ReqUI
req -> do
m (Either MError ReqUI) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void m (Either MError ReqUI)
c2
Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
req
loopOnNothingHuman :: MonadClientUI m
=> m (Either MError ReqUI)
-> m (Either MError ReqUI)
loopOnNothingHuman :: m (Either MError ReqUI) -> m (Either MError ReqUI)
loopOnNothingHuman cmd :: m (Either MError ReqUI)
cmd = do
Either MError ReqUI
res <- m (Either MError ReqUI)
cmd
case Either MError ReqUI
res of
Left Nothing -> m (Either MError ReqUI) -> m (Either MError ReqUI)
forall (m :: * -> *).
MonadClientUI m =>
m (Either MError ReqUI) -> m (Either MError ReqUI)
loopOnNothingHuman m (Either MError ReqUI)
cmd
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
res
executeIfClearHuman :: MonadClientUI m
=> m (Either MError ReqUI)
-> m (Either MError ReqUI)
executeIfClearHuman :: m (Either MError ReqUI) -> m (Either MError ReqUI)
executeIfClearHuman c1 :: m (Either MError ReqUI)
c1 = do
Bool
sreportNull <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sreportNull
if Bool
sreportNull then m (Either MError ReqUI)
c1 else Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
waitHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)
waitHuman :: m (FailOrCmd RequestTimed)
waitHuman = do
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {swaitTimes :: 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
+ 1}
FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
ReqWait
else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
WaitUnskilled
waitHuman10 :: MonadClientUI m => m (FailOrCmd RequestTimed)
waitHuman10 :: m (FailOrCmd RequestTimed)
waitHuman10 = do
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 4 then do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {swaitTimes :: 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
+ 1}
FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
ReqWait10
else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
WaitUnskilled
yellHuman :: MonadClientUI m => m (FailOrCmd RequestTimed)
yellHuman :: m (FailOrCmd RequestTimed)
yellHuman = do
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkWait Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMove Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
Bool -> Bool -> Bool
|| Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMelee Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0
then FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
ReqYell
else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
WaitUnskilled
moveRunHuman :: (MonadClient m, MonadClientUI m)
=> Bool -> Bool -> Bool -> Bool -> Vector
-> m (FailOrCmd RequestTimed)
moveRunHuman :: Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman initialStep :: Bool
initialStep finalGoal :: Bool
finalGoal run :: Bool
run runAhead :: Bool
runAhead dir :: Vector
dir = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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 = $WRunParams :: 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 = 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
$ \sess :: 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 :: * -> *).
(MonadClient 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 <- Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter Bool
run Vector
dir
case FailOrCmd RequestTimed
runStopOrCmd of
Left stopMsg :: FailError
stopMsg -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
stopMsg
Right runCmd :: RequestTimed
runCmd -> 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
[(target :: ActorId
target, _)] | 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
> 0 ->
ActorId -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> m (FailOrCmd RequestTimed)
displaceAid ActorId
target
_ : _ : _ | Bool
run
Bool -> Bool -> Bool
&& Bool
initialStep
Bool -> Bool -> Bool
&& Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkDisplace Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ->
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceMultiple
(target :: ActorId
target, tb :: Actor
tb) : _ | Bool -> Bool
not Bool
run
Bool -> Bool -> Bool
&& Bool
initialStep Bool -> Bool -> Bool
&& Bool
finalGoal
Bool -> Bool -> Bool
&& Actor -> FactionId
bfid Actor
tb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> FactionId
bfid Actor
sb Bool -> Bool -> Bool
&& Bool -> Bool
not (Actor -> Bool
bproj Actor
tb) -> do
m ()
forall (m :: * -> *). (MonadClient m, MonadClientUI m) => m ()
stopPlayBack
Bool
success <- Bool -> ActorId -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
target
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
success Bool -> (String, (ActorId, ActorId, Actor)) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` "bump self"
String
-> (ActorId, ActorId, Actor) -> (String, (ActorId, ActorId, Actor))
forall v. String -> v -> (String, v)
`swith` (ActorId
leader, ActorId
target, Actor
tb)) ()
Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "the pointman switched by bumping"
(target :: ActorId
target, tb :: Actor
tb) : _ | Bool -> Bool
not Bool
run
Bool -> Bool -> Bool
&& Bool
initialStep Bool -> Bool -> Bool
&& Bool
finalGoal
Bool -> Bool -> Bool
&& (Actor -> FactionId
bfid Actor
tb FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> FactionId
bfid Actor
sb Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
tb) -> do
m ()
forall (m :: * -> *). (MonadClient 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
> 0
then
ActorId -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ActorId -> m (FailOrCmd RequestTimed)
meleeAid ActorId
target
else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
MeleeUnskilled
_ : _ -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "actor in the way"
meleeAid :: (MonadClient m, MonadClientUI m)
=> ActorId -> m (FailOrCmd RequestTimed)
meleeAid :: ActorId -> m (FailOrCmd RequestTimed)
meleeAid target :: ActorId
target = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
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
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "nothing to melee with"
Just wp :: RequestTimed
wp -> do
let returnCmd :: m (FailOrCmd RequestTimed)
returnCmd = do
(StateClient -> StateClient) -> m ()
forall (m :: * -> *).
MonadClient m =>
(StateClient -> StateClient) -> m ()
modifyClient ((StateClient -> StateClient) -> m ())
-> (StateClient -> StateClient) -> m ()
forall a b. (a -> b) -> a -> b
$ ActorId
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
updateTarget ActorId
leader ((Maybe Target -> Maybe Target) -> StateClient -> StateClient)
-> (Maybe Target -> Maybe Target) -> StateClient -> StateClient
forall a b. (a -> b) -> a -> b
$ Maybe Target -> Maybe Target -> Maybe Target
forall a b. a -> b -> a
const (Maybe Target -> Maybe Target -> Maybe Target)
-> Maybe Target -> Maybe Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
target
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sxhair :: Maybe Target
sxhair = Target -> Maybe Target
forall a. a -> Maybe a
Just (Target -> Maybe Target) -> Target -> Maybe Target
forall a b. (a -> b) -> a -> b
$ ActorId -> Target
TEnemy ActorId
target}
FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right RequestTimed
wp
res :: m (FailOrCmd RequestTimed)
res | Actor -> Bool
bproj Actor
tb Bool -> Bool -> Bool
|| FactionId -> Faction -> FactionId -> Bool
isFoe 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
"You are bound by an alliance. Really attack?"
if Bool -> Bool
not Bool
go1 then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "attack canceled" else m (FailOrCmd RequestTimed)
returnCmd
| Bool
otherwise = do
Bool
go2 <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
"This attack will start a war. Are you sure?"
if Bool -> Bool
not Bool
go2 then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "attack canceled" else m (FailOrCmd RequestTimed)
returnCmd
m (FailOrCmd RequestTimed)
res
displaceAid :: MonadClientUI m
=> ActorId -> m (FailOrCmd RequestTimed)
displaceAid :: ActorId -> m (FailOrCmd RequestTimed)
displaceAid target :: ActorId
target = do
COps{TileSpeedup
coTileSpeedup :: COps -> TileSpeedup
coTileSpeedup :: TileSpeedup
coTileSpeedup} <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
Actor
tb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
target
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
<= 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 -> (ActorId, Actor, ActorId, Actor) -> String
forall v. Show v => String -> v -> String
`showFailure` (ActorId
leader, Actor
sb, ActorId
target, Actor
tb)
[_] -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> FailOrCmd RequestTimed
forall a b. b -> Either a b
Right (RequestTimed -> FailOrCmd RequestTimed)
-> RequestTimed -> FailOrCmd RequestTimed
forall a b. (a -> b) -> a -> b
$ ActorId -> RequestTimed
ReqDisplace ActorId
target
_ -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceMultiple
else ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
DisplaceAccess
moveSearchAlter :: (MonadClient m, MonadClientUI m)
=> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter :: Bool -> Vector -> m (FailOrCmd RequestTimed)
moveSearchAlter run :: Bool
run dir :: 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
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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
> 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 <- LevelId -> Point -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition (Actor -> LevelId
blid Actor
sb) Point
tpos
((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.
(MonadClient m, 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
$ "the terrain is" Text -> Text -> Text
<+>
if | TileSpeedup -> ContentId TileKind -> Bool
Tile.isModifiable TileSpeedup
coTileSpeedup ContentId TileKind
t -> "potentially modifiable"
| Bool
alterable -> "potentially triggerable"
| Bool
otherwise -> "completely inert"
else Bool -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon 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 :: (MonadClient m, MonadClientUI m)
=> Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon :: Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon bumping :: Bool
bumping tpos :: 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
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgTutorialHint "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 (iid :: ItemId
iid, kit :: (Int, ItemTimers)
kit@(k :: Int
k, _)) =
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 (\(iid :: ItemId
iid, kit :: (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
$
["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 ["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
<= 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 <- LevelId -> Point -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition (Actor -> LevelId
blid Actor
sb) Point
tpos
((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.
(MonadClient m, 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
> 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 <- Bool -> ActorId -> Point -> m (FailOrCmd ())
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> Point -> m (FailOrCmd ())
verifyAlters Bool
bumping ActorId
leader 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
Point -> Text -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Point -> Text -> m ()
msgAddDone Point
tpos "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 err :: FailError
err -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
runOnceAheadHuman :: (MonadClient m, MonadClientUI m)
=> m (Either MError RequestTimed)
runOnceAheadHuman :: m (Either MError RequestTimed)
runOnceAheadHuman = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Bool
keyPressed <- m Bool
forall (m :: * -> *). MonadClientUI m => m Bool
anyKeyPressed
Maybe RunParams
srunning <- (SessionUI -> Maybe RunParams) -> m (Maybe RunParams)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RunParams
srunning
case Maybe RunParams
srunning of
Nothing -> do
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason "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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason "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
_runParams | Bool
keyPressed -> do
m ()
forall (m :: * -> *). MonadClientUI m => m ()
discardPressedKey
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason "run stop: key pressed"
FailOrCmd RequestTimed -> Either MError RequestTimed
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd RequestTimed -> Either MError RequestTimed)
-> m (FailOrCmd RequestTimed) -> m (Either MError RequestTimed)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "interrupted"
Just runParams :: RunParams
runParams -> do
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
Either Text RequestTimed
runOutcome <- LevelId -> RunParams -> m (Either Text RequestTimed)
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> RunParams -> m (Either Text RequestTimed)
continueRun LevelId
arena RunParams
runParams
case Either Text RequestTimed
runOutcome of
Left stopMsg :: Text
stopMsg -> do
MsgClassIgnore -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassIgnore
MsgRunStopReason ("run stop:" Text -> Text -> Text
<+> Text
stopMsg)
Either MError RequestTimed -> m (Either MError RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError RequestTimed -> m (Either MError RequestTimed))
-> Either MError RequestTimed -> m (Either MError RequestTimed)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError RequestTimed
forall a b. a -> Either a b
Left MError
forall a. Maybe a
Nothing
Right runCmd :: RequestTimed
runCmd ->
Either MError RequestTimed -> m (Either MError RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError RequestTimed -> m (Either MError RequestTimed))
-> Either MError RequestTimed -> m (Either MError RequestTimed)
forall a b. (a -> b) -> a -> b
$ RequestTimed -> Either MError RequestTimed
forall a b. b -> Either a b
Right RequestTimed
runCmd
moveOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
=> m (FailOrCmd RequestTimed)
moveOnceToXhairHuman :: m (FailOrCmd RequestTimed)
moveOnceToXhairHuman = Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair Bool
True Bool
False
goToXhair :: (MonadClient m, MonadClientUI m)
=> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair :: Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair initialStep :: Bool
initialStep run :: Bool
run = do
Maybe AimMode
aimMode <- (SessionUI -> Maybe AimMode) -> m (Maybe AimMode)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe AimMode
saimMode
if Maybe AimMode -> Bool
forall a. Maybe a -> Bool
isJust Maybe AimMode
aimMode
then Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "cannot move in aiming mode"
else Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairExplorationMode Bool
initialStep Bool
run
goToXhairExplorationMode :: (MonadClient m, MonadClientUI m)
=> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairExplorationMode :: Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairExplorationMode initialStep :: Bool
initialStep run :: Bool
run = 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 Bool -> Bool
not (Maybe Target -> Bool
forall a. Maybe a -> Bool
isNothing 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 "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
$ \sess :: SessionUI
sess -> SessionUI
sess {sxhairGoTo :: Maybe Target
sxhairGoTo = Maybe Target
xhair}
Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairGoTo 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
$ \sess :: 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
goToXhairGoTo :: (MonadClient m, MonadClientUI m)
=> Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairGoTo :: Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhairGoTo initialStep :: Bool
initialStep run :: Bool
run = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
Maybe Point
xhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
case Maybe Point
xhairPos of
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "crosshair position invalid"
Just c :: Point
c -> do
Maybe RunParams
running <- (SessionUI -> Maybe RunParams) -> m (Maybe RunParams)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe RunParams
srunning
case Maybe RunParams
running of
Just paramOld :: RunParams
paramOld | Bool -> Bool
not Bool
initialStep -> do
LevelId
arena <- m LevelId
forall (m :: * -> *). MonadClientUI m => m LevelId
getArenaUI
FailOrCmd (Bool, Vector)
runOutcome <- LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo LevelId
arena Point
c RunParams
paramOld
case FailOrCmd (Bool, Vector)
runOutcome of
Left stopMsg :: FailError
stopMsg -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
stopMsg
Right (finalGoal :: Bool
finalGoal, dir :: Vector
dir) ->
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman Bool
initialStep Bool
finalGoal Bool
run Bool
False Vector
dir
_ | Point
c Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Actor -> Point
bpos Actor
b -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "position reached"
_ -> do
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool
initialStep Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
run) ()
(bfs :: Array BfsDistance
bfs, mpath :: Maybe AndPath
mpath) <- ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
getCacheBfsAndPath ActorId
leader Point
c
Bool
xhairMoused <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sxhairMoused
case Maybe AndPath
mpath of
_ | Bool
xhairMoused Bool -> Bool -> Bool
&& Maybe 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
"no route to crosshair (press again to go there anyway)"
_ | Bool
initialStep Bool -> Bool -> Bool
&& Point -> Point -> Bool
adjacent (Actor -> Point
bpos Actor
b) Point
c -> do
let dir :: Vector
dir = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
c
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman Bool
initialStep Bool
True Bool
run Bool
False Vector
dir
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no route to crosshair"
Just AndPath{pathList :: AndPath -> [Point]
pathList=[]} -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "almost there"
Just AndPath{pathList :: AndPath -> [Point]
pathList = p1 :: Point
p1 : _} -> do
let finalGoal :: Bool
finalGoal = Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
c
dir :: Vector
dir = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
p1
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool
-> Bool -> Bool -> Bool -> Vector -> m (FailOrCmd RequestTimed)
moveRunHuman Bool
initialStep Bool
finalGoal Bool
run Bool
False Vector
dir
multiActorGoTo :: (MonadClient m, MonadClientUI m)
=> LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo :: LevelId -> Point -> RunParams -> m (FailOrCmd (Bool, Vector))
multiActorGoTo arena :: LevelId
arena c :: Point
c paramOld :: RunParams
paramOld =
case RunParams
paramOld of
RunParams{runMembers :: RunParams -> [ActorId]
runMembers = []} -> Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "selected actors no longer there"
RunParams{runMembers :: RunParams -> [ActorId]
runMembers = r :: ActorId
r : rs :: [ActorId]
rs, 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
xhairPos <- m (Maybe Point)
forall (m :: * -> *). MonadClientUI m => m (Maybe Point)
xhairToPos
if Bool -> Bool
not Bool
onLevel Bool -> Bool -> Bool
|| Maybe Point
xhairPos 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 = 0}
(bfs :: Array BfsDistance
bfs, mpath :: Maybe AndPath
mpath) <- ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
forall (m :: * -> *).
MonadClient m =>
ActorId -> Point -> m (Array BfsDistance, Maybe AndPath)
getCacheBfsAndPath ActorId
r Point
c
Bool
xhairMoused <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
sxhairMoused
case Maybe AndPath
mpath of
_ | Bool
xhairMoused Bool -> Bool -> Bool
&& Maybe 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 "no route to crosshair (press again to go there anyway)"
Nothing -> Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no route to crosshair"
Just AndPath{pathList :: AndPath -> [Point]
pathList=[]} -> Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "almost there"
Just AndPath{pathList :: AndPath -> [Point]
pathList = p1 :: Point
p1 : _} -> do
let finalGoal :: Bool
finalGoal = Point
p1 Point -> Point -> Bool
forall a. Eq a => a -> a -> Bool
== Point
c
dir :: Vector
dir = Point -> Point -> Vector
towards (Actor -> Point
bpos Actor
b) Point
p1
[ActorId]
tgts <- (State -> [ActorId]) -> m [ActorId]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [ActorId]) -> m [ActorId])
-> (State -> [ActorId]) -> m [ActorId]
forall a b. (a -> b) -> a -> b
$ Point -> LevelId -> State -> [ActorId]
posToAids Point
p1 LevelId
arena
case [ActorId]
tgts of
[] -> do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {srunning :: Maybe RunParams
srunning = RunParams -> Maybe RunParams
forall a. a -> Maybe a
Just RunParams
paramNew}
FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector)))
-> FailOrCmd (Bool, Vector) -> m (FailOrCmd (Bool, Vector))
forall a b. (a -> b) -> a -> b
$ (Bool, Vector) -> FailOrCmd (Bool, Vector)
forall a b. b -> Either a b
Right (Bool
finalGoal, Vector
dir)
[target :: ActorId
target] | ActorId
target ActorId -> [ActorId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [ActorId]
rs Bool -> Bool -> Bool
|| 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
+ 1}
_ ->
Text -> m (FailOrCmd (Bool, Vector))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "collective running finished"
runOnceToXhairHuman :: (MonadClient m, MonadClientUI m)
=> m (FailOrCmd RequestTimed)
runOnceToXhairHuman :: m (FailOrCmd RequestTimed)
runOnceToXhairHuman = Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair Bool
True Bool
True
continueToXhairHuman :: (MonadClient m, MonadClientUI m)
=> m (FailOrCmd RequestTimed)
continueToXhairHuman :: m (FailOrCmd RequestTimed)
continueToXhairHuman = Bool -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Bool -> m (FailOrCmd RequestTimed)
goToXhair Bool
False Bool
False
moveItemHuman :: forall m. (MonadClient m, MonadClientUI m)
=> [CStore] -> CStore -> Maybe Text -> Bool
-> m (FailOrCmd RequestTimed)
moveItemHuman :: [CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
moveItemHuman stores :: [CStore]
stores destCStore :: CStore
destCStore mverb :: Maybe Text
mverb auto :: Bool
auto = do
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (CStore
destCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore]
stores) ()
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkMoveItem Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
then [CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
moveOrSelectItem [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. (MonadClient m, MonadClientUI m)
=> [CStore] -> CStore -> Maybe Text -> Bool
-> m (FailOrCmd RequestTimed)
moveOrSelectItem :: [CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
moveOrSelectItem storesRaw :: [CStore]
storesRaw destCStore :: CStore
destCStore mverb :: Maybe Text
mverb auto :: Bool
auto = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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
$ \s :: 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
CEqp : rest :: [CStore]
rest@(_ : _) | Bool -> Bool
not Bool
calmE -> [CStore]
rest [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CEqp]
CGround : rest :: [CStore]
rest@(_ : _) | Bool
overStash -> [CStore]
rest [CStore] -> [CStore] -> [CStore]
forall a. [a] -> [a] -> [a]
++ [CStore
CGround]
_ -> [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
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
case Maybe (ItemId, CStore, Bool)
itemSel of
_ | [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 "you can't loot items from your own stash"
Just (_, fromCStore :: CStore
fromCStore@CStore
CEqp, _) | 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 "neither the selected item nor any other can be unequipped"
Just (_, fromCStore :: CStore
fromCStore@CStore
CGround, _) | 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 "you vainly paw through your own hoard"
Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) | CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
destCStore
Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore]
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
Nothing ->
[CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
moveOrSelectItem [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
Just (k :: Int
k, it :: 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
> 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
== 0 -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no more items can be equipped"
| Bool
otherwise -> do
Either MError Int
socK <- Bool -> Int -> m (Either MError Int)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Int -> m (Either MError Int)
pickNumber (Bool -> Bool
not Bool
auto) Int
kToPick
case Either MError Int
socK of
Left Nothing -> [CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
moveOrSelectItem [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
Left (Just err :: FailError
err) -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
Right kChosen :: 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
<$> [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
moveItems [CStore]
stores (CStore, [(ItemId, (Int, ItemTimers))])
is CStore
destCStore
_ -> do
FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
mis <- [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
selectItemsToMove [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
case FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))])
mis of
Left err :: FailError
err -> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed))
-> FailOrCmd RequestTimed -> m (FailOrCmd RequestTimed)
forall a b. (a -> b) -> a -> b
$ FailError -> FailOrCmd RequestTimed
forall a b. a -> Either a b
Left FailError
err
Right (fromCStore :: CStore
fromCStore, [(iid :: ItemId
iid, _)]) | [CStore]
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
$ \sess :: SessionUI
sess ->
SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
False)}
[CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[CStore]
-> CStore -> Maybe Text -> Bool -> m (FailOrCmd RequestTimed)
moveOrSelectItem [CStore]
stores CStore
destCStore Maybe Text
mverb Bool
auto
Right is :: (CStore, [(ItemId, (Int, ItemTimers))])
is@(fromCStore :: CStore
fromCStore, _) ->
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
<$> [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
[CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
moveItems [CStore]
stores (CStore, [(ItemId, (Int, ItemTimers))])
is CStore
destCStore
selectItemsToMove :: forall m. (MonadClient m, MonadClientUI m)
=> [CStore] -> CStore -> Maybe Text -> Bool
-> m (FailOrCmd (CStore, [(ItemId, ItemQuant)]))
selectItemsToMove :: [CStore]
-> CStore
-> Maybe Text
-> Bool
-> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
selectItemsToMove stores :: [CStore]
stores destCStore :: CStore
destCStore mverb :: Maybe Text
mverb auto :: 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
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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
$ \s :: 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 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 (lastFrom :: CStore
lastFrom, lastDest :: CStore
lastDest) | CStore
lastDest CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
destCStore
Bool -> Bool -> Bool
&& CStore
lastFrom CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore]
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
_ -> [CStore]
stores
prompt :: Text
prompt = "What to"
promptEqp :: Text
promptEqp = "What consumable to"
eqpItemsN :: Actor -> Text
eqpItemsN body :: 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
forall a. Semigroup a => a -> a -> a
<> [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs Int
n "item"]
ppItemDialogBody :: Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody body :: Actor
body actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur = case ItemDialogMode
cCur of
MStore CEqp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorSk ->
"distractedly paw at" Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
MStore 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) ->
"greedily fondle" Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
cCur
_ -> case CStore
destCStore of
CEqp | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Actor -> Skills -> Bool
calmEnough Actor
body Skills
actorSk ->
"distractedly attempt to" Text -> Text -> Text
<+> Text
verb
Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
CEqp | Actor -> Int -> Bool
eqpOverfull Actor
body 1 ->
"attempt to fit into equipment" Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
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) ->
"greedily attempt to" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
CEqp -> Text
verb
Text -> Text -> Text
<+> Actor -> Text
eqpItemsN Actor
body Text -> Text -> Text
<+> "so far)"
Text -> Text -> Text
<+> ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
cCur
_ -> 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
<+> "now)"
else ""
(promptGeneric :: Text
promptGeneric, psuit :: 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
$ \_ itemFull :: ItemFull
itemFull _kit :: (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 <-
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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
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 m Suitability
psuit
(\body :: Actor
body _ actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur _ ->
Text
prompt Text -> Text -> Text
<+> Actor -> Skills -> ItemDialogMode -> Text
ppItemDialogBody Actor
body Skills
actorSk ItemDialogMode
cCur)
(\body :: Actor
body _ actorSk :: Skills
actorSk cCur :: ItemDialogMode
cCur _ ->
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 (fromCStore :: CStore
fromCStore, l :: [(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
$ \sess :: SessionUI
sess ->
SessionUI
sess {slastItemMove :: Maybe (CStore, CStore)
slastItemMove = (CStore, CStore) -> Maybe (CStore, CStore)
forall a. a -> Maybe a
Just (CStore
fromCStore, CStore
destCStore)}
FailOrCmd (CStore, [(ItemId, (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 err :: Text
err -> Text -> m (FailOrCmd (CStore, [(ItemId, (Int, ItemTimers))]))
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
moveItems :: forall m. (MonadClient m, MonadClientUI m)
=> [CStore] -> (CStore, [(ItemId, ItemQuant)]) -> CStore
-> m RequestTimed
moveItems :: [CStore]
-> (CStore, [(ItemId, (Int, ItemTimers))])
-> CStore
-> m RequestTimed
moveItems stores :: [CStore]
stores (fromCStore :: CStore
fromCStore, l :: [(ItemId, (Int, ItemTimers))]
l) destCStore :: 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) ()
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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 [] _ = [(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
ret4 ((iid :: ItemId
iid, (k :: Int
k, _)) : rest :: [(ItemId, (Int, ItemTimers))]
rest) oldN :: 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
> 0) ()
retRec :: CStore -> m [(ItemId, Int, CStore, CStore)]
retRec toCStore :: 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 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
+ 1) -> do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Warning:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpOverfull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Warning:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpStackFull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
CStore -> m [(ItemId, Int, CStore, CStore)]
retRec CStore
CStash
| Bool -> Bool
not Bool
calmE -> do
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionWarning (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Warning:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
ItemNotCalm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
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
CEqp | Actor -> Int -> Bool
eqpOverfull Actor
b (Int
oldN Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 1) -> do
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptItems (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Failure:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpOverfull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
[(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptItems (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$
"Failure:" Text -> Text -> Text
<+> ReqFailure -> Text
showReqFailure ReqFailure
EqpStackFull Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
[(ItemId, Int, CStore, CStore)]
-> m [(ItemId, Int, CStore, CStore)]
forall (m :: * -> *) a. Monad m => a -> m a
return []
_ -> 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 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
-> ([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) => m (FailOrCmd RequestTimed)
projectHuman :: m (FailOrCmd RequestTimed)
projectHuman = do
Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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
<= 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 (_, COrgan, _) -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "can't fling an organ"
Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) -> do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
case ItemId
iid ItemId -> ItemBag -> Maybe (Int, ItemTimers)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to fling"
Just _kit :: (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))
(CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
projectItem (CStore, (ItemId, ItemFull))
i
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to fling"
projectItem :: (MonadClient m, MonadClientUI m)
=> (CStore, (ItemId, ItemFull))
-> m (FailOrCmd RequestTimed)
projectItem :: (CStore, (ItemId, ItemFull)) -> m (FailOrCmd RequestTimed)
projectItem (fromCStore :: CStore
fromCStore, (iid :: ItemId
iid, itemFull :: ItemFull
itemFull)) = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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 <- m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (Either Text (ItemFull -> Either ReqFailure (Point, Bool)))
psuitReq
case Either Text (ItemFull -> Either ReqFailure (Point, Bool))
mpsuitReq of
Left err :: Text
err -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
err
Right psuitReqFun :: ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ->
case ItemFull -> Either ReqFailure (Point, Bool)
psuitReqFun ItemFull
itemFull of
Left reqFail :: ReqFailure
reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
reqFail
Right (pos :: Point
pos, _) -> do
Benefit{Double
benFling :: Benefit -> Double
benFling :: Double
benFling} <- (StateClient -> Benefit) -> m Benefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Benefit) -> m Benefit)
-> (StateClient -> Benefit) -> m Benefit
forall a b. (a -> b) -> a -> b
$ (DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (DiscoveryBenefit -> Benefit)
-> (StateClient -> DiscoveryBenefit) -> StateClient -> Benefit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> DiscoveryBenefit
sdiscoBenefit
Bool
go <- if Double
benFling Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= 0
then ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
"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
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
applyHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd RequestTimed)
applyHuman :: m (FailOrCmd RequestTimed)
applyHuman = do
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
if Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkApply
Skills
actorCurAndMaxSk Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then
ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
ApplyUnskilled
else do
Maybe (ItemId, CStore, Bool)
itemSel <- (SessionUI -> Maybe (ItemId, CStore, Bool))
-> m (Maybe (ItemId, CStore, Bool))
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe (ItemId, CStore, Bool)
sitemSel
case Maybe (ItemId, CStore, Bool)
itemSel of
Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) -> do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
case ItemId
iid ItemId -> ItemBag -> Maybe (Int, ItemTimers)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to trigger"
Just kit :: (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
(CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)
applyItem (CStore
fromCStore, (ItemId
iid, (ItemFull
itemFull, (Int, ItemTimers)
kit)))
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to trigger"
applyItem :: (MonadClient m, MonadClientUI m)
=> (CStore, (ItemId, ItemFullKit))
-> m (FailOrCmd RequestTimed)
applyItem :: (CStore, (ItemId, ItemFullKit)) -> m (FailOrCmd RequestTimed)
applyItem (fromCStore :: CStore
fromCStore, (iid :: ItemId
iid, (itemFull :: ItemFull
itemFull, kit :: (Int, ItemTimers)
kit))) = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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 Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> (Int, ItemTimers)
-> Either ReqFailure Bool
permittedApply Time
localTime Int
skill Bool
calmE (CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
fromCStore)
ItemFull
itemFull (Int, ItemTimers)
kit of
Left reqFail :: ReqFailure
reqFail -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
reqFail
Right _ -> do
Benefit{Double
benApply :: Benefit -> Double
benApply :: Double
benApply} <- (StateClient -> Benefit) -> m Benefit
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient ((StateClient -> Benefit) -> m Benefit)
-> (StateClient -> Benefit) -> m Benefit
forall a b. (a -> b) -> a -> b
$ (DiscoveryBenefit -> ItemId -> Benefit
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (DiscoveryBenefit -> Benefit)
-> (StateClient -> DiscoveryBenefit) -> StateClient -> Benefit
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StateClient -> DiscoveryBenefit
sdiscoBenefit
Bool
go <-
if | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
Bool -> Bool -> Bool
&& Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem) ->
ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
"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
< 0 ->
ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorFull
"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
$ \sess :: SessionUI
sess -> SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = Maybe (ItemId, CStore, Bool)
forall a. Maybe a
Nothing}
Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
alterDirHuman :: (MonadClient m, MonadClientUI m)
=> m (FailOrCmd RequestTimed)
alterDirHuman :: m (FailOrCmd RequestTimed)
alterDirHuman = Text -> m (Maybe Point)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Text -> m (Maybe Point)
pickPoint "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 p :: Point
p -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Point -> m (FailOrCmd RequestTimed)
alterTileAtPos Point
p
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
alterTileAtPos :: (MonadClient m, MonadClientUI m)
=> Point
-> m (FailOrCmd RequestTimed)
alterTileAtPos :: Point -> m (FailOrCmd RequestTimed)
alterTileAtPos pos :: Point
pos = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
sb <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
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
Bool -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> Point -> m (FailOrCmd RequestTimed)
alterCommon Bool
False Point
pos
verifyAlters :: forall m. (MonadClient m, MonadClientUI m)
=> Bool -> ActorId -> Point -> m (FailOrCmd ())
verifyAlters :: Bool -> ActorId -> Point -> m (FailOrCmd ())
verifyAlters bumping :: Bool
bumping source :: ActorId
source tpos :: 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
source
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 (\(iid :: ItemId
iid, kit :: (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
Tile.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 Bool -> ActorId -> Point -> [TileAction] -> m (FailOrCmd ())
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> Point -> [TileAction] -> m (FailOrCmd ())
processTileActions Bool
bumping ActorId
source Point
tpos [TileAction]
tileActions
processTileActions :: forall m. (MonadClient m, MonadClientUI m)
=> Bool -> ActorId -> Point -> [Tile.TileAction]
-> m (FailOrCmd ())
processTileActions :: Bool -> ActorId -> Point -> [TileAction] -> m (FailOrCmd ())
processTileActions bumping :: Bool
bumping source :: ActorId
source tpos :: Point
tpos tas :: [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
source
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 sourceIsMist :: Bool
sourceIsMist = 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
<= 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 -> [Tile.TileAction] -> Bool
-> m (FailOrCmd (Maybe (Bool, Bool)))
processTA :: Maybe Bool
-> [TileAction] -> Bool -> m (FailOrCmd (Maybe (Bool, Bool)))
processTA museResult :: Maybe Bool
museResult [] bumpFailed :: 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 museResult :: Maybe Bool
museResult (ta :: TileAction
ta : rest :: [TileAction]
rest) bumpFailed :: Bool
bumpFailed = case TileAction
ta of
Tile.EmbedAction (iid :: ItemId
iid, _) -> do
let useResult :: Bool
useResult = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
False Maybe Bool
museResult
if | Bool
sourceIsMist
Bool -> Bool -> Bool
|| Actor -> Bool
bproj Actor
sb Bool -> Bool -> Bool
&& Int
tileMinSkill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
| (Effect -> Bool) -> [Effect] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (Bool -> Bool
not (Bool -> Bool) -> (Effect -> Bool) -> Effect -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
m (FailOrCmd ())
verifyEscape
case FailOrCmd ()
mfail of
Left err :: 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
Tile.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
> 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
Tile.WithAction tools0 :: [(Int, GroupName ItemKind)]
tools0 _ ->
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
source [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
source [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 (\(x :: Int
x, y :: GroupName ItemKind
y) -> (Bool
False, Int
x, GroupName ItemKind
y)) [(Int, GroupName ItemKind)]
tools0
(_, iidsToApply :: [(CStore, (ItemId, ItemFull))]
iidsToApply, grps :: [(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 (_, (_, ItemFull{ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind})) =
ItemKind -> Dice
IK.idamage ItemKind
itemKind Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
/= 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 ()
(store :: CStore
store, (_, itemFull :: ItemFull
itemFull)) : _ ->
LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
verifyToolEffect (Actor -> LevelId
blid Actor
sb) CStore
store ItemFull
itemFull
case FailOrCmd ()
mfail of
Left err :: 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 err :: 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 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 (useResult :: Bool
useResult, bumpFailed :: 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 <- LevelId -> Point -> m [(MsgClassShow, Text)]
forall (m :: * -> *).
MonadClientUI m =>
LevelId -> Point -> m [(MsgClassShow, Text)]
lookAtPosition (Actor -> LevelId
blid Actor
sb) Point
tpos
((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.
(MonadClient m, 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 = "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
<> "' 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.
(MonadClient m, 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 "unable to activate nor modify at this time"
verifyEscape :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ())
verifyEscape :: m (FailOrCmd ())
verifyEscape = do
FactionId
side <- (StateClient -> FactionId) -> m FactionId
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> FactionId
sside
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
if Bool -> Bool
not (Player -> Bool
MK.fcanEscape (Player -> Bool) -> Player -> Bool
forall a b. (a -> b) -> a -> b
$ Faction -> Player
gplayer Faction
fact)
then Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith
"This is the way out, but where would you go in this alien world?"
else do
(_, total :: 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
== 0 =
"You finally reached the way out. Really leave now?"
| Int
total Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 =
"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 =
"You've finally found the way out, but you didn't gather all valuables rumoured to be laying around. Really leave already?"
| Bool
otherwise =
"This is the way out and you collected all treasure there is to find. Really leave now?"
Bool
go <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW Text
prompt
if Bool -> Bool
not Bool
go
then Text -> m (FailOrCmd ())
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "here's your chance"
else FailOrCmd () -> m (FailOrCmd ())
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd () -> m (FailOrCmd ()))
-> FailOrCmd () -> m (FailOrCmd ())
forall a b. (a -> b) -> a -> b
$ () -> FailOrCmd ()
forall a b. b -> Either a b
Right ()
verifyToolEffect :: (MonadClient m, MonadClientUI m)
=> LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
verifyToolEffect :: LevelId -> CStore -> ItemFull -> m (FailOrCmd ())
verifyToolEffect lid :: LevelId
lid store :: CStore
store itemFull :: 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 (name1 :: Part
name1, powers :: 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 = "Do you really want to transform the terrain using"
Text -> Text -> Text
<+> Text
objectA Text -> Text -> Text
<+> CStore -> Text
ppCStoreIn CStore
store
Text -> Text -> Text
<+> "that may cause substantial side-effects?"
objectThe :: Text
objectThe = [Part] -> Text
makePhrase ["the", Part
name1]
Bool
go <- ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient 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
$ "replace" Text -> Text -> Text
<+> Text
objectThe 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 :: (MonadClient m, MonadClientUI m)
=> m (FailOrCmd RequestTimed)
alterWithPointerHuman :: m (FailOrCmd RequestTimed)
alterWithPointerHuman = do
COps{corule :: COps -> RuleContent
corule=RuleContent{Int
rXmax :: RuleContent -> Int
rXmax :: Int
rXmax, Int
rYmax :: RuleContent -> Int
rYmax :: Int
rYmax}} <- (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@(Point px :: Int
px py :: Int
py) = PointSquare -> Point
squareToMap (PointSquare -> Point) -> PointSquare -> Point
forall a b. (a -> b) -> a -> b
$ PointUI -> PointSquare
uiToSquare PointUI
pUI
if Int
px Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
py Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 0 Bool -> Bool -> Bool
&& Int
px Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rXmax Bool -> Bool -> Bool
&& Int
py Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
rYmax
then Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Point -> m (FailOrCmd RequestTimed)
alterTileAtPos Point
p
else Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
closeDirHuman :: (MonadClient m, MonadClientUI m)
=> m (FailOrCmd RequestTimed)
closeDirHuman :: m (FailOrCmd RequestTimed)
closeDirHuman = 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
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
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
[o :: Point
o] -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Point -> m (FailOrCmd RequestTimed)
closeTileAtPos Point
o
_ -> Text -> m (Maybe Point)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Text -> m (Maybe Point)
pickPoint "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
Nothing -> Text -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
Just p :: Point
p -> Point -> m (FailOrCmd RequestTimed)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Point -> m (FailOrCmd RequestTimed)
closeTileAtPos Point
p
closeTileAtPos :: (MonadClient m, MonadClientUI m)
=> Point -> m (FailOrCmd RequestTimed)
closeTileAtPos :: Point -> m (FailOrCmd RequestTimed)
closeTileAtPos tpos :: 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
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Skills
actorCurAndMaxSk <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
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
(False, _, _) -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseNothing
(True, False, False) -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseNonClosable
(True, True, False) -> ReqFailure -> m (FailOrCmd RequestTimed)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
CloseClosed
(True, True, True) -> String -> m (FailOrCmd RequestTimed)
forall a. (?callStack::CallStack) => String -> a
error "TileKind content validation"
(True, False, True) ->
if | Point
tpos Point -> Point -> Int
`chessDist` Actor -> Point
bpos Actor
b Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 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
<= 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
Point -> Text -> m ()
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Point -> Text -> m ()
msgAddDone Point
tpos "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 :: (MonadClient m, MonadClientUI m) => Point -> Text -> m ()
msgAddDone :: Point -> Text -> m ()
msgAddDone p :: Point
p verb :: 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
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
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
[] -> "thing"
("open" : xs :: [Text]
xs) -> [Text] -> Text
T.unwords [Text]
xs
_ -> Text
tname
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 0 0 = "underneath"
| Bool
otherwise = Vector -> Text
compassText Vector
v
MsgClassShowAndSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShowAndSave
MsgActionComplete (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "You" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
<+> "the" Text -> Text -> Text
<+> Text
s Text -> Text -> Text
<+> Text
dir Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
pickPoint :: (MonadClient m, MonadClientUI m) => Text -> m (Maybe Point)
pickPoint :: Text -> m (Maybe Point)
pickPoint verb :: Text
verb = do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
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.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ "Where to" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "? [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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> [KM] -> Slideshow -> m KM
getConfirms ColorMode
ColorFull [KM]
keys Slideshow
slides
case KM -> Key
K.key KM
km of
K.LeftButtonRelease -> do
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
_ -> 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 :: (MonadClient m, 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 cmdSemInCxtOfKM :: 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{..} <- 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
let modeH :: (Text, (EnumMap DisplayFont Overlay, [KYX]))
modeH = ( "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 [] acc :: [[String]]
acc _ = [[String] -> [[String]] -> [String]
forall a. [a] -> [[a]] -> [a]
intercalate [""] ([[String]] -> [[String]]
forall a. [a] -> [a]
reverse [[String]]
acc)]
packIntoScreens ([] : ls :: [[String]]
ls) [] _ =
[[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens [[String]]
ls [] 0
packIntoScreens (l :: [String]
l : ls :: [[String]]
ls) [] h :: 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
== 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
- 3
then [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens [[String]]
ls [[String]
l] ([String] -> Int
forall a. [a] -> Int
length [String]
l)
else let (screen :: [String]
screen, rest :: [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
- 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) [] 0
packIntoScreens (l :: [String]
l : ls :: [[String]]
ls) acc :: [[String]]
acc h :: Int
h =
if [String] -> Int
forall a. [a] -> Int
length [String]
l Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 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
- 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
+ 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]]
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) [] 0
manualScreens :: [[String]]
manualScreens = [[String]] -> [[String]] -> Int -> [[String]]
packIntoScreens (([String], [[String]]) -> [[String]]
forall a b. (a, b) -> b
snd ([String], [[String]])
rintroScreen) [] 0
shiftPointUI :: Int -> PointUI -> PointUI
shiftPointUI x :: Int
x (PointUI x0 :: Int
x0 y0 :: Int
y0) = Int -> Int -> PointUI
PointUI (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
x) Int
y0
sideBySide :: ([AttrLine], [AttrLine]) -> [Overlay]
sideBySide =
if DisplayFont -> Bool
isSquareFont DisplayFont
monoFont
then \(screen1 :: [AttrLine]
screen1, screen2 :: [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 \(screen1 :: [AttrLine]
screen1, screen2 :: [AttrLine]
screen2) ->
[[AttrLine] -> Overlay
offsetOverlay [AttrLine]
screen1
Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((PointUI -> PointUI) -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first ((PointUI -> PointUI)
-> (PointUI, AttrLine) -> (PointUI, AttrLine))
-> (PointUI -> PointUI)
-> (PointUI, AttrLine)
-> (PointUI, AttrLine)
forall a b. (a -> b) -> a -> b
$ Int -> PointUI -> PointUI
shiftPointUI Int
rwidth) ([AttrLine] -> Overlay
offsetOverlay [AttrLine]
screen2)]
listPairs :: [[a]] -> [([a], [a])]
listPairs (a :: [a]
a : b :: [a]
b : rest :: [[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]
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 ov :: a
ov =
( "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 (t :: Text
t, okx :: (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.escKM] (EnumMap DisplayFont Overlay, [KYX])
okx
sli :: Slideshow
sli = FontSetup -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
toSlideshow FontSetup
fontSetup ([(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow)
-> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
forall a b. (a -> b) -> a -> b
$ [[(EnumMap DisplayFont Overlay, [KYX])]]
-> [(EnumMap DisplayFont Overlay, [KYX])]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[(EnumMap DisplayFont Overlay, [KYX])]]
-> [(EnumMap DisplayFont Overlay, [KYX])])
-> [[(EnumMap DisplayFont Overlay, [KYX])]]
-> [(EnumMap DisplayFont Overlay, [KYX])]
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 a b. (a -> b) -> [a] -> [b]
map (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
Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "help" ColorMode
ColorFull Bool
True Slideshow
sli [KM
K.spaceKM, KM
K.escKM]
case Either KM SlotChar
ekm of
Left km :: KM
km | 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 -> 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 (_desc :: [CmdCategory]
_desc, _cats :: Text
_cats, cmd :: HumanCmd
cmd) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm
hintHuman :: (MonadClient m, 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 cmdSemInCxtOfKM :: 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 :: * -> *). (MonadClient 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
helpHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
dashboardHuman :: (MonadClient m, 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 cmdSemInCxtOfKM :: 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{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let offsetCol2 :: Int
offsetCol2 = 2
(ov0 :: EnumMap DisplayFont Overlay
ov0, kxs0 :: [KYX]
kxs0) = InputContent
-> DisplayFont
-> DisplayFont
-> Int
-> Int
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> (EnumMap DisplayFont Overlay, [KYX])
okxsN InputContent
coinput DisplayFont
monoFont DisplayFont
propFont 0 Int
offsetCol2 (Bool -> HumanCmd -> Bool
forall a b. a -> b -> a
const Bool
False)
Bool
False CmdCategory
CmdDashboard ([], [], []) ([], [])
al1 :: AttrString
al1 = Text -> AttrString
textToAS "Dashboard"
let splitHelp :: (AttrString, (EnumMap DisplayFont Overlay, [KYX]))
-> [(EnumMap DisplayFont Overlay, [KYX])]
splitHelp (al :: AttrString
al, okx :: (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
- 2) Int
rwidth
AttrString
al [KM
K.escKM] (EnumMap DisplayFont Overlay, [KYX])
okx
sli :: Slideshow
sli = FontSetup -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
toSlideshow FontSetup
fontSetup ([(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.escKM]
Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "dashboard" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
extraKeys
case Either KM SlotChar
ekm of
Left km :: KM
km -> case KM
km KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InputContent -> Map KM CmdTriple
bcmdMap InputContent
coinput of
_ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
Just (_desc :: [CmdCategory]
_desc, _cats :: Text
_cats, cmd :: HumanCmd
cmd) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm
itemMenuHuman :: (MonadClient m, MonadClientUI m)
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
cmdSemInCxtOfKM :: KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = 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
fontSetup :: FontSetup
fontSetup@FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
case Maybe (ItemId, CStore, Bool)
itemSel of
Just (iid :: ItemId
iid, fromCStore :: CStore
fromCStore, _) -> do
ActorId
leader <- m ActorId
forall (m :: * -> *). MonadClientUI m => m ActorId
getLeaderUI
Actor
b <- (State -> Actor) -> m Actor
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Actor) -> m Actor) -> (State -> Actor) -> m Actor
forall a b. (a -> b) -> a -> b
$ ActorId -> State -> Actor
getActorBody ActorId
leader
ActorUI
bUI <- (SessionUI -> ActorUI) -> m ActorUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> ActorUI) -> m ActorUI)
-> (SessionUI -> ActorUI) -> m ActorUI
forall a b. (a -> b) -> a -> b
$ ActorId -> SessionUI -> ActorUI
getActorUI ActorId
leader
ItemBag
bag <- (State -> ItemBag) -> m ItemBag
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemBag) -> m ItemBag)
-> (State -> ItemBag) -> m ItemBag
forall a b. (a -> b) -> a -> b
$ Actor -> CStore -> State -> ItemBag
getBodyStoreBag Actor
b CStore
fromCStore
case ItemId
iid ItemId -> ItemBag -> Maybe (Int, ItemTimers)
forall k a. Enum k => k -> EnumMap k a -> Maybe a
`EM.lookup` ItemBag
bag of
Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to open item menu for"
Just kit :: (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 <- m Skills
forall (m :: * -> *). MonadClientUI m => m Skills
leaderSkillsClientUI
ItemFull
itemFull <- (State -> ItemFull) -> m ItemFull
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> ItemFull) -> m ItemFull)
-> (State -> ItemFull) -> m ItemFull
forall a b. (a -> b) -> a -> b
$ ItemId -> State -> ItemFull
itemToFull ItemId
iid
Time
localTime <- (State -> Time) -> m Time
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Time) -> m Time) -> (State -> Time) -> m Time
forall a b. (a -> b) -> a -> b
$ LevelId -> State -> Time
getLocalTime (Actor -> LevelId
blid Actor
b)
[(ActorId, (Actor, CStore))]
found <- (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))])
-> (State -> [(ActorId, (Actor, CStore))])
-> m [(ActorId, (Actor, CStore))]
forall a b. (a -> b) -> a -> b
$ ActorId
-> FactionId -> ItemId -> State -> [(ActorId, (Actor, CStore))]
findIid ActorId
leader (Actor -> FactionId
bfid Actor
b) ItemId
iid
EnumMap FactionId Faction
factionD <- (State -> EnumMap FactionId Faction)
-> m (EnumMap FactionId Faction)
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> EnumMap FactionId Faction
sfactionD
LevelId
jlid <- (SessionUI -> LevelId) -> m LevelId
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession ((SessionUI -> LevelId) -> m LevelId)
-> (SessionUI -> LevelId) -> m LevelId
forall a b. (a -> b) -> a -> b
$ (EnumMap ItemId LevelId -> ItemId -> LevelId
forall k a. Enum k => EnumMap k a -> k -> a
EM.! ItemId
iid) (EnumMap ItemId LevelId -> LevelId)
-> (SessionUI -> EnumMap ItemId LevelId) -> SessionUI -> LevelId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SessionUI -> EnumMap ItemId LevelId
sitemUI
let !_A :: ()
_A = Bool -> () -> ()
forall a. (?callStack::CallStack) => Bool -> a -> a
assert (Bool -> Bool
not ([(ActorId, (Actor, CStore))] -> Bool
forall a. [a] -> Bool
null [(ActorId, (Actor, CStore))]
found) Bool -> Bool -> Bool
|| CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
CGround
Bool -> (ItemId, ActorId) -> Bool
forall a. Show a => Bool -> a -> Bool
`blame` (ItemId
iid, ActorId
leader)) ()
fAlt :: (ActorId, (Actor, CStore)) -> Bool
fAlt (aid :: ActorId
aid, (_, store :: CStore
store)) = ActorId
aid ActorId -> ActorId -> Bool
forall a. Eq a => a -> a -> Bool
/= ActorId
leader Bool -> Bool -> Bool
|| CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
fromCStore
foundAlt :: [(ActorId, (Actor, CStore))]
foundAlt = ((ActorId, (Actor, CStore)) -> Bool)
-> [(ActorId, (Actor, CStore))] -> [(ActorId, (Actor, CStore))]
forall a. (a -> Bool) -> [a] -> [a]
filter (ActorId, (Actor, CStore)) -> Bool
fAlt [(ActorId, (Actor, CStore))]
found
partRawActor :: ActorId -> m Part
partRawActor aid :: 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 aid :: ActorId
aid store :: 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
forall a. [a] -> [a] -> [a]
++ Text -> String
T.unpack ([Part] -> Text
makePhrase [Part]
parts) String -> String -> String
forall a. [a] -> [a] -> [a]
++ "]"
[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 (\(aid :: ActorId
aid, (_, store :: CStore
store)) -> ActorId -> CStore -> m String
forall (m :: * -> *).
MonadClientUI m =>
ActorId -> CStore -> m String
ppLoc ActorId
aid CStore
store) [(ActorId, (Actor, CStore))]
foundAlt
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 "" else "The item is also in:"
markParagraphs :: Bool
markParagraphs = Int
rheight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 45
descAl :: AttrString
descAl = Int
-> Bool
-> FactionId
-> EnumMap FactionId Faction
-> Int
-> CStore
-> Time
-> LevelId
-> ItemFull
-> (Int, ItemTimers)
-> AttrString
itemDesc Int
rwidth Bool
markParagraphs (Actor -> FactionId
bfid Actor
b) EnumMap FactionId Faction
factionD
(Skill -> Skills -> Int
Ability.getSk Skill
Ability.SkHurtMelee
Skills
actorCurAndMaxSk)
CStore
fromCStore Time
localTime LevelId
jlid ItemFull
itemFull (Int, ItemTimers)
kit
(descSymAl :: AttrString
descSymAl, descBlurbAl :: AttrString
descBlurbAl) = (AttrCharW32 -> Bool) -> AttrString -> (AttrString, AttrString)
forall a. (a -> Bool) -> [a] -> ([a], [a])
span (AttrCharW32 -> AttrCharW32 -> Bool
forall a. Eq a => a -> a -> Bool
/= AttrCharW32
Color.spaceAttrW32) AttrString
descAl
descSym :: Overlay
descSym = [AttrLine] -> Overlay
offsetOverlay ([AttrLine] -> Overlay) -> [AttrLine] -> Overlay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth AttrString
descSymAl
descBlurb :: Overlay
descBlurb = [(Int, AttrLine)] -> Overlay
offsetOverlayX ([(Int, AttrLine)] -> Overlay) -> [(Int, AttrLine)] -> Overlay
forall a b. (a -> b) -> a -> b
$
case Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
rwidth Int
rwidth
(AttrString -> [AttrLine]) -> AttrString -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ String -> AttrString
stringToAS "xx" AttrString -> AttrString -> AttrString
forall a. [a] -> [a] -> [a]
++ AttrString
descBlurbAl of
[] -> String -> [(Int, AttrLine)]
forall a. (?callStack::CallStack) => String -> a
error "splitting AttrString loses characters"
al1 :: AttrLine
al1 : rest :: [AttrLine]
rest ->
(2, AttrString -> AttrLine
attrStringToAL (AttrString -> AttrLine) -> AttrString -> AttrLine
forall a b. (a -> b) -> a -> b
$ Int -> AttrString -> AttrString
forall a. Int -> [a] -> [a]
drop 2 (AttrString -> AttrString) -> AttrString -> AttrString
forall a b. (a -> b) -> a -> b
$ AttrLine -> AttrString
attrLine AttrLine
al1) (Int, AttrLine) -> [(Int, AttrLine)] -> [(Int, AttrLine)]
forall a. a -> [a] -> [a]
: (AttrLine -> (Int, AttrLine)) -> [AttrLine] -> [(Int, AttrLine)]
forall a b. (a -> b) -> [a] -> [b]
map (0,) [AttrLine]
rest
alPrefix :: Overlay
alPrefix = ((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map (\(PointUI x :: Int
x y :: Int
y, al :: AttrLine
al) ->
(Int -> Int -> PointUI
PointUI Int
x (Int
y Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
descBlurb), AttrLine
al))
(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
descBlurb Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
forall a. [a] -> Int
length Overlay
alPrefix Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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
alPrefix))
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)
[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 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rwidth else Int
rwidth
(ovFoundRaw :: Overlay
ovFoundRaw, kxsFound :: [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
alPrefix 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
$ \s :: 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
greyedOut :: HumanCmd -> Bool
greyedOut cmd :: HumanCmd
cmd = Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& CStore
fromCStore CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
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 -> Bool
greyedOut HumanCmd
exploration Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
aiming
ComposeIfLocal cmd1 :: HumanCmd
cmd1 cmd2 :: HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
ComposeUnlessError cmd1 :: HumanCmd
cmd1 cmd2 :: HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
Compose2ndLocal cmd1 :: HumanCmd
cmd1 cmd2 :: HumanCmd
cmd2 -> HumanCmd -> Bool
greyedOut HumanCmd
cmd1 Bool -> Bool -> Bool
|| HumanCmd -> Bool
greyedOut HumanCmd
cmd2
MoveItem stores :: [CStore]
stores destCStore :: CStore
destCStore _ _ ->
CStore
fromCStore CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [CStore]
stores
Bool -> Bool -> Bool
|| 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 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
$ (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id
(Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> (Int, ItemTimers)
-> Either ReqFailure Bool
permittedApply 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
$ (ReqFailure -> Bool)
-> (Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Bool -> ReqFailure -> Bool
forall a b. a -> b -> a
const Bool
False) Bool -> Bool
forall a. a -> a
id
(Either ReqFailure Bool -> Bool) -> Either ReqFailure Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
False Int
skill Bool
calmE ItemFull
itemFull
_ -> Bool
False
fmt :: Int -> Text -> Text -> Text
fmt n :: Int
n k :: Text
k h :: Text
h = " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Text -> Text
T.justifyLeft Int
n ' ' Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
h
offsetCol2 :: Int
offsetCol2 = 11
keyCaption :: Text
keyCaption = Int -> Text -> Text -> Text
fmt Int
offsetCol2 "keys" "command"
offset :: Int
offset = 1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Overlay -> Int
maxYofOverlay (Overlay
descBlurb Overlay -> Overlay -> Overlay
forall a. [a] -> [a] -> [a]
++ Overlay
ovFound)
(ov0 :: EnumMap DisplayFont Overlay
ov0, kxs0 :: [KYX]
kxs0) = InputContent
-> DisplayFont
-> DisplayFont
-> Int
-> Int
-> (HumanCmd -> Bool)
-> Bool
-> CmdCategory
-> ([Text], [Text], [Text])
-> ([Text], [Text])
-> (EnumMap DisplayFont Overlay, [KYX])
okxsN InputContent
coinput DisplayFont
monoFont DisplayFont
propFont Int
offset Int
offsetCol2
HumanCmd -> Bool
greyedOut Bool
True CmdCategory
CmdItemMenu
([], [], ["", Text
keyCaption]) ([], [])
t0 :: Text
t0 = [Part] -> Text
makeSentence [ Part -> Part -> Part
MU.SubjectVerbSg (ActorUI -> Part
partActor ActorUI
bUI) "choose"
, "an item", Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ CStore -> Text
ppCStoreIn CStore
fromCStore ]
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 "\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 (al :: AttrString
al, okx :: (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
- 2) Int
rwidth AttrString
al
[KM
K.spaceKM, KM
K.escKM] (EnumMap DisplayFont Overlay, [KYX])
okx
sli :: Slideshow
sli = FontSetup -> [(EnumMap DisplayFont Overlay, [KYX])] -> Slideshow
toSlideshow FontSetup
fontSetup
([(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
descSym
(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
descBlurb
(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
Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen "item menu" ColorMode
ColorFull Bool
False Slideshow
sli [KM]
extraKeys
case Either KM SlotChar
ekm of
Left km :: KM
km -> case KM
km KM -> Map KM CmdTriple -> Maybe CmdTriple
forall k a. Ord k => k -> Map k a -> Maybe a
`M.lookup` InputContent -> Map KM CmdTriple
bcmdMap InputContent
coinput of
_ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.escKM -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
_ | KM
km KM -> KM -> Bool
forall a. Eq a => a -> a -> Bool
== KM
K.spaceKM -> 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 "back to list"
_ | KM
km KM -> [KM] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [KM]
foundKeys -> case KM
km of
K.KM{key :: KM -> Key
key=K.Fun n :: Int
n} -> do
let (newAid :: ActorId
newAid, (bNew :: Actor
bNew, newCStore :: 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
- 1)
Faction
fact <- (State -> Faction) -> m Faction
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState ((State -> Faction) -> m Faction)
-> (State -> Faction) -> m Faction
forall a b. (a -> b) -> a -> b
$ (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! Actor -> FactionId
bfid Actor
bNew) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let (autoDun :: Bool
autoDun, _) = Faction -> (Bool, Bool)
autoDungeonLevel Faction
fact
if | Actor -> LevelId
blid Actor
bNew LevelId -> LevelId -> Bool
forall a. Eq a => a -> a -> Bool
/= Actor -> LevelId
blid Actor
b Bool -> Bool -> Bool
&& Bool
autoDun ->
FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReqFailure -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a.
MonadClientUI m =>
ReqFailure -> m (FailOrCmd a)
failSer ReqFailure
NoChangeDunLeader
| Bool
otherwise -> do
m Bool -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m Bool -> m ()) -> m Bool -> m ()
forall a b. (a -> b) -> a -> b
$ Bool -> ActorId -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ActorId -> m Bool
pickLeader Bool
True ActorId
newAid
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
newCStore, Bool
False)}
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
itemMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
_ -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> KM -> String
forall v. Show v => String -> v -> String
`showFailure` KM
km
Just (_desc :: [CmdCategory]
_desc, _cats :: Text
_cats, cmd :: HumanCmd
cmd) -> do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess ->
SessionUI
sess {sitemSel :: Maybe (ItemId, CStore, Bool)
sitemSel = (ItemId, CStore, Bool) -> Maybe (ItemId, CStore, Bool)
forall a. a -> Maybe a
Just (ItemId
iid, CStore
fromCStore, Bool
True)}
KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm
Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "no item to open item menu for"
chooseItemMenuHuman :: (MonadClient m, MonadClientUI m)
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> ItemDialogMode
-> m (Either MError ReqUI)
cmdSemInCxtOfKM :: KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM c0 :: ItemDialogMode
c0 = do
let chooseItemMenu :: ItemDialogMode -> m (Either MError ReqUI)
chooseItemMenu c1 :: ItemDialogMode
c1 = do
FailOrCmd ItemDialogMode
res <- Bool -> ItemDialogMode -> m (FailOrCmd ItemDialogMode)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
Bool -> ItemDialogMode -> m (FailOrCmd ItemDialogMode)
chooseItemDialogMode Bool
True ItemDialogMode
c1
case FailOrCmd ItemDialogMode
res of
Right c2 :: ItemDialogMode
c2 -> do
Either MError ReqUI
res2 <- (KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
itemMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
MError
backToList <- Text -> m MError
forall (m :: * -> *). MonadClientUI m => Text -> m MError
failMsg "back to list"
case Either MError ReqUI
res2 of
Left err :: MError
err | MError
err MError -> MError -> Bool
forall a. Eq a => a -> a -> Bool
== MError
backToList -> ItemDialogMode -> m (Either MError ReqUI)
chooseItemMenu ItemDialogMode
c2
_ -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return Either MError ReqUI
res2
Left err :: FailError
err -> Either MError ReqUI -> m (Either MError ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either MError ReqUI -> m (Either MError ReqUI))
-> Either MError ReqUI -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ MError -> Either MError ReqUI
forall a b. a -> Either a b
Left (MError -> Either MError ReqUI) -> MError -> Either MError ReqUI
forall a b. (a -> b) -> a -> b
$ FailError -> MError
forall a. a -> Maybe a
Just FailError
err
ItemDialogMode -> m (Either MError ReqUI)
chooseItemMenu ItemDialogMode
c0
generateMenu :: (MonadClient m, MonadClientUI m)
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(K.KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
cmdSemInCxtOfKM :: KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM blurb :: [(DisplayFont, [AttrLine])]
blurb kds :: [(KM, (Text, HumanCmd))]
kds gameInfo :: [String]
gameInfo menuName :: 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{coscreen :: CCUI -> ScreenContent
coscreen=ScreenContent{Int
rwidth :: Int
rwidth :: ScreenContent -> Int
rwidth, 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{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
let bindings :: [(Maybe KM, String)]
bindings =
let fmt :: (KM, (Text, b)) -> (Maybe KM, String)
fmt (k :: KM
k, (d :: Text
d, _)) =
( KM -> Maybe KM
forall a. a -> Maybe a
Just KM
k
, Text -> String
T.unpack
(Text -> String) -> Text -> String
forall a b. (a -> b) -> a -> b
$ Int -> Char -> Text -> Text
T.justifyLeft 3 ' ' (String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ KM -> String
K.showKM KM
k) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> " " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
d )
in ((KM, (Text, HumanCmd)) -> (Maybe KM, String))
-> [(KM, (Text, HumanCmd))] -> [(Maybe KM, String)]
forall a b. (a -> b) -> [a] -> [b]
map (KM, (Text, HumanCmd)) -> (Maybe KM, String)
forall b. (KM, (Text, b)) -> (Maybe KM, String)
fmt [(KM, (Text, HumanCmd))]
kds
generate :: Int -> (Maybe K.KM, String) -> ((Int, AttrLine), Maybe KYX)
generate :: Int -> (Maybe KM, String) -> ((Int, AttrLine), Maybe KYX)
generate y :: Int
y (mkey :: Maybe KM
mkey, binding :: String
binding) =
let lenB :: Int
lenB = String -> Int
forall a. [a] -> Int
length String
binding
yxx :: KM -> KYX
yxx key :: KM
key = ([KM] -> Either [KM] SlotChar
forall a b. a -> Either a b
Left [KM
key], ( Int -> Int -> PointUI
PointUI 2 Int
y
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
squareFont Int
lenB ))
myxx :: Maybe KYX
myxx = KM -> KYX
yxx (KM -> KYX) -> Maybe KM -> Maybe KYX
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe KM
mkey
in ((2, String -> AttrLine
stringToAL String
binding), Maybe KYX
myxx)
titleLine :: String
titleLine = RuleContent -> String
rtitle RuleContent
corule String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
showVersion (RuleContent -> Version
rexeVersion RuleContent
corule) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " "
rawLines :: [(Maybe KM, String)]
rawLines = [Maybe KM] -> [String] -> [(Maybe KM, String)]
forall a b. [a] -> [b] -> [(a, b)]
zip (Maybe KM -> [Maybe KM]
forall a. a -> [a]
repeat Maybe KM
forall a. Maybe a
Nothing)
(["", String
titleLine String -> String -> String
forall a. [a] -> [a] -> [a]
++ "[" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
rwebAddress String -> String -> String
forall a. [a] -> [a] -> [a]
++ "]", ""]
[String] -> [String] -> [String]
forall a. [a] -> [a] -> [a]
++ [String]
gameInfo)
[(Maybe KM, String)]
-> [(Maybe KM, String)] -> [(Maybe KM, String)]
forall a. [a] -> [a] -> [a]
++ [(Maybe KM, String)]
bindings
(menuOvLines :: [(Int, AttrLine)]
menuOvLines, mkyxs :: [Maybe KYX]
mkyxs) = [((Int, AttrLine), Maybe KYX)] -> ([(Int, AttrLine)], [Maybe KYX])
forall a b. [(a, b)] -> ([a], [b])
unzip ([((Int, AttrLine), Maybe KYX)]
-> ([(Int, AttrLine)], [Maybe KYX]))
-> [((Int, AttrLine), Maybe KYX)]
-> ([(Int, AttrLine)], [Maybe KYX])
forall a b. (a -> b) -> a -> b
$ (Int -> (Maybe KM, String) -> ((Int, AttrLine), Maybe KYX))
-> [Int] -> [(Maybe KM, String)] -> [((Int, AttrLine), Maybe KYX)]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Int -> (Maybe KM, String) -> ((Int, AttrLine), Maybe KYX)
generate [0..] [(Maybe KM, String)]
rawLines
browserKey :: KYX
browserKey = ( SlotChar -> Either [KM] SlotChar
forall a b. b -> Either a b
Right (SlotChar -> Either [KM] SlotChar)
-> SlotChar -> Either [KM] SlotChar
forall a b. (a -> b) -> a -> b
$ Int -> Char -> SlotChar
SlotChar 1042 'a'
, ( Int -> Int -> PointUI
PointUI (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ 2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* String -> Int
forall a. [a] -> Int
length String
titleLine) 1
, DisplayFont -> Int -> ButtonWidth
ButtonWidth DisplayFont
squareFont (2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
length String
rwebAddress) ) )
kyxs :: [KYX]
kyxs = KYX
browserKey KYX -> [KYX] -> [KYX]
forall a. a -> [a] -> [a]
: [Maybe KYX] -> [KYX]
forall a. [Maybe a] -> [a]
catMaybes [Maybe KYX]
mkyxs
introLen :: Int
introLen = [Int] -> Int
forall a. Num a => [a] -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$ ((DisplayFont, [AttrLine]) -> Int)
-> [(DisplayFont, [AttrLine])] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([AttrLine] -> Int
forall a. [a] -> Int
length ([AttrLine] -> Int)
-> ((DisplayFont, [AttrLine]) -> [AttrLine])
-> (DisplayFont, [AttrLine])
-> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (DisplayFont, [AttrLine]) -> [AttrLine]
forall a b. (a, b) -> b
snd) [(DisplayFont, [AttrLine])]
blurb
start0 :: Int
start0 = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 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 1 else 2)
shiftPointUI :: PointUI -> PointUI
shiftPointUI (PointUI x0 :: Int
x0 y0 :: Int
y0) = Int -> Int -> PointUI
PointUI (Int
x0 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
rwidth) Int
y0
ov0 :: EnumMap DisplayFont Overlay
ov0 = (Overlay -> Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b k. (a -> b) -> EnumMap k a -> EnumMap k b
EM.map (((PointUI, AttrLine) -> (PointUI, AttrLine)) -> Overlay -> Overlay
forall a b. (a -> b) -> [a] -> [b]
map ((PointUI -> PointUI) -> (PointUI, AttrLine) -> (PointUI, AttrLine)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first PointUI -> PointUI
shiftPointUI)) (EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay)
-> EnumMap DisplayFont Overlay -> EnumMap DisplayFont Overlay
forall a b. (a -> b) -> a -> b
$ Int -> [(DisplayFont, [AttrLine])] -> EnumMap DisplayFont Overlay
attrLinesToFontMap Int
start0 [(DisplayFont, [AttrLine])]
blurb
ov :: EnumMap DisplayFont Overlay
ov = (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 ([(Int, AttrLine)] -> Overlay
offsetOverlayX [(Int, AttrLine)]
menuOvLines) EnumMap DisplayFont Overlay
ov0
Map String Int
menuIxMap <- (SessionUI -> Map String Int) -> m (Map String Int)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Map String Int
smenuIxMap
Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (String
menuName String -> Map String Int -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`M.member` Map String Int
menuIxMap) (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
$ \sess :: SessionUI
sess -> SessionUI
sess {smenuIxMap :: Map String Int
smenuIxMap = String -> Int -> Map String Int -> Map String Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
M.insert String
menuName 1 Map String Int
menuIxMap}
Either KM SlotChar
ekm <- String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
String
-> ColorMode -> Bool -> Slideshow -> [KM] -> m (Either KM SlotChar)
displayChoiceScreen String
menuName ColorMode
ColorFull Bool
True
((EnumMap DisplayFont Overlay, [KYX]) -> Slideshow
menuToSlideshow (EnumMap DisplayFont Overlay
ov, [KYX]
kyxs)) [KM
K.escKM]
case Either KM SlotChar
ekm of
Left km :: KM
km -> case KM
km KM -> [(KM, (Text, HumanCmd))] -> Maybe (Text, HumanCmd)
forall a b. Eq a => a -> [(a, b)] -> Maybe b
`lookup` [(KM, (Text, HumanCmd))]
kds of
Just (_desc :: Text
_desc, cmd :: HumanCmd
cmd) -> KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM KM
km HumanCmd
cmd
Nothing -> FailOrCmd ReqUI -> Either MError ReqUI
forall a. FailOrCmd a -> Either MError a
weaveJust (FailOrCmd ReqUI -> Either MError ReqUI)
-> m (FailOrCmd ReqUI) -> m (Either MError ReqUI)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "never mind"
Right (SlotChar 1042 'a') -> 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))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM [(DisplayFont, [AttrLine])]
blurb [(KM, (Text, HumanCmd))]
kds [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 "failed to open web browser"
Right _slot :: SlotChar
_slot -> String -> m (Either MError ReqUI)
forall a. (?callStack::CallStack) => String -> a
error (String -> m (Either MError ReqUI))
-> String -> m (Either MError ReqUI)
forall a b. (a -> b) -> a -> b
$ "" String -> Either KM SlotChar -> String
forall v. Show v => String -> v -> String
`showFailure` Either KM SlotChar
ekm
mainMenuHuman :: (MonadClient m, 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 cmdSemInCxtOfKM :: KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
CCUI{ coinput :: CCUI -> InputContent
coinput=InputContent{[(KM, CmdTriple)]
bcmdList :: InputContent -> [(KM, CmdTriple)]
bcmdList :: [(KM, CmdTriple)]
bcmdList}
, 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
Challenge
curChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
scurChal
let offOn :: Bool -> p
offOn b :: Bool
b = if Bool
b then "on" else "off"
tcurDiff :: Text
tcurDiff = " with difficulty:" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Challenge -> Int
cdiff Challenge
curChal)
tcurFish :: Text
tcurFish = " cold fish:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cfish Challenge
curChal)
tcurGoods :: Text
tcurGoods = " ready goods:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cgoods Challenge
curChal)
tcurWolf :: Text
tcurWolf = " lone wolf:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cwolf Challenge
curChal)
tcurKeeper :: Text
tcurKeeper = " finder keeper:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
ckeeper Challenge
curChal)
kds :: [(KM, (Text, HumanCmd))]
kds = [(KM
km, (Text
desc, HumanCmd
cmd)) | (km :: KM
km, ([CmdMainMenu], desc :: Text
desc, cmd :: HumanCmd
cmd)) <- [(KM, CmdTriple)]
bcmdList]
gameName :: Text
gameName = ModeKind -> Text
MK.mname ModeKind
gameMode
gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
[ "Now playing:" Text -> Text -> Text
<+> Text
gameName
, ""
, Text
tcurDiff
, Text
tcurFish
, Text
tcurGoods
, Text
tcurWolf
, Text
tcurKeeper
, "" ]
glueLines :: [[a]] -> [[a]]
glueLines (l1 :: [a]
l1 : l2 :: [a]
l2 : rest :: [[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 ll :: [[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] -> [AttrLine]
forall a b. (a -> b) -> a -> b
$ (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ((Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ')) [String]
backstory
(KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM [(DisplayFont
propFont, [AttrLine]
backstoryAL)] [(KM, (Text, HumanCmd))]
kds [String]
gameInfo "main"
mainMenuAutoOnHuman :: (MonadClient m, 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 cmdSemInCxtOfKM :: 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
$ \sess :: SessionUI
sess -> SessionUI
sess {swasAutomated :: Bool
swasAutomated = Bool
True}
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
mainMenuAutoOffHuman :: (MonadClient m, 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 cmdSemInCxtOfKM :: 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
$ \sess :: SessionUI
sess -> SessionUI
sess {swasAutomated :: Bool
swasAutomated = Bool
False}
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
mainMenuHuman KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM
settingsMenuHuman :: (MonadClient m, MonadClientUI m)
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
cmdSemInCxtOfKM :: KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM = do
Int
markSuspect <- (StateClient -> Int) -> m Int
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Int
smarkSuspect
Bool
markVision <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smarkVision
Bool
markSmell <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
smarkSmell
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
$ Player -> Doctrine
MK.fdoctrine (Player -> Doctrine) -> (State -> Player) -> State -> Doctrine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player) -> (State -> Faction) -> State -> Player
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
side) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
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 b :: Bool
b = if Bool
b then "on" else "off"
offOnUnset :: Maybe Bool -> p
offOnUnset mb :: Maybe Bool
mb = case Maybe Bool
mb of
Nothing -> "no override"
Just b :: Bool
b -> if Bool
b then "force on" else "force off"
offOnAll :: v -> p
offOnAll n :: v
n = case v
n of
0 -> "none"
1 -> "untried"
2 -> "all"
_ -> String -> p
forall a. (?callStack::CallStack) => String -> a
error (String -> p) -> String -> p
forall a b. (a -> b) -> a -> b
$ "" String -> v -> String
forall v. Show v => String -> v -> String
`showFailure` v
n
tsuspect :: Text
tsuspect = "mark suspect terrain:" Text -> Text -> Text
<+> Int -> Text
forall v p. (Eq v, Num v, IsString p, Show v) => v -> p
offOnAll Int
markSuspect
tvisible :: Text
tvisible = "show visible zone:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn Bool
markVision
tsmell :: Text
tsmell = "display smell clues:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn Bool
markSmell
tanim :: Text
tanim = "play animations:" Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Bool -> Bool
not Bool
noAnim)
tdoctrine :: Text
tdoctrine = "squad doctrine:" Text -> Text -> Text
<+> Doctrine -> Text
Ability.nameDoctrine Doctrine
factDoctrine
toverride :: Text
toverride = "override tutorial hints:" Text -> Text -> Text
<+> Maybe Bool -> Text
forall p. IsString p => Maybe Bool -> p
offOnUnset Maybe Bool
overrideTut
kds :: [(KM, (Text, HumanCmd))]
kds = [ (String -> KM
K.mkKM "s", (Text
tsuspect, HumanCmd
MarkSuspect))
, (String -> KM
K.mkKM "v", (Text
tvisible, HumanCmd
MarkVision))
, (String -> KM
K.mkKM "c", (Text
tsmell, HumanCmd
MarkSmell))
, (String -> KM
K.mkKM "a", (Text
tanim, HumanCmd
MarkAnim))
, (String -> KM
K.mkKM "t", (Text
tdoctrine, HumanCmd
Doctrine))
, (String -> KM
K.mkKM "o", (Text
toverride, HumanCmd
OverrideTut))
, (String -> KM
K.mkKM "Escape", ("back to main menu", HumanCmd
MainMenu)) ]
gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack
[ "Tweak convenience settings:"
, "" ]
(KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM [] [(KM, (Text, HumanCmd))]
kds [String]
gameInfo "settings"
challengeMenuHuman :: (MonadClient m, MonadClientUI m)
=> (K.KM -> HumanCmd -> m (Either MError ReqUI))
-> m (Either MError ReqUI)
cmdSemInCxtOfKM :: 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, Int
rwrap :: ScreenContent -> Int
rwrap :: Int
rwrap}} <- (SessionUI -> CCUI) -> m CCUI
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> CCUI
sccui
FontSetup{..} <- m FontSetup
forall (m :: * -> *). MonadClientUI m => m FontSetup
getFontSetup
EnumMap (ContentId ModeKind) (Map Challenge Int)
svictories <- (StateClient -> EnumMap (ContentId ModeKind) (Map Challenge Int))
-> m (EnumMap (ContentId ModeKind) (Map Challenge Int))
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> 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
Bool
nxtTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
snxtTutorial
Maybe Bool
overrideTut <- (SessionUI -> Maybe Bool) -> m (Maybe Bool)
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Maybe Bool
soverrideTut
Challenge
nxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
let (gameModeId :: ContentId ModeKind
gameModeId, gameMode :: 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
Nothing -> 0
Just cm :: Map Challenge Int
cm -> Int -> Maybe Int -> Int
forall a. a -> Maybe a -> a
fromMaybe 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 t :: Text
t = if Int
victories Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t else Text
t
tnextScenario :: Text
tnextScenario = "adventure:" Text -> Text -> Text
<+> Text -> Text
star (ModeKind -> Text
MK.mname ModeKind
gameMode)
offOn :: Bool -> p
offOn b :: Bool
b = if Bool
b then "on" else "off"
starTut :: Text -> Text
starTut t :: Text
t = if Maybe Bool -> Bool
forall a. Maybe a -> Bool
isJust Maybe Bool
overrideTut then "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t else Text
t
displayTutorialHints :: Bool
displayTutorialHints = Bool -> Maybe Bool -> Bool
forall a. a -> Maybe a -> a
fromMaybe Bool
nxtTutorial Maybe Bool
overrideTut
tnextTutorial :: Text
tnextTutorial = "tutorial hints (in pink):"
Text -> Text -> Text
<+> Text -> Text
starTut (Bool -> Text
forall p. IsString p => Bool -> p
offOn Bool
displayTutorialHints)
tnextDiff :: Text
tnextDiff = "difficulty (lower easier):" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Challenge -> Int
cdiff Challenge
nxtChal)
tnextFish :: Text
tnextFish = "cold fish (rather hard):"
Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cfish Challenge
nxtChal)
tnextGoods :: Text
tnextGoods = "ready goods (hard):"
Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cgoods Challenge
nxtChal)
tnextWolf :: Text
tnextWolf = "lone wolf (very hard):"
Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
cwolf Challenge
nxtChal)
tnextKeeper :: Text
tnextKeeper = "finder keeper (hard):"
Text -> Text -> Text
<+> Bool -> Text
forall p. IsString p => Bool -> p
offOn (Challenge -> Bool
ckeeper Challenge
nxtChal)
kds :: [(KM, (Text, HumanCmd))]
kds = [ (String -> KM
K.mkKM "s", (Text
tnextScenario, HumanCmd
GameScenarioIncr))
, (String -> KM
K.mkKM "t", (Text
tnextTutorial, HumanCmd
GameTutorialToggle))
, (String -> KM
K.mkKM "d", (Text
tnextDiff, HumanCmd
GameDifficultyIncr))
, (String -> KM
K.mkKM "f", (Text
tnextFish, HumanCmd
GameFishToggle))
, (String -> KM
K.mkKM "r", (Text
tnextGoods, HumanCmd
GameGoodsToggle))
, (String -> KM
K.mkKM "w", (Text
tnextWolf, HumanCmd
GameWolfToggle))
, (String -> KM
K.mkKM "k", (Text
tnextKeeper, HumanCmd
GameKeeperToggle))
, (String -> KM
K.mkKM "g", ("start new game", HumanCmd
GameRestart))
, (String -> KM
K.mkKM "Escape", ("back to main menu", HumanCmd
MainMenu)) ]
gameInfo :: [String]
gameInfo = (Text -> String) -> [Text] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack [ "Setup and start new game:"
, "" ]
widthProp :: Int
widthProp = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont
then Int
rwidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
else Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
rwrap (Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2)
widthMono :: Int
widthMono = if DisplayFont -> Bool
isSquareFont DisplayFont
propFont
then Int
rwidth Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` 2
else Int
rwidth Int -> Int -> Int
forall a. Num a => a -> a -> a
- 2
duplicateEOL :: Char -> Text
duplicateEOL '\n' = "\n\n"
duplicateEOL c :: Char
c = Char -> Text
T.singleton Char
c
blurb :: [(DisplayFont, [AttrLine])]
blurb =
[ ( DisplayFont
propFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
widthProp Int
widthProp
(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
<> "\n\n" )
, ( DisplayFont
monoFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
widthMono Int
widthMono
(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
<> "\n\n" )
, ( DisplayFont
propFont
, Int -> Int -> AttrString -> [AttrLine]
splitAttrString Int
widthProp Int
widthProp
(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) )
]
(KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
(KM -> HumanCmd -> m (Either MError ReqUI))
-> [(DisplayFont, [AttrLine])]
-> [(KM, (Text, HumanCmd))]
-> [String]
-> String
-> m (Either MError ReqUI)
generateMenu KM -> HumanCmd -> m (Either MError ReqUI)
cmdSemInCxtOfKM [(DisplayFont, [AttrLine])]
blurb [(KM, (Text, HumanCmd))]
kds [String]
gameInfo "challenge"
gameTutorialToggle :: MonadClientUI m => m ()
gameTutorialToggle :: m ()
gameTutorialToggle = do
Bool
nxtTutorial <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
snxtTutorial
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
nxtTutorial Maybe Bool
overrideTut
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess { snxtTutorial :: Bool
snxtTutorial = Bool -> Bool
not Bool
displayTutorialHints
, soverrideTut :: Maybe Bool
soverrideTut = Maybe Bool
forall a. Maybe a
Nothing }
gameDifficultyIncr :: MonadClient m => m ()
gameDifficultyIncr :: m ()
gameDifficultyIncr = 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 delta :: Int
delta = -1
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 = 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
< 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
$ \cli :: 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
$ \cli :: StateClient
cli ->
StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {cfish :: Bool
cfish = Bool -> Bool
not (Challenge -> Bool
cfish (StateClient -> Challenge
snxtChal StateClient
cli))} }
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
$ \cli :: 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
$ \cli :: StateClient
cli ->
StateClient
cli {snxtChal :: Challenge
snxtChal = (StateClient -> Challenge
snxtChal StateClient
cli) {cwolf :: Bool
cwolf = Bool -> Bool
not (Challenge -> Bool
cwolf (StateClient -> Challenge
snxtChal StateClient
cli))} }
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
$ \cli :: 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 :: (MonadClient m, MonadClientUI m) => m ()
gameScenarioIncr :: m ()
gameScenarioIncr = 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
+ 1
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
$ \sess :: SessionUI
sess -> SessionUI
sess {Int
snxtScenario :: Int
snxtScenario :: Int
snxtScenario, Bool
snxtTutorial :: Bool
snxtTutorial :: Bool
snxtTutorial}
gameRestartHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)
gameRestartHuman :: m (FailOrCmd ReqUI)
gameRestartHuman = do
COps
cops <- (State -> COps) -> m COps
forall (m :: * -> *) a. MonadStateRead m => (State -> a) -> m a
getsState State -> COps
scops
Bool
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
Bool
b <- if Bool
noConfirmsGame
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
(Text -> m Bool) -> Text -> m Bool
forall a b. (a -> b) -> a -> b
$ "You just requested a new" Text -> Text -> Text
<+> Text
nxtGameName
Text -> Text -> Text
<+> "game. The progress of the ongoing" Text -> Text -> Text
<+> ModeKind -> Text
MK.mname ModeKind
gameMode
Text -> Text -> Text
<+> "game will be lost! Are you sure?"
if Bool
b
then do
Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
let (mainName :: Text
mainName, _) = (Char -> Bool) -> Text -> (Text, Text)
T.span (\c :: Char
c -> Char -> Bool
Char.isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== ' ') Text
nxtGameName
nxtGameGroup :: GroupName ModeKind
nxtGameGroup = Text -> GroupName ModeKind
forall a. Text -> GroupName a
GroupName (Text -> GroupName ModeKind) -> Text -> GroupName ModeKind
forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate " " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take 2 ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
mainName
FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd ReqUI -> m (FailOrCmd ReqUI))
-> FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall a b. (a -> b) -> a -> b
$ ReqUI -> FailOrCmd ReqUI
forall a b. b -> Either a b
Right (ReqUI -> FailOrCmd ReqUI) -> ReqUI -> FailOrCmd ReqUI
forall a b. (a -> b) -> a -> b
$ GroupName ModeKind -> Challenge -> ReqUI
ReqUIGameRestart GroupName ModeKind
nxtGameGroup Challenge
snxtChal
else do
Text
msg2 <- Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI (Rnd Text -> m Text) -> Rnd Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
[ "yea, would be a pity to leave them to die"
, "yea, a shame to get your team stranded" ]
Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
msg2
gameQuitHuman :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)
gameQuitHuman :: m (FailOrCmd ReqUI)
gameQuitHuman = do
Bool
noConfirmsGame <- m Bool
forall (m :: * -> *). MonadStateRead m => m Bool
isNoConfirmsGame
ModeKind
gameMode <- m ModeKind
forall (m :: * -> *). MonadStateRead m => m ModeKind
getGameMode
Bool
b <- if Bool
noConfirmsGame
then Bool -> m Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
else ColorMode -> Text -> m Bool
forall (m :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW
(Text -> m Bool) -> Text -> m Bool
forall a b. (a -> b) -> a -> b
$ "If you quit, the progress of the ongoing" Text -> Text -> Text
<+> ModeKind -> Text
MK.mname ModeKind
gameMode
Text -> Text -> Text
<+> "game will be lost! Are you sure?"
if Bool
b
then do
Challenge
snxtChal <- (StateClient -> Challenge) -> m Challenge
forall (m :: * -> *) a.
MonadClientRead m =>
(StateClient -> a) -> m a
getsClient StateClient -> Challenge
snxtChal
FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. Monad m => a -> m a
return (FailOrCmd ReqUI -> m (FailOrCmd ReqUI))
-> FailOrCmd ReqUI -> m (FailOrCmd ReqUI)
forall a b. (a -> b) -> a -> b
$ ReqUI -> FailOrCmd ReqUI
forall a b. b -> Either a b
Right (ReqUI -> FailOrCmd ReqUI) -> ReqUI -> FailOrCmd ReqUI
forall a b. (a -> b) -> a -> b
$ GroupName ModeKind -> Challenge -> ReqUI
ReqUIGameRestart GroupName ModeKind
MK.INSERT_COIN Challenge
snxtChal
else do
Text
msg2 <- Rnd Text -> m Text
forall (m :: * -> *) a. MonadClientUI m => Rnd a -> m a
rndToActionUI (Rnd Text -> m Text) -> Rnd Text -> m Text
forall a b. (a -> b) -> a -> b
$ [Text] -> Rnd Text
forall a. [a] -> Rnd a
oneOf
[ "yea, would be a pity to leave them to die"
, "yea, a shame to get your team stranded" ]
Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith Text
msg2
gameDropHuman :: (MonadClient m, MonadClientUI m) => m ReqUI
gameDropHuman :: m ReqUI
gameDropHuman = do
(SessionUI -> SessionUI) -> m ()
forall (m :: * -> *).
MonadClientUI m =>
(SessionUI -> SessionUI) -> m ()
modifySession ((SessionUI -> SessionUI) -> m ())
-> (SessionUI -> SessionUI) -> m ()
forall a b. (a -> b) -> a -> b
$ \sess :: SessionUI
sess -> SessionUI
sess {sallNframes :: Int
sallNframes = -1}
MsgClassShow -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassShow
MsgPromptGeneric "Interrupt! Trashing the unsaved game. The program exits now."
Text -> m ()
forall (m :: * -> *). MonadClientUI m => Text -> m ()
clientPrintUI "Interrupt! Trashing the unsaved game. The program exits now."
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameDropAndExit
gameExitHuman :: Monad m => m ReqUI
gameExitHuman :: m ReqUI
gameExitHuman =
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameSaveAndExit
gameSaveHuman :: (MonadClient m, MonadClientUI m) => m ReqUI
gameSaveHuman :: m ReqUI
gameSaveHuman = do
MsgClassSave -> Text -> m ()
forall (m :: * -> *) a.
(MonadClient m, MonadClientUI m, MsgShared a) =>
a -> Text -> m ()
msgAdd MsgClassSave
MsgInnerWorkSpam "Saving game backup."
ReqUI -> m ReqUI
forall (m :: * -> *) a. Monad m => a -> m a
return ReqUI
ReqUIGameSave
doctrineHuman :: (MonadClient m, 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
$ Player -> Doctrine
MK.fdoctrine (Player -> Doctrine) -> (State -> Player) -> State -> Doctrine
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Faction -> Player
gplayer (Faction -> Player) -> (State -> Faction) -> State -> Player
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (EnumMap FactionId Faction -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid) (EnumMap FactionId Faction -> Faction)
-> (State -> EnumMap FactionId Faction) -> State -> Faction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. State -> EnumMap FactionId Faction
sfactionD
let toT :: 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displaySpaceEsc ColorMode
ColorFull
(Text -> m Bool) -> Text -> m Bool
forall a b. (a -> b) -> a -> b
$ "(Beware, work in progress!)"
Text -> Text -> Text
<+> "Current squad doctrine is" Text -> Text -> Text
<+> Doctrine -> Text
Ability.nameDoctrine Doctrine
fromT
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
<+> "Switching doctrine to" Text -> Text -> Text
<+> Doctrine -> Text
Ability.nameDoctrine Doctrine
toT
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
<+> "This clears targets of all non-pointmen teammates."
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 "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 :: (MonadClient m, 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 :: * -> *).
(MonadClient m, MonadClientUI m) =>
ColorMode -> Text -> m Bool
displayYesNo ColorMode
ColorBW "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 "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 :: (MonadClient m, MonadClientUI m) => m (FailOrCmd ReqUI)
automateToggleHuman :: m (FailOrCmd ReqUI)
automateToggleHuman = do
Bool
swasAutomated <- (SessionUI -> Bool) -> m Bool
forall (m :: * -> *) a. MonadClientUI m => (SessionUI -> a) -> m a
getsSession SessionUI -> Bool
swasAutomated
if Bool
swasAutomated
then Text -> m (FailOrCmd ReqUI)
forall (m :: * -> *) a. MonadClientUI m => Text -> m (FailOrCmd a)
failWith "automation canceled"
else m (FailOrCmd ReqUI)
forall (m :: * -> *).
(MonadClient 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