module Game.LambdaHack.Client.UI.HandleHumanClient
( cmdHumanSem
) where
import Control.Applicative
import Data.Monoid
import Game.LambdaHack.Client.UI.HandleHumanGlobalClient
import Game.LambdaHack.Client.UI.HandleHumanLocalClient
import Game.LambdaHack.Client.UI.HumanCmd
import Game.LambdaHack.Client.UI.MonadClientUI
import Game.LambdaHack.Client.UI.MsgClient
import Game.LambdaHack.Common.Request
cmdHumanSem :: MonadClientUI m => HumanCmd -> m (SlideOrCmd RequestUI)
cmdHumanSem cmd =
if noRemoteHumanCmd cmd then do
arena <- getArenaUI
lidV <- viewedLevel
if arena /= lidV then
failWith "command disabled on a remote level, press ESC to switch back"
else cmdAction cmd
else cmdAction cmd
cmdAction :: MonadClientUI m => HumanCmd -> m (SlideOrCmd RequestUI)
cmdAction cmd = case cmd of
Move v -> fmap anyToUI <$> moveRunHuman True True False False v
Run v -> fmap anyToUI <$> moveRunHuman True True True True v
Wait -> Right <$> fmap ReqUITimed waitHuman
MoveItem cLegalRaw toCStore mverb _ auto ->
fmap ReqUITimed <$> moveItemHuman cLegalRaw toCStore mverb auto
DescribeItem cstore -> fmap ReqUITimed <$> describeItemHuman cstore
Project ts -> fmap ReqUITimed <$> projectHuman ts
Apply ts -> fmap ReqUITimed <$> applyHuman ts
AlterDir ts -> fmap ReqUITimed <$> alterDirHuman ts
TriggerTile ts -> fmap ReqUITimed <$> triggerTileHuman ts
RunOnceAhead -> fmap anyToUI <$> runOnceAheadHuman
MoveOnceToCursor -> fmap anyToUI <$> moveOnceToCursorHuman
RunOnceToCursor -> fmap anyToUI <$> runOnceToCursorHuman
ContinueToCursor -> fmap anyToUI <$> continueToCursorHuman
GameRestart t -> gameRestartHuman t
GameExit -> gameExitHuman
GameSave -> fmap Right gameSaveHuman
Tactic -> tacticHuman
Automate -> automateHuman
GameDifficultyCycle -> addNoSlides gameDifficultyCycle
PickLeader k -> Left <$> pickLeaderHuman k
MemberCycle -> Left <$> memberCycleHuman
MemberBack -> Left <$> memberBackHuman
SelectActor -> addNoSlides selectActorHuman
SelectNone -> addNoSlides selectNoneHuman
Clear -> addNoSlides clearHuman
StopIfTgtMode -> addNoSlides stopIfTgtModeHuman
SelectWithPointer -> addNoSlides selectWithPointer
Repeat n -> addNoSlides $ repeatHuman n
Record -> Left <$> recordHuman
History -> Left <$> historyHuman
MarkVision -> addNoSlides markVisionHuman
MarkSmell -> addNoSlides markSmellHuman
MarkSuspect -> addNoSlides markSuspectHuman
Help -> Left <$> helpHuman
MainMenu -> Left <$> mainMenuHuman
Macro _ kms -> addNoSlides $ macroHuman kms
MoveCursor v k -> Left <$> moveCursorHuman v k
TgtFloor -> Left <$> tgtFloorHuman
TgtEnemy -> Left <$> tgtEnemyHuman
TgtAscend k -> Left <$> tgtAscendHuman k
EpsIncr b -> Left <$> epsIncrHuman b
TgtClear -> Left <$> tgtClearHuman
CursorUnknown -> Left <$> cursorUnknownHuman
CursorItem -> Left <$> cursorItemHuman
CursorStair up -> Left <$> cursorStairHuman up
Cancel -> Left <$> cancelHuman mainMenuHuman
Accept -> Left <$> acceptHuman helpHuman
CursorPointerFloor -> addNoSlides cursorPointerFloorHuman
CursorPointerEnemy -> addNoSlides cursorPointerEnemyHuman
TgtPointerFloor -> Left <$> tgtPointerFloorHuman
TgtPointerEnemy -> Left <$> tgtPointerEnemyHuman
addNoSlides :: Monad m => m () -> m (SlideOrCmd RequestUI)
addNoSlides cmdCli = cmdCli >> return (Left mempty)