{-# LANGUAGE DeriveGeneric #-} -- | The type of kinds of weapons, treasure, organs, blasts, etc. module Game.LambdaHack.Content.ItemKind ( pattern CONDITION, pattern COMMON_ITEM, pattern S_BONUS_HP, pattern S_BRACED, pattern S_ASLEEP, pattern S_IMPRESSED, pattern S_CURRENCY, pattern MOBILE , pattern CRAWL_ITEM, pattern TREASURE, pattern ANY_SCROLL, pattern ANY_GLASS, pattern ANY_POTION, pattern ANY_FLASK, pattern EXPLOSIVE, pattern ANY_JEWELRY, pattern S_SINGLE_SPARK, pattern S_SPARK, pattern S_FRAGRANCE , pattern HORROR, pattern VALUABLE, pattern UNREPORTED_INVENTORY, pattern AQUATIC , ItemKind(..), makeData , Aspect(..), Effect(..), Condition(..), DetectKind(..) , TimerDice, ThrowMod(..) , ItemSymbolsUsedInEngine(..), emptyItemSymbolsUsedInEngine , boostItemKindList, forApplyEffect, forDamageEffect, isDamagingKind , strengthOnCombine, strengthOnSmash, getDropOrgans , getMandatoryPresentAsFromKind, isEffEscape, isEffEscapeOrAscend , timeoutAspect, orEffect, onSmashEffect, onCombineEffect, alwaysDudEffect , damageUsefulness, verbMsgNoLonger, verbMsgLess, toVelocity, toLinger , timerNone, isTimerNone, foldTimer, toOrganBad, toOrganGood, toOrganNoTimer , validateSingle , mandatoryGroups, mandatoryGroupsSingleton #ifdef EXPOSE_INTERNAL -- * Internal operations , boostItemKind, onSmashOrCombineEffect , validateAll, validateDups, validateDamage #endif ) where import Prelude () import Game.LambdaHack.Core.Prelude import Data.Binary import Data.Hashable (Hashable) import qualified Data.Text as T import GHC.Generics (Generic) import qualified System.Random.SplitMix32 as SM import qualified Game.LambdaHack.Core.Dice as Dice import Game.LambdaHack.Core.Random (nextRandom) import qualified Game.LambdaHack.Definition.Ability as Ability import Game.LambdaHack.Definition.ContentData import Game.LambdaHack.Definition.Defs import Game.LambdaHack.Definition.DefsInternal import Game.LambdaHack.Definition.Flavour -- * Mandatory item groups mandatoryGroupsSingleton :: [GroupName ItemKind] mandatoryGroupsSingleton = [S_BONUS_HP, S_BRACED, S_ASLEEP, S_IMPRESSED, S_CURRENCY] pattern S_BONUS_HP, S_BRACED, S_ASLEEP, S_IMPRESSED, S_CURRENCY :: GroupName ItemKind mandatoryGroups :: [GroupName ItemKind] mandatoryGroups = [CONDITION, COMMON_ITEM, MOBILE] pattern CONDITION, COMMON_ITEM, MOBILE :: GroupName ItemKind -- From Preferences.hs pattern CONDITION = GroupName "condition" pattern COMMON_ITEM = GroupName "common item" -- Assorted pattern S_BONUS_HP = GroupName "bonus HP" pattern S_BRACED = GroupName "braced" pattern S_ASLEEP = GroupName "asleep" pattern S_IMPRESSED = GroupName "impressed" pattern S_CURRENCY = GroupName "currency" pattern MOBILE = GroupName "mobile" -- * Optional item groups pattern S_SINGLE_SPARK, S_SPARK, S_FRAGRANCE, CRAWL_ITEM, TREASURE, ANY_SCROLL, ANY_GLASS, ANY_POTION, ANY_FLASK, EXPLOSIVE, ANY_JEWELRY, VALUABLE, UNREPORTED_INVENTORY, AQUATIC, HORROR :: GroupName ItemKind -- Used in Preferences.hs pattern S_SINGLE_SPARK = GroupName "single spark" pattern S_SPARK = GroupName "spark" pattern S_FRAGRANCE = GroupName "fragrance" pattern CRAWL_ITEM = GroupName "curious item" -- to be used only in long scenarios, such as multi-level dungeon crawl; -- may be a powerful or a mundate item, unlike @TREASURE@ item pattern TREASURE = GroupName "treasure" -- particularly powerful items, but may appear in any scenario pattern ANY_SCROLL = GroupName "scroll" pattern ANY_GLASS = GroupName "glass" pattern ANY_POTION = GroupName "potion" pattern ANY_FLASK = GroupName "flask" pattern EXPLOSIVE = GroupName "explosive" pattern ANY_JEWELRY = GroupName "jewelry" -- * Used elsewhere pattern VALUABLE = GroupName "valuable" pattern UNREPORTED_INVENTORY = GroupName "unreported inventory" pattern AQUATIC = GroupName "aquatic" pattern HORROR = GroupName "horror" -- | Item properties that are fixed for a given kind of items. -- Of these, aspects and effects are jointly called item powers. -- Note that this type is mutually recursive with 'Effect' and `Aspect`. data ItemKind = ItemKind { isymbol :: ContentSymbol ItemKind -- ^ map symbol , iname :: Text -- ^ generic name; is pluralized if needed , ifreq :: Freqs ItemKind -- ^ frequency within groups , iflavour :: [Flavour] -- ^ possible flavours , icount :: Dice.Dice -- ^ created in that quantity , irarity :: Rarity -- ^ rarity on given depths , iverbHit :: Text -- ^ the verb for hitting , iweight :: Int -- ^ weight in grams , idamage :: Dice.Dice -- ^ basic kinetic damage , iaspects :: [Aspect] -- ^ affect the actor continuously , ieffects :: [Effect] -- ^ cause the effects when triggered , ikit :: [(GroupName ItemKind, CStore)] -- ^ accompanying organs and equipment , idesc :: Text -- ^ description } deriving Show -- No Eq and Ord to make extending logically sound -- | Aspects of items. Aspect @AddSkill@ is additive (starting at 0) -- for all items wielded by an actor and it affects the actor. -- The others affect only the item in question, not the actor carrying it, -- and so are not additive in any sense. data Aspect = Timeout Dice.Dice -- ^ specifies the cooldown before an item may be -- applied again; if a copy of an item is applied -- manually (not via periodic activation), -- all effects on a single copy of the item are -- disabled until the copy recharges for the given -- time expressed in game turns; all copies -- recharge concurrently | AddSkill Ability.Skill Dice.Dice -- ^ bonus to a skill; in content, avoid boosting -- skills such as SkApply via permanent equipment, -- to avoid micromanagement through swapping items -- among party members before each skill use | SetFlag Ability.Flag -- ^ item feature | ELabel Text -- ^ extra label of the item; it's not pluralized | ToThrow ThrowMod -- ^ parameters modifying a throw | PresentAs (GroupName ItemKind) -- ^ until identified, presents as this unique kind | EqpSlot Ability.EqpSlot -- ^ AI and UI flag that leaks item intended use | Odds Dice.Dice [Aspect] [Aspect] -- ^ if level-scaled dice roll > 50, -- pick the former aspects, otherwise the latter deriving (Show, Eq) -- | Effects of items. Can be invoked by the item wielder to affect -- another actor or the wielder himself. -- -- Various effects of an item kind are all groupped in one list, -- at the cost of conditionals, sequences, etc., to ensure brevity -- and simplicity of content definitions. Most effects fire regardless -- of activation kind (the only exceptions are @OnSmash@ and @OnCombine@ -- effects) so the deviations, handled via the conditionals, are rare -- and the definitions remain simple. Whether an item can be activated -- in any particular way, OTOH, is specified via simple flags elsewhere, -- again, by default, assuming that most activations are possible for all. data Effect = Burn Dice.Dice -- ^ burn with this damage | Explode (GroupName ItemKind) -- ^ explode producing this group of blasts | RefillHP Int -- ^ modify HP of the actor by this amount | RefillCalm Int -- ^ modify Calm of the actor by this amount | Dominate -- ^ change actor's allegiance | Impress -- ^ make actor susceptible to domination | PutToSleep -- ^ put actor to sleep, also calming him | Yell -- ^ make the actor yell/yawn, waking him and others up | Summon (GroupName ItemKind) Dice.Dice -- ^ summon the given number of actors of this group | Ascend Bool -- ^ ascend to another level of the dungeon | Escape -- ^ escape from the dungeon | Paralyze Dice.Dice -- ^ paralyze for this many game clips | ParalyzeInWater Dice.Dice -- ^ paralyze for this many game clips due to water | InsertMove Dice.Dice -- ^ give actor this many extra tenths of actor move | Teleport Dice.Dice -- ^ teleport actor across rougly this distance | CreateItem (Maybe Int) CStore (GroupName ItemKind) TimerDice -- ^ create an item of the group and insert into the store with the given -- random timer; it cardinality not specified, roll it | DestroyItem Int Int CStore (GroupName ItemKind) -- ^ destroy some items of the group from the store; see below about Ints | ConsumeItems [(Int, GroupName ItemKind)] [(Int, GroupName ItemKind)] -- ^ @ConsumeItems toUse toDestroy@ uses items matching @toUse@ -- (destroys non-durable, without invoking OnSmash effects; -- applies normal effects of durable, without destroying them; -- the same behaviour as when transforming terrain using items) -- and destroys items matching @toDestroy@, invoking no effects, -- regardless of durability; -- the items are taken from @CGround@ (but not from @CEqp@), -- preferring non-durable (since durable can harm when used -- and may be more vauable when destroyed); if not all required items -- are present, no item are destroyed; if an item belongs to many groups -- in the sum of @toUse@ and @toDestroy@, it counts for all -- (otherwise, some orders of destroying would succeed, -- while others would not); even if item durable, as many copies -- are needed as specified, not just one applied many times; -- items are first destroyed and then, if any copies left, applied | DropItem Int Int CStore (GroupName ItemKind) -- ^ make the actor drop items of the given group from the given store; -- the first integer says how many item kinds to drop, the second, -- how many copies of each kind to drop; -- for non-organs, beware of not dropping all kinds, or cluttering -- store with rubbish becomes beneficial | Recharge Int Dice.Dice -- ^ reduce the cooldown period of this number of discharged items -- in the victim's equipment and organs by this dice of game clips; -- if the result is negative, set to 0, instantly recharging the item; -- starts with weapons with highest raw damage in equipment, -- then among organs, then non-weapons in equipment and among organs; -- beware of exploiting for healing periodic items | Discharge Int Dice.Dice -- ^ increase the cooldown period of this number of fully recharged items -- in the victim's equipment and organs by this dice of game clips; -- starts with weapons with highest raw damage in equipment, -- then among organs, then non-weapons in equipment and among organs; -- beware of exploiting for hunger inducing and similar organs | PolyItem -- ^ get a suitable (i.e., numerous enough) non-unique common item stack -- on the floor and polymorph it to a stack of random common items, -- with current depth coefficient | RerollItem -- ^ get a suitable (i.e., with any random aspects) single item -- (even unique) on the floor and change the random bonuses -- of the items randomly, with maximal depth coefficient | DupItem -- ^ exactly duplicate a single non-unique, non-valuable item on the floor | Identify -- ^ find a suitable (i.e., not identified) item, starting from -- the floor, and identify it | Detect DetectKind Int -- ^ detect something on the map in the given radius | SendFlying ThrowMod -- ^ send an actor flying (push or pull, depending) | PushActor ThrowMod -- ^ push an actor | PullActor ThrowMod -- ^ pull an actor | ApplyPerfume -- ^ remove all smell on the level | AtMostOneOf [Effect] -- ^ try to trigger a single random effect of the list | OneOf [Effect] -- ^ trigger, with equal probability, -- one of the effects that don't end with @UseDud@ | OnSmash Effect -- ^ trigger the effect when item smashed (not when applied nor meleed) | OnCombine Effect -- ^ trigger the effect only when the actor explicitly desires -- to combine items or otherwise subtly tinker with an -- item or a tile, e.g., craft items from other items in a workshop; -- in particular, don't trigger the effects when entering a tile; -- trigger exclusively the effects when activating walkable terrain | OnUser Effect -- ^ apply the effect to the user, not the victim | NopEffect -- ^ nothing happens, @UseDud@, no description | AndEffect Effect Effect -- ^ only fire second effect if first activated | OrEffect Effect Effect -- ^ only fire second effect if first not activated | SeqEffect [Effect] -- ^ fire all effects in order; always suceed | When Condition Effect -- ^ if condition not met, fail without a message; -- better avoided, since AI can't value it well | Unless Condition Effect -- ^ if condition met, fail without a message; -- better avoided, since AI can't value it well | IfThenElse Condition Effect Effect -- ^ conditional effect; -- better avoided, since AI can't value it well | VerbNoLonger Text Text -- ^ a sentence with the actor causing the effect as subject, the given -- texts as the verb and the ending of the sentence (that may be -- ignored when the message is cited, e.g., as heard by someone) -- that is emitted when an activation causes an item to expire; -- no spam is emitted if a projectile; the ending is appended -- without a space in-between | VerbMsg Text Text -- ^ as @VerbNoLonger@ but that is emitted whenever the item is activated; | VerbMsgFail Text Text -- ^ as @VerbMsg@, but a failed effect (returns @UseId@) deriving (Show, Eq) data Condition = HpLeq Int | HpGeq Int | CalmLeq Int | CalmGeq Int | TriggeredBy Ability.ActivationFlag deriving (Show, Eq) data DetectKind = DetectAll | DetectActor | DetectLoot | DetectExit | DetectHidden | DetectEmbed | DetectStash deriving (Show, Eq) -- | Specification of how to randomly roll a timer at item creation -- to obtain a fixed timer for the item's lifetime. data TimerDice = TimerNone | TimerGameTurn Dice.Dice | TimerActorTurn Dice.Dice deriving Eq instance Show TimerDice where show TimerNone = "0" show (TimerGameTurn nDm) = show nDm ++ " " ++ if nDm == 1 then "turn" else "turns" show (TimerActorTurn nDm) = show nDm ++ " " ++ if nDm == 1 then "move" else "moves" -- | Parameters modifying a throw of a projectile or flight of pushed actor. -- Not additive and don't start at 0. data ThrowMod = ThrowMod { throwVelocity :: Int -- ^ fly with this percentage of base throw speed , throwLinger :: Int -- ^ fly for this percentage of 2 turns , throwHP :: Int -- ^ start flight with this many HP } deriving (Show, Eq, Ord, Generic) instance Binary ThrowMod instance Hashable ThrowMod data ItemSymbolsUsedInEngine = ItemSymbolsUsedInEngine { rsymbolProjectile :: ContentSymbol ItemKind , rsymbolLight :: ContentSymbol ItemKind , rsymbolTool :: ContentSymbol ItemKind , rsymbolSpecial :: ContentSymbol ItemKind , rsymbolGold :: ContentSymbol ItemKind , rsymbolNecklace :: ContentSymbol ItemKind , rsymbolRing :: ContentSymbol ItemKind , rsymbolPotion :: ContentSymbol ItemKind , rsymbolFlask :: ContentSymbol ItemKind , rsymbolScroll :: ContentSymbol ItemKind , rsymbolTorsoArmor :: ContentSymbol ItemKind , rsymbolMiscArmor :: ContentSymbol ItemKind , rsymbolClothes :: ContentSymbol ItemKind , rsymbolShield :: ContentSymbol ItemKind , rsymbolPolearm :: ContentSymbol ItemKind , rsymbolEdged :: ContentSymbol ItemKind , rsymbolHafted :: ContentSymbol ItemKind , rsymbolWand :: ContentSymbol ItemKind , rsymbolFood :: ContentSymbol ItemKind } emptyItemSymbolsUsedInEngine :: ItemSymbolsUsedInEngine emptyItemSymbolsUsedInEngine = ItemSymbolsUsedInEngine { rsymbolProjectile = toContentSymbol '0' , rsymbolLight = toContentSymbol '0' , rsymbolTool = toContentSymbol '0' , rsymbolSpecial = toContentSymbol '0' , rsymbolGold = toContentSymbol '0' , rsymbolNecklace = toContentSymbol '0' , rsymbolRing = toContentSymbol '0' , rsymbolPotion = toContentSymbol '0' , rsymbolFlask = toContentSymbol '0' , rsymbolScroll = toContentSymbol '0' , rsymbolTorsoArmor = toContentSymbol '0' , rsymbolMiscArmor = toContentSymbol '0' , rsymbolClothes = toContentSymbol '0' , rsymbolShield = toContentSymbol '0' , rsymbolPolearm = toContentSymbol '0' , rsymbolEdged = toContentSymbol '0' , rsymbolHafted = toContentSymbol '0' , rsymbolWand = toContentSymbol '0' , rsymbolFood = toContentSymbol '0' } boostItemKindList :: SM.SMGen -> [ItemKind] -> [ItemKind] boostItemKindList _ [] = [] boostItemKindList initialGen l = let (r, _) = nextRandom (length l - 1) initialGen in case splitAt r l of (pre, i : post) -> pre ++ boostItemKind i : post _ -> error $ "" `showFailure` l boostItemKind :: ItemKind -> ItemKind boostItemKind i = let mainlineLabel (label, _) = label `elem` [COMMON_ITEM, CRAWL_ITEM, TREASURE] in if any mainlineLabel (ifreq i) then i { ifreq = (COMMON_ITEM, 10000) : filter (not . mainlineLabel) (ifreq i) , iaspects = delete (SetFlag Ability.Unique) $ iaspects i } else i -- | Whether the effect has a chance of exhibiting any potentially -- noticeable behaviour, except when the item is destroyed or combined. -- We assume at least one of @OneOf@ effects must be noticeable. forApplyEffect :: Effect -> Bool forApplyEffect eff = case eff of OnSmash{} -> False OnCombine{} -> False OnUser eff1 -> forApplyEffect eff1 NopEffect -> False AndEffect eff1 eff2 -> forApplyEffect eff1 || forApplyEffect eff2 OrEffect eff1 eff2 -> forApplyEffect eff1 || forApplyEffect eff2 SeqEffect effs -> any forApplyEffect effs When _ eff1 -> forApplyEffect eff1 Unless _ eff1 -> forApplyEffect eff1 IfThenElse _ eff1 eff2 -> forApplyEffect eff1 || forApplyEffect eff2 VerbNoLonger{} -> False VerbMsg{} -> False VerbMsgFail{} -> False ParalyzeInWater{} -> False -- barely noticeable, spams when resisted _ -> True -- | Whether a non-nested effect always applies raw damage. forDamageEffect :: Effect -> Bool forDamageEffect eff = case eff of Burn{} -> True RefillHP n | n < 0 -> True _ -> False -- | Whether an item is damaging. Such items may trigger embedded items -- and may collide with bursting items mid-air. isDamagingKind :: ItemKind -> Bool isDamagingKind itemKind = Dice.infDice (idamage itemKind) > 0 || any forDamageEffect (ieffects itemKind) isEffEscape :: Effect -> Bool isEffEscape Escape{} = True isEffEscape (AtMostOneOf l) = any isEffEscape l isEffEscape (OneOf l) = any isEffEscape l isEffEscape (OnCombine eff) = isEffEscape eff isEffEscape (OnUser eff) = isEffEscape eff isEffEscape (AndEffect eff1 eff2) = isEffEscape eff1 || isEffEscape eff2 isEffEscape (OrEffect eff1 eff2) = isEffEscape eff1 || isEffEscape eff2 isEffEscape (SeqEffect effs) = any isEffEscape effs isEffEscape (When _ eff) = isEffEscape eff isEffEscape (Unless _ eff) = isEffEscape eff isEffEscape (IfThenElse _ eff1 eff2) = isEffEscape eff1 || isEffEscape eff2 isEffEscape _ = False isEffEscapeOrAscend :: Effect -> Bool isEffEscapeOrAscend Ascend{} = True isEffEscapeOrAscend Escape{} = True isEffEscapeOrAscend (AtMostOneOf l) = any isEffEscapeOrAscend l isEffEscapeOrAscend (OneOf l) = any isEffEscapeOrAscend l isEffEscapeOrAscend (OnCombine eff) = isEffEscapeOrAscend eff isEffEscapeOrAscend (OnUser eff) = isEffEscapeOrAscend eff isEffEscapeOrAscend (AndEffect eff1 eff2) = isEffEscapeOrAscend eff1 || isEffEscapeOrAscend eff2 isEffEscapeOrAscend (OrEffect eff1 eff2) = isEffEscapeOrAscend eff1 || isEffEscapeOrAscend eff2 isEffEscapeOrAscend (SeqEffect effs) = any isEffEscapeOrAscend effs isEffEscapeOrAscend (When _ eff) = isEffEscapeOrAscend eff isEffEscapeOrAscend (Unless _ eff) = isEffEscapeOrAscend eff isEffEscapeOrAscend (IfThenElse _ eff1 eff2) = isEffEscapeOrAscend eff1 || isEffEscapeOrAscend eff2 isEffEscapeOrAscend _ = False timeoutAspect :: Aspect -> Bool timeoutAspect Timeout{} = True timeoutAspect _ = False orEffect :: Effect -> Bool orEffect OrEffect{} = True orEffect _ = False onSmashEffect :: Effect -> Bool onSmashEffect OnSmash{} = True onSmashEffect _ = False onCombineEffect :: Effect -> Bool onCombineEffect OnCombine{} = True onCombineEffect _ = False onSmashOrCombineEffect :: Effect -> Bool onSmashOrCombineEffect OnSmash{} = True onSmashOrCombineEffect OnCombine{} = True onSmashOrCombineEffect _ = False alwaysDudEffect :: Effect -> Bool alwaysDudEffect OnSmash{} = True alwaysDudEffect OnCombine{} = True alwaysDudEffect NopEffect = True alwaysDudEffect _ = False strengthOnSmash :: ItemKind -> [Effect] strengthOnSmash = let f (OnSmash eff) = [eff] f _ = [] in concatMap f . ieffects strengthOnCombine :: ItemKind -> [Effect] strengthOnCombine = let f (OnCombine eff) = [eff] f _ = [] in concatMap f . ieffects getDropOrgans :: ItemKind -> [GroupName ItemKind] getDropOrgans = let f (DestroyItem _ _ COrgan grp) = [grp] f (DropItem _ _ COrgan grp) = [grp] f Impress = [S_IMPRESSED] f (AtMostOneOf l) = concatMap f l -- even remote possibility accepted f (OneOf l) = concatMap f l -- even remote possibility accepted f (OnUser eff) = f eff -- no OnCombine, because checked for potions, etc. f (AndEffect eff1 eff2) = f eff1 ++ f eff2 -- not certain, but accepted f (OrEffect eff1 eff2) = f eff1 ++ f eff2 -- not certain, but accepted f (SeqEffect effs) = concatMap f effs f (When _ eff) = f eff f (Unless _ eff) = f eff f (IfThenElse _ eff1 eff2) = f eff1 ++ f eff2 f _ = [] in concatMap f . ieffects -- Anything under @Odds@ is ignored, because it's not mandatory. getMandatoryPresentAsFromKind :: ItemKind -> Maybe (GroupName ItemKind) getMandatoryPresentAsFromKind itemKind = let f (PresentAs grp) = [grp] f _ = [] in listToMaybe $ concatMap f (iaspects itemKind) damageUsefulness :: ItemKind -> Double damageUsefulness itemKind = let v = min 1000 (10 * Dice.meanDice (idamage itemKind)) in assert (v >= 0) v verbMsgNoLonger :: Text -> Effect verbMsgNoLonger name = VerbNoLonger ("be no longer" <+> name) "." verbMsgLess :: Text -> Effect verbMsgLess name = VerbMsg ("appear less" <+> name) "." toVelocity :: Int -> Aspect toVelocity n = ToThrow $ ThrowMod n 100 1 toLinger :: Int -> Aspect toLinger n = ToThrow $ ThrowMod 100 n 1 timerNone :: TimerDice timerNone = TimerNone isTimerNone :: TimerDice -> Bool isTimerNone tim = tim == TimerNone foldTimer :: a -> (Dice.Dice -> a) -> (Dice.Dice -> a) -> TimerDice -> a foldTimer a fgame factor tim = case tim of TimerNone -> a TimerGameTurn nDm -> fgame nDm TimerActorTurn nDm -> factor nDm toOrganBad :: GroupName ItemKind -> Dice.Dice -> Effect toOrganBad grp nDm = CreateItem Nothing COrgan grp (TimerGameTurn nDm) toOrganGood :: GroupName ItemKind -> Dice.Dice -> Effect toOrganGood grp nDm = CreateItem Nothing COrgan grp (TimerActorTurn nDm) toOrganNoTimer :: GroupName ItemKind -> Effect toOrganNoTimer grp = CreateItem Nothing COrgan grp TimerNone -- | Catch invalid item kind definitions. validateSingle :: ItemSymbolsUsedInEngine -> ItemKind -> [Text] validateSingle itemSymbols ik@ItemKind{..} = ["iname longer than 23" | T.length iname > 23] ++ ["icount < 0" | Dice.infDice icount < 0] ++ validateRarity irarity ++ validateDamage idamage -- Reject duplicate Timeout, because it's not additive. ++ (let ts = filter timeoutAspect iaspects in ["more than one Timeout specification" | length ts > 1]) ++ [ "Conflicting Fragile and Durable" | SetFlag Ability.Fragile `elem` iaspects && SetFlag Ability.Durable `elem` iaspects ] ++ (let f :: Aspect -> Bool f EqpSlot{} = True f _ = False ts = filter f iaspects equipable = SetFlag Ability.Equipable `elem` iaspects meleeable = SetFlag Ability.Meleeable `elem` iaspects likelyTemplate = case ifreq of [(grp, 1)] -> "unknown" `T.isSuffixOf` fromGroupName grp _ -> False likelyException = isymbol `elem` [ rsymbolFood itemSymbols , rsymbolNecklace itemSymbols , rsymbolWand itemSymbols ] || likelyTemplate in [ "EqpSlot specified but not Equipable nor Meleeable" | length ts == 1 && not equipable && not meleeable ] ++ [ "EqpSlot not specified but Equipable or Meleeable and not a likely organ or necklace or template" | not likelyException && null ts && (equipable || meleeable) ] ++ [ "More than one EqpSlot specified" | length ts > 1 ] ) ++ [ "Redundant Equipable or Meleeable" | SetFlag Ability.Equipable `elem` iaspects && SetFlag Ability.Meleeable `elem` iaspects ] ++ [ "Conflicting Durable and Blast" | SetFlag Ability.Durable `elem` iaspects && SetFlag Ability.Blast `elem` iaspects ] ++ [ "Conflicting Durable and Condition" | SetFlag Ability.Durable `elem` iaspects && SetFlag Ability.Condition `elem` iaspects ] ++ [ "Conflicting Blast and Condition" | SetFlag Ability.Blast `elem` iaspects && SetFlag Ability.Condition `elem` iaspects ] ++ (let f :: Aspect -> Bool f ELabel{} = True f _ = False ts = filter f iaspects in ["more than one ELabel specification" | length ts > 1]) ++ (let f :: Aspect -> Bool f ToThrow{} = True f _ = False ts = filter f iaspects in ["more than one ToThrow specification" | length ts > 1]) ++ (let f :: Aspect -> Bool f PresentAs{} = True f _ = False ts = filter f iaspects in ["more than one PresentAs specification" | length ts > 1]) ++ concatMap (validateDups ik . SetFlag) [minBound .. maxBound] ++ (let f :: Effect -> Bool f VerbNoLonger{} = True f _ = False in validateOnlyOne ieffects "VerbNoLonger" f) -- may be duped if nested ++ (let f :: Effect -> Bool f VerbMsg{} = True f _ = False in validateOnlyOne ieffects "VerbMsg" f) -- may be duplicated if nested ++ (let f :: Effect -> Bool f VerbMsgFail{} = True f _ = False in validateOnlyOne ieffects "VerbMsgFail" f) -- may be duped if nested ++ validateNotNested ieffects "OnSmash or OnCombine" onSmashOrCombineEffect -- but duplicates permitted ++ let nonPositiveBurn :: Effect -> Bool nonPositiveBurn (Burn d) = Dice.infDice d <= 0 nonPositiveBurn _ = False containingNonPositiveBurn = filter (checkSubEffectProp nonPositiveBurn) ieffects in [ "effects with non-positive Burn:" <+> tshow containingNonPositiveBurn | not $ null containingNonPositiveBurn ] ++ let emptyOneOf :: Effect -> Bool emptyOneOf (AtMostOneOf []) = True emptyOneOf (OneOf []) = True emptyOneOf _ = False containingEmptyOneOf = filter (checkSubEffectProp emptyOneOf) ieffects in [ "effects with empty AtMostOneOf or OneOf:" <+> tshow containingEmptyOneOf | not $ null containingEmptyOneOf ] ++ (let nonPositiveEffect :: Effect -> Bool nonPositiveEffect (CreateItem (Just n) _ _ _) | n <= 0 = True nonPositiveEffect (DestroyItem n k _ _) | n <= 0 || k <= 0 = True nonPositiveEffect (ConsumeItems tools raw) | any ((<= 0) . fst) (tools ++ raw) = True nonPositiveEffect (DropItem n k _ _) | n <= 0 || k <= 0 = True nonPositiveEffect (Detect _ n) | n <= 0 = True nonPositiveEffect _ = False containingNonPositiveEffect = filter (checkSubEffectProp nonPositiveEffect) ieffects in [ "effects with forbidden non-positive parameters:" <+> tshow containingNonPositiveEffect | not $ null containingNonPositiveEffect ]) ++ (let nonPositiveEffect :: Effect -> Bool nonPositiveEffect (Summon _ d) | Dice.infDice d <= 0 = True nonPositiveEffect (Paralyze d) | Dice.infDice d <= 0 = True nonPositiveEffect (ParalyzeInWater d) | Dice.infDice d <= 0 = True nonPositiveEffect (InsertMove d) | Dice.infDice d <= 0 = True nonPositiveEffect (Teleport d) | Dice.infDice d <= 0 = True nonPositiveEffect (CreateItem _ _ _ (TimerGameTurn d)) | Dice.infDice d <= 0 = True nonPositiveEffect (CreateItem _ _ _ (TimerActorTurn d)) | Dice.infDice d <= 0 = True nonPositiveEffect (Recharge n d) | n <= 0 || Dice.infDice d <= 0 = True nonPositiveEffect (Discharge n d) | n <= 0 || Dice.infDice d <= 0 = True nonPositiveEffect _ = False containingNonPositiveEffect = filter (checkSubEffectProp nonPositiveEffect) ieffects in [ "effects with forbidden potentially non-positive or negative number or dice:" <+> tshow containingNonPositiveEffect | not $ null containingNonPositiveEffect ]) -- We only check there are no duplicates at top level. If it may be nested, -- it may presumably be duplicated inside the nesting as well. validateOnlyOne :: [Effect] -> Text -> (Effect -> Bool) -> [Text] validateOnlyOne effs t f = let ts = filter f effs in ["more than one" <+> t <+> "specification" | length ts > 1] -- We check it's not nested one nor more levels. validateNotNested :: [Effect] -> Text -> (Effect -> Bool) -> [Text] validateNotNested effs t f = let g (AtMostOneOf l) = any h l g (OneOf l) = any h l g (OnSmash effect) = h effect g (OnCombine effect) = h effect g (OnUser effect) = h effect g (AndEffect eff1 eff2) = h eff1 || h eff2 g (OrEffect eff1 eff2) = h eff1 || h eff2 g (SeqEffect effs2) = any h effs2 g (When _ effect) = h effect g (Unless _ effect) = h effect g (IfThenElse _ eff1 eff2) = h eff1 || h eff2 g _ = False h effect = f effect || g effect ts = filter g effs in [ "effect" <+> t <+> "should be specified at top level, not nested" | not (null ts) ] checkSubEffectProp :: (Effect -> Bool) -> Effect -> Bool checkSubEffectProp f eff = let g (AtMostOneOf l) = any h l g (OneOf l) = any h l g (OnSmash effect) = h effect g (OnCombine effect) = h effect g (OnUser effect) = h effect g (AndEffect eff1 eff2) = h eff1 || h eff2 g (OrEffect eff1 eff2) = h eff1 || h eff2 g (SeqEffect effs) = any h effs g (When _ effect) = h effect g (Unless _ effect) = h effect g (IfThenElse _ eff1 eff2) = h eff1 || h eff2 g _ = False h effect = f effect || g effect in h eff validateDups :: ItemKind -> Aspect -> [Text] validateDups ItemKind{..} feat = let ts = filter (== feat) iaspects in ["more than one" <+> tshow feat <+> "specification" | length ts > 1] validateDamage :: Dice.Dice -> [Text] validateDamage dice = [ "potentially negative dice:" <+> tshow dice | Dice.infDice dice < 0] -- | Validate all item kinds. validateAll :: [ItemKind] -> ContentData ItemKind -> [Text] validateAll content coitem = let f :: Aspect -> Bool f PresentAs{} = True f _ = False wrongPresentAsGroups = [ cgroup | k <- content , let (cgroup, notSingleton) = case find f (iaspects k) of Just (PresentAs grp) | not $ oisSingletonGroup coitem grp -> (grp, True) _ -> (undefined, False) , notSingleton ] in [ "PresentAs groups not singletons:" <+> tshow wrongPresentAsGroups | not $ null wrongPresentAsGroups ] makeData :: ItemSymbolsUsedInEngine -> [ItemKind] -> [GroupName ItemKind] -> [GroupName ItemKind] -> ContentData ItemKind makeData itemSymbols content groupNamesSingleton groupNames = let allGroupNamesTooLong = filter ((> 23) . T.length . fromGroupName) $ groupNamesSingleton ++ groupNames in assert (null allGroupNamesTooLong `blame` "ItemKind: some item group names too long" `swith` allGroupNamesTooLong) $ makeContentData "ItemKind" iname ifreq (validateSingle itemSymbols) validateAll content (mandatoryGroupsSingleton ++ groupNamesSingleton) (mandatoryGroups ++ groupNames)