{-# LANGUAGE DataKinds, DeriveGeneric, GADTs, KindSignatures, StandaloneDeriving
#-}
module Game.LambdaHack.Common.Request
( RequestAI, ReqAI(..), RequestUI, ReqUI(..)
, RequestTimed(..), RequestAnyAbility(..), ReqFailure(..)
, impossibleReqFailure, showReqFailure, timedToUI
, permittedPrecious, permittedProject, permittedProjectAI, permittedApply
) where
import Prelude ()
import Game.LambdaHack.Common.Prelude
import Data.Binary
import GHC.Generics (Generic)
import Game.LambdaHack.Common.Ability
import Game.LambdaHack.Common.Actor
import Game.LambdaHack.Common.Faction
import Game.LambdaHack.Common.Item
import Game.LambdaHack.Common.ItemStrongest
import Game.LambdaHack.Common.Misc
import Game.LambdaHack.Common.Point
import Game.LambdaHack.Common.Time
import Game.LambdaHack.Common.Vector
import qualified Game.LambdaHack.Content.ItemKind as IK
import Game.LambdaHack.Content.ModeKind
data ReqAI =
ReqAITimed RequestAnyAbility
| ReqAINop
deriving Show
type RequestAI = (ReqAI, Maybe ActorId)
data ReqUI =
ReqUINop
| ReqUITimed RequestAnyAbility
| ReqUIGameRestart !(GroupName ModeKind) !Challenge
| ReqUIGameExit
| ReqUIGameSave
| ReqUITactic !Tactic
| ReqUIAutomate
deriving Show
type RequestUI = (ReqUI, Maybe ActorId)
data RequestAnyAbility = forall a. RequestAnyAbility !(RequestTimed a)
deriving instance Show RequestAnyAbility
timedToUI :: RequestTimed a -> ReqUI
timedToUI = ReqUITimed . RequestAnyAbility
data RequestTimed :: Ability -> * where
ReqMove :: !Vector -> RequestTimed 'AbMove
ReqMelee :: !ActorId -> !ItemId -> !CStore -> RequestTimed 'AbMelee
ReqDisplace :: !ActorId -> RequestTimed 'AbDisplace
ReqAlter :: !Point -> RequestTimed 'AbAlter
ReqWait :: RequestTimed 'AbWait
ReqWait10 :: RequestTimed 'AbWait
ReqMoveItems :: ![(ItemId, Int, CStore, CStore)] -> RequestTimed 'AbMoveItem
ReqProject :: !Point -> !Int -> !ItemId -> !CStore -> RequestTimed 'AbProject
ReqApply :: !ItemId -> !CStore -> RequestTimed 'AbApply
deriving instance Show (RequestTimed a)
data ReqFailure =
MoveNothing
| MeleeSelf
| MeleeDistant
| DisplaceDistant
| DisplaceAccess
| DisplaceProjectiles
| DisplaceDying
| DisplaceBraced
| DisplaceImmobile
| DisplaceSupported
| AlterUnskilled
| AlterUnwalked
| AlterDistant
| AlterBlockActor
| AlterBlockItem
| AlterNothing
| EqpOverfull
| EqpStackFull
| ApplyUnskilled
| ApplyRead
| ApplyOutOfReach
| ApplyCharging
| ApplyNoEffects
| ItemNothing
| ItemNotCalm
| NotCalmPrecious
| ProjectUnskilled
| ProjectAimOnself
| ProjectBlockTerrain
| ProjectBlockActor
| ProjectLobable
| ProjectOutOfReach
| TriggerNothing
| NoChangeDunLeader
deriving (Show, Eq, Generic)
instance Binary ReqFailure
impossibleReqFailure :: ReqFailure -> Bool
impossibleReqFailure reqFailure = case reqFailure of
MoveNothing -> True
MeleeSelf -> True
MeleeDistant -> True
DisplaceDistant -> True
DisplaceAccess -> True
DisplaceProjectiles -> True
DisplaceDying -> True
DisplaceBraced -> True
DisplaceImmobile -> False -- unidentified skill items
DisplaceSupported -> True
AlterUnskilled -> False -- unidentified skill items
AlterUnwalked -> False
AlterDistant -> True
AlterBlockActor -> True -- adjacent actor always visible
AlterBlockItem -> True -- adjacent item always visible
AlterNothing -> True
EqpOverfull -> True
EqpStackFull -> True
ApplyUnskilled -> False -- unidentified skill items
ApplyRead -> False -- unidentified skill items
ApplyOutOfReach -> True
ApplyCharging -> False -- if aspects unknown, charging unknown
ApplyNoEffects -> False -- if effects unknown, can't prevent it
ItemNothing -> True
ItemNotCalm -> False -- unidentified skill items
NotCalmPrecious -> False -- unidentified skill items
ProjectUnskilled -> False -- unidentified skill items
ProjectAimOnself -> True
ProjectBlockTerrain -> True -- adjacent terrain always visible
ProjectBlockActor -> True -- adjacent actor always visible
ProjectLobable -> False -- unidentified skill items
ProjectOutOfReach -> True
TriggerNothing -> True -- terrain underneath always visibl
NoChangeDunLeader -> True
showReqFailure :: ReqFailure -> Text
showReqFailure reqFailure = case reqFailure of
MoveNothing -> "wasting time on moving into obstacle"
MeleeSelf -> "trying to melee oneself"
MeleeDistant -> "trying to melee a distant foe"
DisplaceDistant -> "trying to displace a distant actor"
DisplaceAccess -> "switching places without access"
DisplaceProjectiles -> "trying to displace multiple projectiles"
DisplaceDying -> "trying to displace a dying foe"
DisplaceBraced -> "trying to displace a braced foe"
DisplaceImmobile -> "trying to displace an immobile foe"
DisplaceSupported -> "trying to displace a supported foe"
AlterUnskilled -> "unskilled actors cannot alter tiles"
AlterUnwalked -> "unskilled actors cannot enter tiles"
AlterDistant -> "trying to alter a distant tile"
AlterBlockActor -> "blocked by an actor"
AlterBlockItem -> "jammed by an item"
AlterNothing -> "wasting time on altering nothing"
EqpOverfull -> "cannot equip any more items"
EqpStackFull -> "cannot equip the whole item stack"
ApplyUnskilled -> "unskilled actors cannot apply items"
ApplyRead -> "activating this kind of items requires skill level 2"
ApplyOutOfReach -> "cannot apply an item out of reach"
ApplyCharging -> "cannot apply an item that is still charging"
ApplyNoEffects -> "cannot apply an item that produces no effects"
ItemNothing -> "wasting time on void item manipulation"
ItemNotCalm -> "you are too alarmed to use the shared stash"
NotCalmPrecious -> "you are too alarmed to handle such an exquisite item"
ProjectUnskilled -> "unskilled actors cannot aim"
ProjectAimOnself -> "cannot aim at oneself"
ProjectBlockTerrain -> "aiming obstructed by terrain"
ProjectBlockActor -> "aiming blocked by an actor"
ProjectLobable -> "lobbing an item requires fling skill 3"
ProjectOutOfReach -> "cannot aim an item out of reach"
TriggerNothing -> "wasting time on triggering nothing"
NoChangeDunLeader -> "no manual level change for your team"
-- The item should not be applied nor thrown because it's too delicate
-- to operate when not calm or becuse it's too precious to identify by use.
permittedPrecious :: Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious calmE forced itemFull =
let isPrecious = IK.Precious `elem` jfeature (itemBase itemFull)
in if not calmE && not forced && isPrecious then Left NotCalmPrecious
else Right $ IK.Durable `elem` jfeature (itemBase itemFull)
|| case itemDisco itemFull of
Just ItemDisco{itemAspect=Just _} -> True
_ -> not isPrecious
permittedPreciousAI :: Bool -> ItemFull -> Bool
permittedPreciousAI calmE itemFull =
let isPrecious = IK.Precious `elem` jfeature (itemBase itemFull)
in if not calmE && isPrecious then False
else IK.Durable `elem` jfeature (itemBase itemFull)
|| case itemDisco itemFull of
Just ItemDisco{itemAspect=Just _} -> True
_ -> not isPrecious
permittedProject :: Bool -> Int -> Bool -> [Char] -> ItemFull
-> Either ReqFailure Bool
permittedProject forced skill calmE triggerSyms itemFull@ItemFull{itemBase} =
if | not forced && skill < 1 -> Left ProjectUnskilled
| not forced
&& IK.Lobable `elem` jfeature itemBase
&& skill < 3 -> Left ProjectLobable
| otherwise ->
let legal = permittedPrecious calmE forced itemFull
in case legal of
Left{} -> legal
Right False -> legal
Right True -> Right $
if | null triggerSyms -> True
| ' ' `elem` triggerSyms ->
case strengthEqpSlot itemFull of
Just IK.EqpSlotLightSource -> True
Just _ -> False
Nothing -> not (goesIntoEqp itemBase)
| otherwise -> jsymbol itemBase `elem` triggerSyms
-- Speedup.
permittedProjectAI :: Int -> Bool -> ItemFull -> Bool
permittedProjectAI skill calmE itemFull@ItemFull{itemBase} =
if | skill < 1 -> False
| IK.Lobable `elem` jfeature itemBase
&& skill < 3 -> False
| otherwise -> permittedPreciousAI calmE itemFull
permittedApply :: Time -> Int -> Bool-> [Char] -> ItemFull
-> Either ReqFailure Bool
permittedApply localTime skill calmE triggerSyms itemFull@ItemFull{..} =
if | skill < 1 -> Left ApplyUnskilled
| jsymbol itemBase == '?' && skill < 2 -> Left ApplyRead
-- We assume if the item has a timeout, all or most of interesting
-- effects are under Recharging, so no point activating if not recharged.
-- Note that if client doesn't know the timeout, here we leak the fact
-- that the item is still charging, but the client risks destruction
-- if the item is, in fact, recharged and is not durable
-- (very likely in case of jewellery), so it's OK (the message may be
-- somewhat alarming though).
| not $ hasCharge localTime itemFull -> Left ApplyCharging
| otherwise -> case itemDisco of
Just ItemDisco{itemKind} | null $ IK.ieffects itemKind ->
Left ApplyNoEffects
_ -> let legal = permittedPrecious calmE False itemFull
in case legal of
Left{} -> legal
Right False -> legal
Right True -> Right $
if ' ' `elem` triggerSyms
then IK.Applicable `elem` jfeature itemBase
else jsymbol itemBase `elem` triggerSyms