module Game.LambdaHack.Client.HumanSem
( cmdHumanSem
) where
import Control.Monad
import Control.Monad.Writer.Strict (WriterT)
import Data.Maybe
import Control.Exception.Assert.Sugar
import Game.LambdaHack.Client.Action
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.Level
import Game.LambdaHack.Common.Msg
import Game.LambdaHack.Common.ServerCmd
import Game.LambdaHack.Common.Vector
import Game.LambdaHack.Common.VectorXY
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 -> moveRunHuman False v
Run v -> moveRunHuman True v
Wait -> fmap (Just . TakeTimeSer) waitHuman
Pickup -> fmap (Just . TakeTimeSer) pickupHuman
Drop -> fmap (Just . TakeTimeSer) dropHuman
Project ts -> projectHuman ts
Apply ts -> fmap (Just . TakeTimeSer) $ applyHuman ts
AlterDir ts -> fmap (Just . TakeTimeSer) $ alterDirHuman ts
TriggerTile ts -> fmap (Just . TakeTimeSer) $ triggerTileHuman ts
GameRestart t -> fmap Just $ gameRestartHuman t
GameExit -> fmap Just gameExitHuman
GameSave -> fmap Just gameSaveHuman
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"
moveRunHuman :: (MonadClientAbort m, MonadClientUI m)
=> Bool -> VectorXY -> WriterT Slideshow m (Maybe CmdSer)
moveRunHuman run v = do
tgtMode <- getsClient stgtMode
(arena, Level{lxsize}) <- viewedLevel
source <- getLeaderUI
sb <- getsState $ getActorBody source
let dir = toDir lxsize v
if isJust tgtMode then do
moveCursor dir (if run then 10 else 1) >> return Nothing
else do
let tpos = bpos sb `shift` dir
tgt <- getsState $ posToActor tpos arena
case tgt of
Nothing -> do
when run $ modifyClient $ \cli -> cli {srunning = Just (dir, 1)}
fmap (Just . TakeTimeSer) $ moveRunAid source dir
Just target | run ->
fmap (Just . TakeTimeSer) $ displaceAid source target
Just target -> do
tb <- getsState $ getActorBody target
if bfid tb == bfid sb && not (bproj tb) then do
success <- selectLeader target
assert (success `blame` "bump self" `twith` (source, target, tb)) skip
return Nothing
else
fmap (Just . TakeTimeSer) $ meleeAid source target
projectHuman :: (MonadClientAbort m, MonadClientUI m)
=> [Trigger] -> WriterT Slideshow m (Maybe CmdSer)
projectHuman ts = do
tgtLoc <- targetToPos
if isNothing tgtLoc
then retargetLeader >> return Nothing
else do
leader <- getLeaderUI
fmap (Just . TakeTimeSer) $ projectAid leader 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