-- | Possible causes of failure of request.
module Game.LambdaHack.Common.ReqFailure
  ( ReqFailure(..)
  , impossibleReqFailure, showReqFailure
  , permittedPrecious, permittedProject, permittedProjectAI, permittedApply
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Time
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Content.RuleKind as RK
import qualified Game.LambdaHack.Definition.Ability as Ability
import           Game.LambdaHack.Definition.Defs

-- | Possible causes of failure of request.
data ReqFailure =
    MoveUnskilled
  | MoveUnskilledAsleep
  | MoveNothing
  | MeleeUnskilled
  | MeleeSelf
  | MeleeDistant
  | MeleeNotWeapon
  | DisplaceUnskilled
  | DisplaceDistant
  | DisplaceAccess
  | DisplaceMultiple
  | DisplaceDying
  | DisplaceBraced
  | DisplaceImmobile
  | DisplaceSupported
  | AlterUnskilled
  | AlterUnwalked
  | AlterDistant
  | AlterBlockActor
  | AlterBlockItem
  | AlterNothing
  | CloseDistant
  | CloseClosed
  | CloseNothing
  | CloseNonClosable
  | WaitUnskilled
  | YellUnskilled
  | MoveItemUnskilled
  | EqpOverfull
  | EqpStackFull
  | ApplyUnskilled
  | ApplyFood
  | ApplyRead
  | ApplyPeriodic
  | ApplyOutOfReach
  | ApplyCharging
  | ApplyNoEffects
  | ItemNothing
  | ItemNotCalm
  | ItemOverStash
  | NotCalmPrecious
  | ProjectUnskilled
  | ProjectAimOnself
  | ProjectBlockTerrain
  | ProjectBlockActor
  | ProjectLobable
  | ProjectOutOfReach
  | ProjectFinderKeeper
  | NoChangeDunLeader
  deriving (Int -> ReqFailure -> ShowS
[ReqFailure] -> ShowS
ReqFailure -> String
(Int -> ReqFailure -> ShowS)
-> (ReqFailure -> String)
-> ([ReqFailure] -> ShowS)
-> Show ReqFailure
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReqFailure] -> ShowS
$cshowList :: [ReqFailure] -> ShowS
show :: ReqFailure -> String
$cshow :: ReqFailure -> String
showsPrec :: Int -> ReqFailure -> ShowS
$cshowsPrec :: Int -> ReqFailure -> ShowS
Show, ReqFailure -> ReqFailure -> Bool
(ReqFailure -> ReqFailure -> Bool)
-> (ReqFailure -> ReqFailure -> Bool) -> Eq ReqFailure
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReqFailure -> ReqFailure -> Bool
$c/= :: ReqFailure -> ReqFailure -> Bool
== :: ReqFailure -> ReqFailure -> Bool
$c== :: ReqFailure -> ReqFailure -> Bool
Eq)

impossibleReqFailure :: ReqFailure -> Bool
impossibleReqFailure :: ReqFailure -> Bool
impossibleReqFailure ReqFailure
reqFailure = case ReqFailure
reqFailure of
  ReqFailure
MoveUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
MoveUnskilledAsleep -> Bool
False  -- unidentified skill items
  ReqFailure
MoveNothing -> Bool
True
  ReqFailure
MeleeUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
MeleeSelf -> Bool
True
  ReqFailure
MeleeDistant -> Bool
True
  ReqFailure
MeleeNotWeapon -> Bool
False  -- unidentified items
  ReqFailure
DisplaceUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
DisplaceDistant -> Bool
True
  ReqFailure
DisplaceAccess -> Bool
True
  ReqFailure
DisplaceMultiple -> Bool
True
  ReqFailure
DisplaceDying -> Bool
True
  ReqFailure
DisplaceBraced -> Bool
True
  ReqFailure
DisplaceImmobile -> Bool
False  -- unidentified skill items
  ReqFailure
DisplaceSupported -> Bool
False
  ReqFailure
AlterUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
AlterUnwalked -> Bool
False
  ReqFailure
AlterDistant -> Bool
True
  ReqFailure
AlterBlockActor -> Bool
True  -- adjacent actor always visible
  ReqFailure
AlterBlockItem -> Bool
True  -- adjacent item always visible
  ReqFailure
AlterNothing -> Bool
True  -- if tile known, its properties known
  ReqFailure
CloseDistant -> Bool
True
  ReqFailure
CloseClosed -> Bool
True
  ReqFailure
CloseNothing -> Bool
True
  ReqFailure
CloseNonClosable -> Bool
True
  ReqFailure
WaitUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
YellUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
MoveItemUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
EqpOverfull -> Bool
True
  ReqFailure
EqpStackFull -> Bool
True
  ReqFailure
ApplyUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
ApplyFood -> Bool
False  -- unidentified skill items
  ReqFailure
ApplyRead -> Bool
False  -- unidentified skill items
  ReqFailure
ApplyPeriodic -> Bool
False  -- unidentified skill items
  ReqFailure
ApplyOutOfReach -> Bool
True
  ReqFailure
ApplyCharging -> Bool
False  -- if aspect record unknown, charging unknown
  ReqFailure
ApplyNoEffects -> Bool
False  -- if effects unknown, can't prevent it
  ReqFailure
ItemNothing -> Bool
True
  ReqFailure
ItemNotCalm -> Bool
False  -- unidentified skill items
  ReqFailure
ItemOverStash -> Bool
True
  ReqFailure
NotCalmPrecious -> Bool
False  -- unidentified skill items
  ReqFailure
ProjectUnskilled -> Bool
False  -- unidentified skill items
  ReqFailure
ProjectAimOnself -> Bool
True
  ReqFailure
ProjectBlockTerrain -> Bool
True  -- adjacent terrain always visible
  ReqFailure
ProjectBlockActor -> Bool
True  -- adjacent actor always visible
  ReqFailure
ProjectLobable -> Bool
False  -- unidentified skill items
  ReqFailure
ProjectOutOfReach -> Bool
True
  ReqFailure
ProjectFinderKeeper -> Bool
False
  ReqFailure
NoChangeDunLeader -> Bool
True

showReqFailure :: ReqFailure -> Text
showReqFailure :: ReqFailure -> Text
showReqFailure ReqFailure
reqFailure = case ReqFailure
reqFailure of
  ReqFailure
MoveUnskilled -> Text
"too low movement stat; use equipment menu to take off stat draining gear or switch to another teammate or wait until a stat draining condition passes as seen in organ menu"
  ReqFailure
MoveUnskilledAsleep -> Text
"actor asleep; yawn to wake up"
  ReqFailure
MoveNothing -> Text
"wasting time on moving into obstacle"
  ReqFailure
MeleeUnskilled -> Text
"too low melee combat stat"
  ReqFailure
MeleeSelf -> Text
"trying to melee oneself"
  ReqFailure
MeleeDistant -> Text
"trying to melee a distant foe"
  ReqFailure
MeleeNotWeapon -> Text
"trying to melee with not a weapon"
  ReqFailure
DisplaceUnskilled -> Text
"too low actor displacing stat"
  ReqFailure
DisplaceDistant -> Text
"trying to displace a distant actor"
  ReqFailure
DisplaceAccess -> Text
"trying to switch places without access"
  ReqFailure
DisplaceMultiple -> Text
"trying to displace multiple actors"
  ReqFailure
DisplaceDying -> Text
"trying to displace a dying foe"
  ReqFailure
DisplaceBraced -> Text
"trying to displace a braced foe"
  ReqFailure
DisplaceImmobile -> Text
"trying to displace an immobile foe"
  ReqFailure
DisplaceSupported -> Text
"trying to displace a foe supported by teammates or supply stash"
  ReqFailure
AlterUnskilled -> Text
"modify stat is needed to search or activate or transform terrain"
  ReqFailure
AlterUnwalked -> Text
"too low modify stat to enter or activate or transform terrain; find and equip gear that improves the stat or try with a teammate whose skill menu shows a higher stat"
  ReqFailure
AlterDistant -> Text
"trying to modify distant terrain"
  ReqFailure
AlterBlockActor -> Text
"blocked by an actor"
  ReqFailure
AlterBlockItem -> Text
"jammed by an item"
  ReqFailure
AlterNothing -> Text
"wasting time on modifying nothing"
  ReqFailure
CloseDistant -> Text
"trying to close a distant terrain"
  ReqFailure
CloseClosed -> Text
"already closed"
  ReqFailure
CloseNothing -> Text
"no adjacent terrain can be closed"
  ReqFailure
CloseNonClosable -> Text
"cannot be closed"
  ReqFailure
WaitUnskilled -> Text
"too low wait stat"
  ReqFailure
YellUnskilled -> Text
"actors unskilled in waiting cannot yell/yawn"
  ReqFailure
MoveItemUnskilled -> Text
"too low item moving stat"
  ReqFailure
EqpOverfull -> Text
"cannot equip any more items"
  ReqFailure
EqpStackFull -> Text
"cannot equip the whole item stack"
  ReqFailure
ApplyUnskilled -> Text
"too low item triggering stat"
  ReqFailure
ApplyFood -> Text
"trigger stat 1 is enough only to eat food from the ground and trigger simple appendages"
  ReqFailure
ApplyRead -> Text
"activating cultural artifacts requires trigger stat 3"
  ReqFailure
ApplyPeriodic -> Text
"manually activating periodic items requires trigger stat 4"
  ReqFailure
ApplyOutOfReach -> Text
"cannot trigger an item out of reach"
  ReqFailure
ApplyCharging -> Text
"cannot trigger an item that is still charging"
  ReqFailure
ApplyNoEffects -> Text
"cannot trigger an item that produces no effect"
  ReqFailure
ItemNothing -> Text
"wasting time on void item manipulation"
  ReqFailure
ItemNotCalm -> Text
"you try to focus on your equipment but your calm fails you"
  ReqFailure
ItemOverStash -> Text
"you roll in your hoard a little"
  ReqFailure
NotCalmPrecious -> Text
"you are too distracted to handle such an exquisite item"
  ReqFailure
ProjectUnskilled -> Text
"too low item flinging stat"
  ReqFailure
ProjectAimOnself -> Text
"cannot aim at oneself"
  ReqFailure
ProjectBlockTerrain -> Text
"aiming obstructed by terrain"
  ReqFailure
ProjectBlockActor -> Text
"aiming blocked by an actor"
  ReqFailure
ProjectLobable -> Text
"flinging a lobable item that stops at target position requires fling stat 3"
  ReqFailure
ProjectOutOfReach -> Text
"cannot aim an item out of reach"
  ReqFailure
ProjectFinderKeeper -> Text
"flinging any projectile you've found is out of the question; you prefer to keep them pristine and safe"
  ReqFailure
NoChangeDunLeader -> Text
"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 because it's too precious to identify by use.
permittedPrecious :: Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious :: Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious Bool
forced Bool
calmE itemFull :: ItemFull
itemFull@ItemFull{ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco :: ItemDisco
itemDisco} =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      isPrecious :: Bool
isPrecious = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Precious AspectRecord
arItem
  in if Bool -> Bool
not Bool
forced Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
calmE Bool -> Bool -> Bool
&& Bool
isPrecious
     then ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
NotCalmPrecious
     else Bool -> Either ReqFailure Bool
forall a b. b -> Either a b
Right (Bool -> Either ReqFailure Bool) -> Bool -> Either ReqFailure Bool
forall a b. (a -> b) -> a -> b
$ Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
                  Bool -> Bool -> Bool
|| case ItemDisco
itemDisco of
                       ItemDiscoFull{} -> Bool
True
                       ItemDiscoMean KindMean
itemAspectMean ->
                         KindMean -> Bool
IA.kmConst KindMean
itemAspectMean Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isPrecious

-- Simplified, faster version, for inner AI loop.
permittedPreciousAI :: Bool -> ItemFull -> Bool
permittedPreciousAI :: Bool -> ItemFull -> Bool
permittedPreciousAI Bool
calmE itemFull :: ItemFull
itemFull@ItemFull{ItemDisco
itemDisco :: ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco} =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      isPrecious :: Bool
isPrecious = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Precious AspectRecord
arItem
  in (Bool
calmE Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isPrecious)
     Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Durable AspectRecord
arItem
        Bool -> Bool -> Bool
|| case ItemDisco
itemDisco of
             ItemDiscoFull{} -> Bool
True
             ItemDiscoMean KindMean
itemAspectMean ->
               KindMean -> Bool
IA.kmConst KindMean
itemAspectMean Bool -> Bool -> Bool
|| Bool -> Bool
not Bool
isPrecious

permittedProject :: Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject :: Bool -> Int -> Bool -> ItemFull -> Either ReqFailure Bool
permittedProject Bool
forced Int
skill Bool
calmE ItemFull
itemFull =
 let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
 in if | Bool -> Bool
not Bool
forced Bool -> Bool -> Bool
&& Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ProjectUnskilled
       | Bool -> Bool
not Bool
forced
         Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Lobable AspectRecord
arItem
         Bool -> Bool -> Bool
&& Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ProjectLobable
       | Bool
otherwise -> Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious Bool
forced Bool
calmE ItemFull
itemFull

-- Simplified, faster and more permissive version, for inner AI loop.
permittedProjectAI :: Int -> Bool -> ItemFull -> Bool
permittedProjectAI :: Int -> Bool -> ItemFull -> Bool
permittedProjectAI Int
skill Bool
calmE ItemFull
itemFull =
 let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
 in if | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 -> Bool
False
       | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Lobable AspectRecord
arItem
         Bool -> Bool -> Bool
&& Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 -> Bool
False
       | Bool
otherwise -> Bool -> ItemFull -> Bool
permittedPreciousAI Bool
calmE ItemFull
itemFull

permittedApply :: RK.RuleContent -> Time -> Int -> Bool -> Maybe CStore
               -> ItemFull -> ItemQuant
               -> Either ReqFailure Bool
permittedApply :: RuleContent
-> Time
-> Int
-> Bool
-> Maybe CStore
-> ItemFull
-> ItemQuant
-> Either ReqFailure Bool
permittedApply RuleContent
corule Time
localTime Int
skill Bool
calmE Maybe CStore
mstore
               itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind, Bool
itemSuspect :: ItemFull -> Bool
itemSuspect :: Bool
itemSuspect} ItemQuant
kit =
  if | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyUnskilled
     | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
2
       Bool -> Bool -> Bool
&& ItemKind -> ContentSymbol ItemKind
IK.isymbol ItemKind
itemKind ContentSymbol ItemKind -> ContentSymbol ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemSymbolsUsedInEngine -> ContentSymbol ItemKind
IK.rsymbolNecklace (RuleContent -> ItemSymbolsUsedInEngine
RK.ritemSymbols RuleContent
corule)
       Bool -> Bool -> Bool
&& (ItemKind -> ContentSymbol ItemKind
IK.isymbol ItemKind
itemKind ContentSymbol ItemKind -> ContentSymbol ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
/= ItemSymbolsUsedInEngine -> ContentSymbol ItemKind
IK.rsymbolFood (RuleContent -> ItemSymbolsUsedInEngine
RK.ritemSymbols RuleContent
corule)
           Bool -> Bool -> Bool
|| Maybe CStore
mstore Maybe CStore -> Maybe CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore -> Maybe CStore
forall a. a -> Maybe a
Just CStore
CGround) -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyFood
     | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3
       Bool -> Bool -> Bool
&& ItemKind -> ContentSymbol ItemKind
IK.isymbol ItemKind
itemKind ContentSymbol ItemKind -> ContentSymbol ItemKind -> Bool
forall a. Eq a => a -> a -> Bool
== ItemSymbolsUsedInEngine -> ContentSymbol ItemKind
IK.rsymbolScroll (RuleContent -> ItemSymbolsUsedInEngine
RK.ritemSymbols RuleContent
corule) ->
         ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyRead
     | Int
skill Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4
       Bool -> Bool -> Bool
&& let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
          in Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyPeriodic
     -- If the item is discharged, neither the kinetic hit nor
     -- any effects activate, so there's no point triggering.
     -- Note that if client doesn't know the timeout, here we may 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
     -- (likely in case of jewellery). So it's OK (the message may be
     -- somewhat alarming though).
     | Bool -> Bool
not (Bool -> Bool) -> Bool -> Bool
forall a b. (a -> b) -> a -> b
$ Time -> ItemQuant -> Bool
hasCharge Time
localTime ItemQuant
kit -> ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyCharging
     | Bool
otherwise ->
       if [Effect] -> Bool
forall a. [a] -> Bool
null (ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind)
          Bool -> Bool -> Bool
&& (Bool -> Bool
not Bool
itemSuspect Bool -> Bool -> Bool
|| ItemKind -> Bool
IA.isHumanTrinket ItemKind
itemKind)
       then ReqFailure -> Either ReqFailure Bool
forall a b. a -> Either a b
Left ReqFailure
ApplyNoEffects
       else Bool -> Bool -> ItemFull -> Either ReqFailure Bool
permittedPrecious Bool
False Bool
calmE ItemFull
itemFull