{-# 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
DisplaceSupported -> False
AlterUnskilled -> False
AlterUnwalked -> False
AlterDistant -> True
AlterBlockActor -> True
AlterBlockItem -> True
AlterNothing -> True
EqpOverfull -> True
EqpStackFull -> True
ApplyUnskilled -> False
ApplyRead -> False
ApplyOutOfReach -> True
ApplyCharging -> False
ApplyNoEffects -> False
ItemNothing -> True
ItemNotCalm -> False
NotCalmPrecious -> False
ProjectUnskilled -> False
ProjectAimOnself -> True
ProjectBlockTerrain -> True
ProjectBlockActor -> True
ProjectLobable -> False
ProjectOutOfReach -> True
TriggerNothing -> True
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"
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
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
| 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