module Game.LambdaHack.Client.HumanSem
( cmdHumanSem
) where
import Control.Monad
import Control.Monad.Writer.Strict (WriterT)
import qualified Data.EnumMap.Strict as EM
import Data.Maybe
import Game.LambdaHack.Client.Action
import Game.LambdaHack.Client.Draw
import Game.LambdaHack.Client.HumanCmd
import Game.LambdaHack.Client.HumanGlobal
import Game.LambdaHack.Client.HumanLocal
import Game.LambdaHack.Client.State
import Game.LambdaHack.Common.Action
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.ActorState
import Game.LambdaHack.Common.Faction
import qualified Game.LambdaHack.Common.Feature as F
import qualified Game.LambdaHack.Common.Kind as Kind
import Game.LambdaHack.Common.Level
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.ServerCmd
import Game.LambdaHack.Common.State
import qualified Game.LambdaHack.Common.Tile as Tile
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Common.VectorXY
import Game.LambdaHack.Utils.Assert
cmdHumanSem :: (MonadClientAbort m, MonadClientUI m)
=> HumanCmd -> WriterT Slideshow m (Maybe CmdSer)
cmdHumanSem cmd = do
arena <- getArenaUI
when (noRemoteHumanCmd cmd) $ checkCursor arena
cmdAction cmd
cmdAction :: (MonadClientAbort m, MonadClientUI m)
=> HumanCmd -> WriterT Slideshow m (Maybe CmdSer)
cmdAction cmd = case cmd of
Move v -> moveHuman v
Run v -> runHuman v
Wait -> fmap Just waitHuman
Pickup -> fmap Just pickupHuman
Drop -> fmap Just dropHuman
Project ts -> projectHuman ts
Apply ts -> fmap Just $ applyHuman ts
TriggerDir ts -> fmap Just $ triggerDirHuman ts
TriggerTile ts -> fmap Just $ triggerTileHuman ts
GameRestart t -> fmap Just $ gameRestartHuman t
GameExit -> fmap Just gameExitHuman
GameSave -> fmap Just gameSaveHuman
CfgDump -> fmap Just cfgDumpHuman
SelectHero k -> selectHeroHuman k >> return Nothing
MemberCycle -> memberCycleHuman >> return Nothing
MemberBack -> memberBackHuman >> return Nothing
Inventory -> inventoryHuman >> return Nothing
TgtFloor -> tgtFloorHuman
TgtEnemy -> tgtEnemyHuman
TgtAscend k -> tgtAscendHuman k >> return Nothing
EpsIncr b -> epsIncrHuman b >> return Nothing
Cancel -> cancelHuman displayMainMenu >> return Nothing
Accept -> acceptHuman helpHuman >> return Nothing
Clear -> clearHuman >> return Nothing
History -> historyHuman >> return Nothing
MarkVision -> humanMarkVision >> return Nothing
MarkSmell -> humanMarkSmell >> return Nothing
MarkSuspect -> humanMarkSuspect >> return Nothing
Help -> displayMainMenu >> return Nothing
checkCursor :: (MonadClientAbort m, MonadClientUI m) => LevelId -> m ()
checkCursor arena = do
(lid, _) <- viewedLevel
when (arena /= lid) $
abortWith "[targeting] command disabled on a remote level, press ESC to switch back"
moveHuman :: (MonadClientAbort m, MonadClientUI m)
=> VectorXY -> WriterT Slideshow m (Maybe CmdSer)
moveHuman v = do
Kind.COps{cotile} <- getsState scops
tgtMode <- getsClient stgtMode
(arena, lvl@Level{lxsize}) <- viewedLevel
leader <- getLeaderUI
sb <- getsState $ getActorBody leader
if isJust tgtMode then do
let dir = toDir lxsize v
moveCursor dir 1 >> return Nothing
else do
let dir = toDir lxsize v
tpos = bpos sb `shift` dir
t = lvl `at` tpos
tgt <- getsState $ posToActor tpos arena
case tgt of
Just target -> do
tb <- getsState $ getActorBody target
sfact <- getsState $ (EM.! bfid sb) . sfactionD
if bfid tb == bfid sb && not (bproj tb) then do
success <- selectLeader target
assert (success `blame` (leader, target, tb)) skip
return Nothing
else do
unless (bproj tb || isAtWar sfact (bfid tb)) $ do
go <- displayYesNo ColorBW
"This attack will start a war. Are you sure?"
unless go $ abortWith "Attack canceled."
when (not (bproj tb) && isAllied sfact (bfid tb)) $ do
go <- displayYesNo ColorBW
"You are bound by an alliance. Really attack?"
unless go $ abortWith "Attack canceled."
fmap Just $ moveLeader dir
_ -> fmap Just $
if Tile.hasFeature cotile F.Suspect t
|| Tile.hasFeature cotile F.Openable t
then
exploreLeader dir
else
moveLeader dir
runHuman :: MonadClientUI m => VectorXY -> WriterT Slideshow m (Maybe CmdSer)
runHuman v = do
tgtMode <- getsClient stgtMode
(_, Level{lxsize}) <- viewedLevel
if isJust tgtMode then
let dir = toDir lxsize v
in moveCursor dir 10 >> return Nothing
else
let dir = toDir lxsize v
in fmap Just $ runLeader dir
projectHuman :: (MonadClientAbort m, MonadClientUI m)
=> [Trigger] -> WriterT Slideshow m (Maybe CmdSer)
projectHuman ts = do
tgtLoc <- targetToPos
if isNothing tgtLoc
then retargetLeader >> return Nothing
else fmap Just $ projectLeader ts
tgtFloorHuman :: MonadClientUI m => WriterT Slideshow m (Maybe CmdSer)
tgtFloorHuman = do
arena <- getArenaUI
tgtFloorLeader (TgtExplicit arena) >> return Nothing
tgtEnemyHuman :: MonadClientUI m => WriterT Slideshow m (Maybe CmdSer)
tgtEnemyHuman = do
arena <- getArenaUI
tgtEnemyLeader (TgtExplicit arena) >> return Nothing