{-# LANGUAGE DeriveGeneric #-}
-- | Description of effects.
module Game.LambdaHack.Client.UI.EffectDescription
  ( DetailLevel(..), defaultDetailLevel
  , effectToSuffix, detectToObject, detectToVerb
  , skillName, skillDesc, skillToDecorator, skillSlots
  , kindAspectToSuffix, aspectToSentence, affixDice
  , describeToolsAlternative, describeCrafting, wrapInParens
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , conditionToObject, activationFlagToObject, slotToSentence, tmodToSuff
  , affixBonus, wrapInChevrons
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Binary
import qualified Data.Text as T
import           GHC.Generics (Generic)
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Common.Actor
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Content.ItemKind
import qualified Game.LambdaHack.Core.Dice as Dice
import           Game.LambdaHack.Definition.Ability
import           Game.LambdaHack.Definition.Defs

data DetailLevel = DetailLow | DetailMedium | DetailHigh | DetailAll
  deriving (Int -> DetailLevel -> ShowS
[DetailLevel] -> ShowS
DetailLevel -> String
(Int -> DetailLevel -> ShowS)
-> (DetailLevel -> String)
-> ([DetailLevel] -> ShowS)
-> Show DetailLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DetailLevel] -> ShowS
$cshowList :: [DetailLevel] -> ShowS
show :: DetailLevel -> String
$cshow :: DetailLevel -> String
showsPrec :: Int -> DetailLevel -> ShowS
$cshowsPrec :: Int -> DetailLevel -> ShowS
Show, DetailLevel -> DetailLevel -> Bool
(DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool) -> Eq DetailLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DetailLevel -> DetailLevel -> Bool
$c/= :: DetailLevel -> DetailLevel -> Bool
== :: DetailLevel -> DetailLevel -> Bool
$c== :: DetailLevel -> DetailLevel -> Bool
Eq, Eq DetailLevel
Eq DetailLevel =>
(DetailLevel -> DetailLevel -> Ordering)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> DetailLevel)
-> (DetailLevel -> DetailLevel -> DetailLevel)
-> Ord DetailLevel
DetailLevel -> DetailLevel -> Bool
DetailLevel -> DetailLevel -> Ordering
DetailLevel -> DetailLevel -> DetailLevel
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: DetailLevel -> DetailLevel -> DetailLevel
$cmin :: DetailLevel -> DetailLevel -> DetailLevel
max :: DetailLevel -> DetailLevel -> DetailLevel
$cmax :: DetailLevel -> DetailLevel -> DetailLevel
>= :: DetailLevel -> DetailLevel -> Bool
$c>= :: DetailLevel -> DetailLevel -> Bool
> :: DetailLevel -> DetailLevel -> Bool
$c> :: DetailLevel -> DetailLevel -> Bool
<= :: DetailLevel -> DetailLevel -> Bool
$c<= :: DetailLevel -> DetailLevel -> Bool
< :: DetailLevel -> DetailLevel -> Bool
$c< :: DetailLevel -> DetailLevel -> Bool
compare :: DetailLevel -> DetailLevel -> Ordering
$ccompare :: DetailLevel -> DetailLevel -> Ordering
$cp1Ord :: Eq DetailLevel
Ord, Int -> DetailLevel
DetailLevel -> Int
DetailLevel -> [DetailLevel]
DetailLevel -> DetailLevel
DetailLevel -> DetailLevel -> [DetailLevel]
DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
(DetailLevel -> DetailLevel)
-> (DetailLevel -> DetailLevel)
-> (Int -> DetailLevel)
-> (DetailLevel -> Int)
-> (DetailLevel -> [DetailLevel])
-> (DetailLevel -> DetailLevel -> [DetailLevel])
-> (DetailLevel -> DetailLevel -> [DetailLevel])
-> (DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel])
-> Enum DetailLevel
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
$cenumFromThenTo :: DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
enumFromTo :: DetailLevel -> DetailLevel -> [DetailLevel]
$cenumFromTo :: DetailLevel -> DetailLevel -> [DetailLevel]
enumFromThen :: DetailLevel -> DetailLevel -> [DetailLevel]
$cenumFromThen :: DetailLevel -> DetailLevel -> [DetailLevel]
enumFrom :: DetailLevel -> [DetailLevel]
$cenumFrom :: DetailLevel -> [DetailLevel]
fromEnum :: DetailLevel -> Int
$cfromEnum :: DetailLevel -> Int
toEnum :: Int -> DetailLevel
$ctoEnum :: Int -> DetailLevel
pred :: DetailLevel -> DetailLevel
$cpred :: DetailLevel -> DetailLevel
succ :: DetailLevel -> DetailLevel
$csucc :: DetailLevel -> DetailLevel
Enum, DetailLevel
DetailLevel -> DetailLevel -> Bounded DetailLevel
forall a. a -> a -> Bounded a
maxBound :: DetailLevel
$cmaxBound :: DetailLevel
minBound :: DetailLevel
$cminBound :: DetailLevel
Bounded, (forall x. DetailLevel -> Rep DetailLevel x)
-> (forall x. Rep DetailLevel x -> DetailLevel)
-> Generic DetailLevel
forall x. Rep DetailLevel x -> DetailLevel
forall x. DetailLevel -> Rep DetailLevel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DetailLevel x -> DetailLevel
$cfrom :: forall x. DetailLevel -> Rep DetailLevel x
Generic)

instance Binary DetailLevel

defaultDetailLevel :: DetailLevel
defaultDetailLevel :: DetailLevel
defaultDetailLevel = DetailLevel
DetailAll  -- TODO: take from config file

-- | Suffix to append to a basic content name if the content causes the effect.
--
-- We show absolute time in seconds, not @moves@, because actors can have
-- different speeds (and actions can potentially take different time intervals).
-- We call the time taken by one player move, when walking, a @move@.
-- @Turn@ and @clip@ are used mostly internally, the former as an absolute
-- time unit.
-- We show distances in @steps@, because one step, from a tile to another
-- tile, is always 1 meter. We don't call steps @tiles@, reserving
-- that term for the context of terrain kinds or units of area.
effectToSuffix :: DetailLevel -> Effect -> Text
effectToSuffix :: DetailLevel -> Effect -> Text
effectToSuffix detailLevel :: DetailLevel
detailLevel effect :: Effect
effect =
  case Effect
effect of
    Burn d :: Dice
d -> Text -> Text
wrapInParens (Dice -> Text
forall a. Show a => a -> Text
tshow Dice
d
                            Text -> Text -> Text
<+> if Dice -> Int
Dice.supDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 then "burns" else "burn")
    Explode t :: GroupName ItemKind
t -> "of" Text -> Text -> Text
<+> GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
t Text -> Text -> Text
<+> "explosion"
    RefillHP p :: Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> "of healing" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
affixBonus Int
p)
    RefillHP 0 -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "" String -> Effect -> String
forall v. Show v => String -> v -> String
`showFailure` Effect
effect
    RefillHP p :: Int
p -> "of wounding" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
affixBonus Int
p)
    RefillCalm p :: Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 -> "of soothing" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
affixBonus Int
p)
    RefillCalm 0 -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ "" String -> Effect -> String
forall v. Show v => String -> v -> String
`showFailure` Effect
effect
    RefillCalm p :: Int
p -> "of dismaying" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
affixBonus Int
p)
    Dominate -> "of domination"
    Impress -> "of impression"
    PutToSleep -> "of sleep"
    Yell -> "of alarm"  -- minor, but if under timeout, differentiates items
    Summon grp :: GroupName ItemKind
grp d :: Dice
d -> [Part] -> Text
makePhrase
      [ "of summoning"
      , if Dice -> Int
Dice.supDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 1 then "" else Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Dice -> Text
forall a. Show a => a -> Text
tshow Dice
d
      , Part -> Part
MU.Ws (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp ]
    ApplyPerfume -> "of smell removal"
    Ascend True -> "of ascending"
    Ascend False -> "of descending"
    Escape{} -> "of escaping"
    Paralyze dice :: Dice
dice ->
      let time :: Text
time = case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
            Nothing -> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> "* 0.05s"
            Just p :: Int
p ->
              let dt :: Delta Time
dt = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
p
              in Delta Time -> Text
timeDeltaInSecondsText Delta Time
dt
      in "of paralysis for" Text -> Text -> Text
<+> Text
time
    ParalyzeInWater dice :: Dice
dice ->
      let time :: Text
time = case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
            Nothing -> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> "* 0.05s"
            Just p :: Int
p ->
              let dt :: Delta Time
dt = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
p
              in Delta Time -> Text
timeDeltaInSecondsText Delta Time
dt
      in "of retardation for" Text -> Text -> Text
<+> Text
time
    InsertMove dice :: Dice
dice ->
      let moves :: Text
moves = case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
            Nothing -> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> "tenths of a move"
            Just p :: Int
p ->
              let (d :: Int
d, m :: Int
m) = Int
p Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` 10
              in if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                 then [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs Int
d "move"]
                 else [Part] -> Text
makePhrase [Int -> Part -> Part
MU.Car1Ws Int
p "tenth", "of a move"]
      in "of speed surge for" Text -> Text -> Text
<+> Text
moves
    Teleport dice :: Dice
dice | Dice -> Int
Dice.supDice Dice
dice Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 9 ->
      "of blinking" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice)
    Teleport dice :: Dice
dice -> "of teleport" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice)
    CreateItem _ COrgan grp :: GroupName ItemKind
grp tim :: TimerDice
tim ->
      let stime :: Text
stime = if TimerDice -> Bool
isTimerNone TimerDice
tim then "" else "for" Text -> Text -> Text
<+> TimerDice -> Text
forall a. Show a => a -> Text
tshow TimerDice
tim Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":"
      in "(keep" Text -> Text -> Text
<+> Text
stime Text -> Text -> Text
<+> GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
    CreateItem _ _ grp :: GroupName ItemKind
grp _ ->
      [Part] -> Text
makePhrase ["of gain", Part -> Part
MU.AW (Part -> Part) -> Part -> Part
forall a b. (a -> b) -> a -> b
$ Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp]
    DestroyItem{} -> "of loss"
    ConsumeItems{} -> "of consumption from the ground"
      -- too much noise from crafting
    DropItem n :: Int
n k :: Int
k store :: CStore
store grp :: GroupName ItemKind
grp ->
      let (preT :: Text
preT, postT :: Text
postT) =
            if | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound -> ("one", "kind")
               | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound -> ("all", "kinds")
               | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
|| CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
COrgan -> ("", "")
               | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound -> ("", "condition fully")
               | Bool
otherwise -> ("", "condition" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-fold")
          (verb :: Text
verb, fromStore :: Text
fromStore) =
            if CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan
            then ("nullify", "")
            else ("drop", "from" Text -> Text -> Text
<+> (Text, Text) -> Text
forall a b. (a, b) -> b
snd (CStore -> (Text, Text)
ppCStore CStore
store))
      in "of" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
<+> Text
preT Text -> Text -> Text
<+> GroupName ItemKind -> Text
forall a. GroupName a -> Text
fromGroupName GroupName ItemKind
grp Text -> Text -> Text
<+> Text
postT Text -> Text -> Text
<+> Text
fromStore
    Recharge n :: Int
n dice :: Dice
dice ->
      let times :: Text
times = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "" else Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
<+> "times"
      in case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
        Nothing -> "of recharge" Text -> Text -> Text
<+> Text
times
                   Text -> Text -> Text
<+> "by" Text -> Text -> Text
<+> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> "* 0.05s"
        Just p :: Int
p -> let dt :: Delta Time
dt = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
p
                  in "of recharge" Text -> Text -> Text
<+> Text
times
                     Text -> Text -> Text
<+> "by" Text -> Text -> Text
<+> Delta Time -> Text
timeDeltaInSecondsText Delta Time
dt
    Discharge n :: Int
n dice :: Dice
dice ->
      let times :: Text
times = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 then "" else Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
<+> "times"
      in case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
        Nothing -> "of discharge" Text -> Text -> Text
<+> Text
times
                   Text -> Text -> Text
<+> "by" Text -> Text -> Text
<+> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> "* 0.05s"
        Just p :: Int
p -> let dt :: Delta Time
dt = Delta Time -> Int -> Delta Time
timeDeltaScale (Time -> Delta Time
forall a. a -> Delta a
Delta Time
timeClip) Int
p
                  in "of discharge" Text -> Text -> Text
<+> Text
times
                     Text -> Text -> Text
<+> "by" Text -> Text -> Text
<+> Delta Time -> Text
timeDeltaInSecondsText Delta Time
dt
    PolyItem -> "of repurpose on the ground"
    RerollItem -> "of deeply reshape on the ground"
    DupItem -> "of multiplication on the ground"
    Identify -> "of identify"
    Detect d :: DetectKind
d radius :: Int
radius ->
      "of" Text -> Text -> Text
<+> DetectKind -> Text
detectToObject DetectKind
d Text -> Text -> Text
<+> "location" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
forall a. Show a => a -> Text
tshow Int
radius)
    SendFlying tmod :: ThrowMod
tmod -> "of impact" Text -> Text -> Text
<+> Text -> ThrowMod -> Text
tmodToSuff "" ThrowMod
tmod
    PushActor tmod :: ThrowMod
tmod -> "of pushing" Text -> Text -> Text
<+> Text -> ThrowMod -> Text
tmodToSuff "" ThrowMod
tmod
    PullActor tmod :: ThrowMod
tmod -> "of pulling" Text -> Text -> Text
<+> Text -> ThrowMod -> Text
tmodToSuff "" ThrowMod
tmod
    AtMostOneOf effs :: [Effect]
effs ->
      let ts :: [Text]
ts = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Effect -> Text) -> [Effect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel) [Effect]
effs
          subject :: Part
subject = "marvel"
          header :: Text
header = [Part] -> Text
makePhrase ["of", Int -> Part -> Part
MU.CardinalWs ([Text] -> Int
forall a. [a] -> Int
length [Text]
ts) Part
subject]
          sometimes :: Text
sometimes = if [Effect] -> Int
forall a. [a] -> Int
length [Effect]
effs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Text] -> Int
forall a. [a] -> Int
length [Text]
ts then "(sometimes)" else ""
      in case [Text]
ts of
        [] -> ""
        [wonder :: Text
wonder] -> Text
wonder Text -> Text -> Text
<+> Text
sometimes
        _ | DetailLevel
detailLevel DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll -> Text
header
        _ -> Text
header Text -> Text -> Text
<+> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate ", " [Text]
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]" Text -> Text -> Text
<+> Text
sometimes
    OneOf effs :: [Effect]
effs ->
      let ts :: [Text]
ts = (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
/= "") ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Effect -> Text) -> [Effect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel) [Effect]
effs
          subject :: Part
subject = "wonder"
          header :: Text
header = [Part] -> Text
makePhrase ["of", Int -> Part -> Part
MU.CardinalWs ([Text] -> Int
forall a. [a] -> Int
length [Text]
ts) Part
subject]
          sometimes :: Text
sometimes = if [Effect] -> Int
forall a. [a] -> Int
length [Effect]
effs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> [Text] -> Int
forall a. [a] -> Int
length [Text]
ts then "(sometimes)" else ""
      in case [Text]
ts of
        [] -> ""
        [wonder :: Text
wonder] -> Text
wonder Text -> Text -> Text
<+> Text
sometimes
        _ | DetailLevel
detailLevel DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailAll -> Text
header
        _ -> Text
header Text -> Text -> Text
<+> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate ", " [Text]
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "]" Text -> Text -> Text
<+> Text
sometimes
    OnSmash _ -> ""  -- printed inside a separate section
    OnCombine _ -> ""  -- printed inside a separate section
    OnUser eff :: Effect
eff -> let t :: Text
t = DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel Effect
eff
                  in if Text -> Bool
T.null Text
t then "" else "(on user:" Text -> Text -> Text
<+> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
    NopEffect -> ""  -- never printed
    AndEffect (ConsumeItems tools :: [(Int, GroupName ItemKind)]
tools raw :: [(Int, GroupName ItemKind)]
raw) eff :: Effect
eff -> case DetailLevel
detailLevel of
      DetailAll ->
       let (tcraft :: Text
tcraft, traw :: Text
traw, ttools :: Text
ttools) = [(Int, GroupName ItemKind)]
-> [(Int, GroupName ItemKind)] -> Effect -> (Text, Text, Text)
describeCrafting [(Int, GroupName ItemKind)]
tools [(Int, GroupName ItemKind)]
raw Effect
eff
       in Text
tcraft Text -> Text -> Text
<+> Text
traw Text -> Text -> Text
<+> Text
ttools
      DetailHigh -> "of crafting (recipes in lore menu)"
      _ -> "of crafting"
    AndEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2 ->
      let t :: Text
t = Text -> [Text] -> Text
T.intercalate " and then "
              ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
              ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Effect -> Text) -> [Effect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel) [Effect
eff1, Effect
eff2]
      in if Text -> Bool
T.null Text
t then "of conjunctive processing" else Text
t
    OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2 ->
      let t :: Text
t = Text -> [Text] -> Text
T.intercalate " or else "
              ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
              ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Effect -> Text) -> [Effect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel) [Effect
eff1, Effect
eff2]
      in if Text -> Bool
T.null Text
t then "of alternative processing" else Text
t
    SeqEffect effs :: [Effect]
effs ->
      let t :: Text
t = Text -> [Text] -> Text
T.intercalate " then "
              ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Text -> Bool) -> [Text] -> [Text]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (Text -> Bool) -> Text -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Bool
T.null)
              ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Effect -> Text) -> [Effect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel) [Effect]
effs
      in if Text -> Bool
T.null Text
t then "of sequential processing" else Text
t
    When cond :: Condition
cond eff :: Effect
eff ->
      let object :: Text
object = Condition -> Text
conditionToObject Condition
cond
          object2 :: Text
object2 = DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel Effect
eff
      in if Text -> Bool
T.null Text
object2
         then ""  -- no 'conditional processing' --- probably a hack
         else "when" Text -> Text -> Text
<+> Text
object Text -> Text -> Text
<+> "then" Text -> Text -> Text
<+> Text
object2
    Unless cond :: Condition
cond eff :: Effect
eff ->
      let object :: Text
object = Condition -> Text
conditionToObject Condition
cond
          object2 :: Text
object2 = DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel Effect
eff
      in if Text -> Bool
T.null Text
object2
         then ""
         else "unless" Text -> Text -> Text
<+> Text
object Text -> Text -> Text
<+> "then" Text -> Text -> Text
<+> Text
object2
    IfThenElse cond :: Condition
cond eff1 :: Effect
eff1 eff2 :: Effect
eff2 ->
      let object :: Text
object = Condition -> Text
conditionToObject Condition
cond
          object1 :: Text
object1 = DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel Effect
eff1
          object2 :: Text
object2 = DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel Effect
eff2
      in if Text -> Bool
T.null Text
object1 Bool -> Bool -> Bool
&& Text -> Bool
T.null Text
object2
         then ""
         else "if" Text -> Text -> Text
<+> Text
object Text -> Text -> Text
<+> "then" Text -> Text -> Text
<+> Text
object1 Text -> Text -> Text
<+> "else" Text -> Text -> Text
<+> Text
object2
    VerbNoLonger{} -> ""  -- no description for a flavour effect
    VerbMsg{} -> ""  -- no description for an effect that prints a description
    VerbMsgFail{} -> ""

conditionToObject :: Condition -> Text
conditionToObject :: Condition -> Text
conditionToObject = \case
  HpLeq n :: Int
n -> "HP <=" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
  HpGeq n :: Int
n -> "HP >=" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
  CalmLeq n :: Int
n -> "Calm <=" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
  CalmGeq n :: Int
n -> "Calm >=" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
n
  TriggeredBy activationFlag :: ActivationFlag
activationFlag ->
    "activated" Text -> Text -> Text
<+> ActivationFlag -> Text
activationFlagToObject ActivationFlag
activationFlag

activationFlagToObject :: ActivationFlag -> Text
activationFlagToObject :: ActivationFlag -> Text
activationFlagToObject = \case
  ActivationMeleeable -> "by meleeing"
  ActivationPeriodic -> "periodically"
  ActivationUnderRanged -> "under ranged attack"
  ActivationUnderMelee -> "under melee attack"
  ActivationProjectile -> "when flung"
  ActivationTrigger -> "by triggering"
  ActivationOnSmash -> "on smash"
  ActivationOnCombine -> "when combined"
  ActivationEmbed -> "embedded in terrain"
  ActivationConsume -> "when consumed"

detectToObject :: DetectKind -> Text
detectToObject :: DetectKind -> Text
detectToObject d :: DetectKind
d = case DetectKind
d of
  DetectAll -> "detail"
  DetectActor -> "intruder"
  DetectLoot -> "merchandise"
  DetectExit -> "exit"
  DetectHidden -> "secret"
  DetectEmbed -> "feature"
  DetectStash -> "stash"

detectToVerb :: DetectKind -> Text
detectToVerb :: DetectKind -> Text
detectToVerb d :: DetectKind
d = case DetectKind
d of
  DetectAll -> "map all"
  DetectActor -> "spot nearby"
  DetectLoot -> "locate nearby"
  DetectExit -> "learn nearby"
  DetectHidden -> "uncover nearby"
  DetectEmbed -> "notice nearby"
  DetectStash -> "locate"

slotToSentence :: EqpSlot -> Text
slotToSentence :: EqpSlot -> Text
slotToSentence es :: EqpSlot
es = case EqpSlot
es of
  EqpSlotMove -> "Those unskilled in locomotion equip it."
  EqpSlotMelee -> "Those unskilled in close combat equip it."
  EqpSlotDisplace -> "Those unskilled in moving in crowds equip it."
  EqpSlotAlter -> "Those unskilled in terrain modification equip it."
  EqpSlotWait -> "Those unskilled in watchfulness equip it."
  EqpSlotMoveItem -> "Those unskilled in inventory management equip it."
  EqpSlotProject -> "Those unskilled in item flinging equip it."
  EqpSlotApply -> "Those unskilled in applying items equip it."
  EqpSlotSwimming -> "Useful to any that wade or swim in water."
  EqpSlotFlying -> "Those not afraid to fly, put it on."
  EqpSlotHurtMelee -> "Veteran melee fighters are known to devote equipment slot to it."
  EqpSlotArmorMelee -> "Worn by people in risk of melee wounds."
  EqpSlotArmorRanged -> "People scared of shots in the dark wear it."
  EqpSlotMaxHP -> "The frail wear it to increase their Hit Point capacity."
  EqpSlotSpeed -> "The sluggish equip it to speed up their whole life."
  EqpSlotSight -> "The short-sighted wear it to notice their demise sooner."
  EqpSlotShine -> "Explorers brave enough to highlight themselves put it in their equipment."
  EqpSlotMiscBonus -> "Those that don't scorn minor bonuses may equip it."
  EqpSlotWeaponFast -> "Close range fighters pick it as their mainstay weapon."
  EqpSlotWeaponBig -> "Close range fighters pick it as their opening weapon."

skillName :: Skill -> Text
skillName :: Skill -> Text
skillName SkMove = "move stat"
skillName SkMelee = "melee stat"
skillName SkDisplace = "displace stat"
skillName SkAlter = "modify terrain stat"
skillName SkWait = "wait stat"
skillName SkMoveItem = "manage items stat"
skillName SkProject = "fling stat"
skillName SkApply = "trigger stat"
skillName SkSwimming = "swimming"
skillName SkFlying = "flying"
skillName SkHurtMelee = "to melee damage"
skillName SkArmorMelee = "melee armor"
skillName SkArmorRanged = "ranged armor"
skillName SkMaxHP = "max HP"
skillName SkMaxCalm = "max Calm"
skillName SkSpeed = "speed"
skillName SkSight = "sight radius"
skillName SkSmell = "smell radius"
skillName SkShine = "shine radius"
skillName SkNocto = "noctovision radius"
skillName SkHearing = "hearing radius"
skillName SkAggression = "aggression level"
skillName SkOdor = "odor level"
skillName SkDeflectRanged = "ranged deflection"
skillName SkDeflectMelee = "melee deflection"

skillDesc :: Skill -> Text
skillDesc :: Skill -> Text
skillDesc skill :: Skill
skill =
  let skName :: Text
skName = Skill -> Text
skillName Skill
skill
      capSkillName :: Text
capSkillName = "The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' skill"
      capStatName :: Text
capStatName = "The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords ([Text] -> [Text]
forall a. [a] -> [a]
init ([Text] -> [Text]) -> [Text] -> [Text]
forall a b. (a -> b) -> a -> b
$ Text -> [Text]
T.words Text
skName) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' stat"
  in case Skill
skill of
    SkMove -> Text
capStatName Text -> Text -> Text
<+>
      "determines whether the character can move. Actors not capable of movement can't be dominated."
    SkMelee -> Text
capStatName Text -> Text -> Text
<+>
      "determines whether the character can melee. Actors that can't melee can still cause damage by flinging missiles or by ramming (being pushed) at opponents."
    SkDisplace -> Text
capStatName Text -> Text -> Text
<+>
      "determines whether the character can displace adjacent actors. In some cases displacing is not possible regardless of skill: when the target is braced, dying, has no move skill or when both actors are supported by adjacent friendly units. Missiles can be displaced always, unless more than one occupies the map location."
    SkAlter -> Text
capStatName Text -> Text -> Text
<+>
      "determines which kinds of terrain can be activated and modified by the character. Opening doors and searching suspect tiles require skill 2, some stairs require 3, closing doors requires 4, others require 4 or 5. Actors not smart enough to be capable of using stairs can't be dominated."
    SkWait -> Text
capStatName Text -> Text -> Text
<+>
      "determines whether the character can wait, brace for combat (potentially blocking the effects of some attacks), sleep and lurk."
    SkMoveItem -> Text
capStatName Text -> Text -> Text
<+>
      "determines whether the character can pick up items and manage inventory."
    SkProject -> Text
capStatName Text -> Text -> Text
<+>
      "determines which kinds of items the character can propel. Items that can be lobbed to explode at a precise location, such as flasks, require skill 3. Other items travel until they meet an obstacle and skill 1 is enough to fling them. In some cases, e.g., of too intricate or two awkward items at low Calm, throwing is not possible regardless of the skill value."
    SkApply -> Text
capStatName Text -> Text -> Text
<+>
      "determines which kinds of items the character can use. Items that assume literacy require skill 2, others can be used already at skill 1. In some cases, e.g., when the item needs recharging, has no possible effects or is too intricate for distracted use, triggering may not be possible."
    SkSwimming -> Text
capSkillName Text -> Text -> Text
<+>
      "is the degree of avoidance of bad effects of terrain containing water, whether shallow or deep."
    SkFlying -> Text
capSkillName Text -> Text -> Text
<+>
      "is the degree of avoidance of bad effects of any hazards spread on the ground."
    SkHurtMelee -> Text
capSkillName Text -> Text -> Text
<+>
      "is a percentage of additional damage dealt by the actor (either a character or a missile) with any weapon. The value is capped at 200% and then the armor percentage of the defender is subtracted from it."
    SkArmorMelee -> Text
capSkillName Text -> Text -> Text
<+>
      "is a percentage of melee damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 95% (always at least 5% of damage gets through). It includes 50% bonus from being braced for combat, if applicable."
    SkArmorRanged -> Text
capSkillName Text -> Text -> Text
<+>
      "is a percentage of ranged damage avoided by the actor. The value is capped at 200%, then the extra melee damage percentage of the attacker is subtracted from it and the resulting total is capped at 95% (always at least 5% of damage gets through). It includes 25% bonus from being braced for combat, if applicable."
    SkMaxHP -> Text
capSkillName Text -> Text -> Text
<+>
      "is a cap on HP of the actor, except for some rare effects able to overfill HP. At any direct enemy damage (but not, e.g., incremental poisoning damage or wounds inflicted by mishandling a device) HP is cut back to the cap."
    SkMaxCalm -> Text
capSkillName Text -> Text -> Text
<+>
      "is a cap on Calm of the actor, except for some rare effects able to overfill Calm. At any direct enemy damage (but not, e.g., incremental poisoning damage or wounds inflicted by mishandling a device) Calm is lowered, sometimes very significantly and always at least back down to the cap."
    SkSpeed -> Text
capSkillName Text -> Text -> Text
<+>
      "is expressed in meters per second, which corresponds to map location (1m by 1m) per two standard turns (0.5s each). Thus actor at standard speed of 2m/s moves one location per standard turn."
    SkSight -> Text
capSkillName Text -> Text -> Text
<+>
      "is the limit of visibility in light. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location."
    SkSmell -> Text
capSkillName Text -> Text -> Text
<+>
      "determines the maximal area smelled by the actor. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location."
    SkShine -> Text
capSkillName Text -> Text -> Text
<+>
      "determines the maximal area lit by the actor. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location."
    SkNocto -> Text
capSkillName Text -> Text -> Text
<+>
      "is the limit of visibility in dark. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location."
    SkHearing -> Text
capSkillName Text -> Text -> Text
<+>
      "is the limit of hearing. The radius is measured from the middle of the map location occupied by the character to the edge of the furthest covered location."
    SkAggression -> "The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' property" Text -> Text -> Text
<+>
      "represents the willingness of the actor to engage in combat, especially close quarters, and conversely, to break engagement when overpowered."
    SkOdor -> "The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' property" Text -> Text -> Text
<+>
      "represents the ability to communicate (more specifically, communicate one's presence) through personal odor. Zero or less means the odor is not trackable."
    SkDeflectRanged -> "The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' property" Text -> Text -> Text
<+>
      "tells whether complete invulnerability to ranged attacks, piercing and of every other kind, is effective, and from how many sources."
    SkDeflectMelee -> "The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "' property" Text -> Text -> Text
<+>
      "tells whether complete invulnerability to melee attacks, piercing and of every other kind, is effective, and from how many sources."

skillToDecorator :: Skill -> Actor -> Int -> Text
skillToDecorator :: Skill -> Actor -> Int -> Text
skillToDecorator skill :: Skill
skill b :: Actor
b t :: Int
t =
  let tshow200 :: a -> Text
tshow200 n :: a
n = let n200 :: a
n200 = a -> a -> a
forall a. Ord a => a -> a -> a
min 200 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max (-200) a
n
                   in a -> Text
forall a. Show a => a -> Text
tshow a
n200 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if a
n200 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
n then "$" else ""
      -- Some values can be negative, for others 0 is equivalent but shorter.
      tshowRadius :: a -> Text
tshowRadius r :: a
r = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
r 0 of
                        GT -> a -> Text
forall a. Show a => a -> Text
tshow (a
r a -> a -> a
forall a. Num a => a -> a -> a
- 1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".5m"
                        EQ -> "0m"
                        LT -> a -> Text
forall a. Show a => a -> Text
tshow (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ 1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ".5m"
  in case Skill
skill of
    SkMove -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkMelee -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkDisplace -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkAlter -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkWait -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkMoveItem -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkProject -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkApply -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkSwimming -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkFlying -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkHurtMelee -> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshow200 Int
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
    SkArmorMelee -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshow200 Int
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%]"
    SkArmorRanged -> "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshow200 Int
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%}"
    SkMaxHP -> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
t
    SkMaxCalm -> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Ord a => a -> a -> a
max 0 Int
t
    SkSpeed -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
displaySpeed Int
t
    SkSight ->
      let tcapped :: Int
tcapped = Int -> Int -> Int
forall a. Ord a => a -> a -> a
min (Int64 -> Int
forall a. Enum a => a -> Int
fromEnum (Int64 -> Int) -> Int64 -> Int
forall a b. (a -> b) -> a -> b
$ Actor -> Int64
bcalm Actor
b Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int -> Int64
xM 5) Int
t
      in Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
tcapped
         Text -> Text -> Text
<+> if Int
tcapped Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
t
             then ""
             else "(max" Text -> Text -> Text
<+> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
    SkSmell -> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    SkShine -> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    SkNocto -> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    SkHearing -> Int -> Text
forall a. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    SkAggression -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkOdor -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkDeflectRanged -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    SkDeflectMelee -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t

skillSlots :: [Skill]
skillSlots :: [Skill]
skillSlots = [Skill
forall a. Bounded a => a
minBound .. Skill
forall a. Bounded a => a
maxBound]

tmodToSuff :: Text -> ThrowMod -> Text
tmodToSuff :: Text -> ThrowMod -> Text
tmodToSuff verb :: Text
verb ThrowMod{..} =
  let vSuff :: Text
vSuff | Int
throwVelocity Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 100 = ""
            | Bool
otherwise = "v=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
throwVelocity Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
      tSuff :: Text
tSuff | Int
throwLinger Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 100 = ""
            | Bool
otherwise = "t=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
throwLinger Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
      hSuff :: Text
hSuff | Int
throwHP Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = ""
            | Bool
otherwise = "pierce=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
throwHP
  in if Text
vSuff Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
&& Text
tSuff Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" Bool -> Bool -> Bool
&& Text
hSuff Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== "" then ""
     else Text
verb Text -> Text -> Text
<+> "with" Text -> Text -> Text
<+> Text
vSuff Text -> Text -> Text
<+> Text
tSuff Text -> Text -> Text
<+> Text
hSuff

kindAspectToSuffix :: Aspect -> Text
kindAspectToSuffix :: Aspect -> Text
kindAspectToSuffix aspect :: Aspect
aspect =
  case Aspect
aspect of
    Timeout{} -> ""  -- printed specially
    AddSkill SkMove t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "move"
    AddSkill SkMelee t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "melee"
    AddSkill SkDisplace t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "displace"
    AddSkill SkAlter t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "modify"
    AddSkill SkWait t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "wait"
    AddSkill SkMoveItem t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "manage items"
    AddSkill SkProject t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "fling"
    AddSkill SkApply t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "trigger"
    AddSkill SkSwimming t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "swimming"
    AddSkill SkFlying t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "flying"
    AddSkill SkHurtMelee _ ->
      ""  -- printed together with dice, even if dice is zero
    AddSkill SkArmorMelee t :: Dice
t -> "[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dice -> Text
affixDice Dice
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%]"
    AddSkill SkArmorRanged t :: Dice
t -> "{" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dice -> Text
affixDice Dice
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%}"
    AddSkill SkMaxHP t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "HP"
    AddSkill SkMaxCalm t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "Calm"
    AddSkill SkSpeed t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "speed"
    AddSkill SkSight t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "sight"
    AddSkill SkSmell t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "smell"
    AddSkill SkShine t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "shine"
    AddSkill SkNocto t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "night vision"
    AddSkill SkHearing t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "hearing"
    AddSkill SkAggression t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "aggression"
    AddSkill SkOdor t :: Dice
t -> Text -> Text
wrapInParens (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Text
affixDice Dice
t Text -> Text -> Text
<+> "odor"
    AddSkill SkDeflectRanged d :: Dice
d ->
      if | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 -> Text -> Text
wrapInChevrons "deflecting ranged attacks"
         | Dice -> Int
Dice.supDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -1 -> Text -> Text
wrapInChevrons "vulnerable to ranged attacks"
         | Bool
otherwise -> ""  -- bad content?
    AddSkill SkDeflectMelee d :: Dice
d ->
      if | Dice -> Int
Dice.infDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= 1 -> Text -> Text
wrapInChevrons "deflecting melee attacks"
         | Dice -> Int
Dice.supDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= -1 -> Text -> Text
wrapInChevrons "vulnerable to melee attacks"
         | Bool
otherwise -> ""  -- bad content?
    SetFlag Fragile -> Text -> Text
wrapInChevrons "fragile"
    SetFlag Lobable -> Text -> Text
wrapInChevrons "can be lobbed"
    SetFlag Durable -> Text -> Text
wrapInChevrons "durable"
    SetFlag Equipable -> ""
    SetFlag Benign -> ""
    SetFlag Precious -> ""
    SetFlag Blast -> ""
    SetFlag Condition -> ""
    SetFlag Unique -> ""  -- named specially by the content writer
    SetFlag MetaGame -> ""
    SetFlag MinorEffects -> ""  -- cryptic override
    SetFlag MinorAspects -> ""  -- cryptic override
    SetFlag Meleeable -> ""
    SetFlag Periodic -> ""  -- printed specially
    SetFlag UnderRanged -> Text -> Text
wrapInChevrons "applied under ranged attack"
    SetFlag UnderMelee -> Text -> Text
wrapInChevrons "applied under melee attack"
    ELabel{} -> ""  -- too late
    ToThrow tmod :: ThrowMod
tmod -> Text -> Text
wrapInChevrons (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> ThrowMod -> Text
tmodToSuff "flies" ThrowMod
tmod
    PresentAs{} -> ""
    EqpSlot{} -> ""  -- used in @slotToSentence@ instead
    Odds{} -> ""

aspectToSentence :: Aspect -> Maybe Text
aspectToSentence :: Aspect -> Maybe Text
aspectToSentence feat :: Aspect
feat =
  case Aspect
feat of
    Timeout{} -> Maybe Text
forall a. Maybe a
Nothing
    AddSkill{} -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Fragile -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Lobable -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Durable -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Equipable -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Benign -> Text -> Maybe Text
forall a. a -> Maybe a
Just "It affects the opponent in a benign way."
    SetFlag Precious -> Text -> Maybe Text
forall a. a -> Maybe a
Just "It seems precious."
    SetFlag Blast -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Condition -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Unique -> Text -> Maybe Text
forall a. a -> Maybe a
Just "It is one of a kind."
    SetFlag MetaGame -> Text -> Maybe Text
forall a. a -> Maybe a
Just "It's characteristic to a person and easy to recognize once learned, even under very different circumstances."
    SetFlag MinorEffects -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag MinorAspects -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Meleeable -> Text -> Maybe Text
forall a. a -> Maybe a
Just "It is considered for melee strikes."
    SetFlag Periodic -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag UnderRanged -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag UnderMelee -> Maybe Text
forall a. Maybe a
Nothing
    ELabel{} -> Maybe Text
forall a. Maybe a
Nothing
    ToThrow{} -> Maybe Text
forall a. Maybe a
Nothing
    PresentAs{} -> Maybe Text
forall a. Maybe a
Nothing
    EqpSlot es :: EqpSlot
es -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ EqpSlot -> Text
slotToSentence EqpSlot
es
    Odds{} -> Text -> Maybe Text
forall a. a -> Maybe a
Just "Individual specimens sometimes have yet other properties."

affixBonus :: Int -> Text
affixBonus :: Int -> Text
affixBonus p :: Int
p = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
p 0 of
  EQ -> "0"
  LT -> Int -> Text
forall a. Show a => a -> Text
tshow Int
p
  GT -> "+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
p

wrapInParens :: Text -> Text
wrapInParens :: Text -> Text
wrapInParens "" = ""
wrapInParens t :: Text
t = "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"

wrapInChevrons :: Text -> Text
wrapInChevrons :: Text -> Text
wrapInChevrons "" = ""
wrapInChevrons t :: Text
t = "<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ">"

affixDice :: Dice.Dice -> Text
affixDice :: Dice -> Text
affixDice d :: Dice
d = Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "+?" Int -> Text
affixBonus (Maybe Int -> Text) -> Maybe Int -> Text
forall a b. (a -> b) -> a -> b
$ Dice -> Maybe Int
Dice.reduceDice Dice
d

describeTools :: [(Int, GroupName ItemKind)] -> MU.Part
describeTools :: [(Int, GroupName ItemKind)] -> Part
describeTools =
  let carAWs :: (Int, GroupName a) -> Part
carAWs (k :: Int
k, grp :: GroupName a
grp) = Int -> Part -> Part
MU.CarAWs Int
k (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName a -> Text
forall a. GroupName a -> Text
fromGroupName GroupName a
grp)
  in [Part] -> Part
MU.WWandW ([Part] -> Part)
-> ([(Int, GroupName ItemKind)] -> [Part])
-> [(Int, GroupName ItemKind)]
-> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Int, GroupName ItemKind) -> Part)
-> [(Int, GroupName ItemKind)] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map (Int, GroupName ItemKind) -> Part
forall a. (Int, GroupName a) -> Part
carAWs

describeToolsAlternative :: [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative :: [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative grps :: [[(Int, GroupName ItemKind)]]
grps =
  Text -> [Text] -> Text
T.intercalate " or " ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ([(Int, GroupName ItemKind)] -> Text)
-> [[(Int, GroupName ItemKind)]] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\grp :: [(Int, GroupName ItemKind)]
grp -> [Part] -> Text
makePhrase [[(Int, GroupName ItemKind)] -> Part
describeTools [(Int, GroupName ItemKind)]
grp])
                       ([[(Int, GroupName ItemKind)]] -> [Text])
-> [[(Int, GroupName ItemKind)]] -> [Text]
forall a b. (a -> b) -> a -> b
$ ([(Int, GroupName ItemKind)] -> Bool)
-> [[(Int, GroupName ItemKind)]] -> [[(Int, GroupName ItemKind)]]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool)
-> ([(Int, GroupName ItemKind)] -> Bool)
-> [(Int, GroupName ItemKind)]
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null) [[(Int, GroupName ItemKind)]]
grps

describeCrafting :: [(Int, GroupName ItemKind)]
                 -> [(Int, GroupName ItemKind)]
                 -> Effect
                 -> (Text, Text, Text)
describeCrafting :: [(Int, GroupName ItemKind)]
-> [(Int, GroupName ItemKind)] -> Effect -> (Text, Text, Text)
describeCrafting tools :: [(Int, GroupName ItemKind)]
tools raw :: [(Int, GroupName ItemKind)]
raw eff :: Effect
eff =
  let unCreate :: Effect -> [(Int, GroupName ItemKind)]
unCreate (CreateItem (Just k :: Int
k) _ grp :: GroupName ItemKind
grp _) = [(Int
k, GroupName ItemKind
grp)]
      unCreate (SeqEffect effs :: [Effect]
effs) = (Effect -> [(Int, GroupName ItemKind)])
-> [Effect] -> [(Int, GroupName ItemKind)]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Effect -> [(Int, GroupName ItemKind)]
unCreate [Effect]
effs
      unCreate _ = []
      grpsCreate :: [(Int, GroupName ItemKind)]
grpsCreate = Effect -> [(Int, GroupName ItemKind)]
unCreate Effect
eff
      tcraft :: Text
tcraft = [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
        "of crafting"
        Part -> [Part] -> [Part]
forall a. a -> [a] -> [a]
: (if [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Int, GroupName ItemKind)]
grpsCreate
           then ["nothing"]
           else [[(Int, GroupName ItemKind)] -> Part
describeTools [(Int, GroupName ItemKind)]
grpsCreate])
      traw :: Text
traw = [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
        if [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Int, GroupName ItemKind)]
raw
        then []
        else ["from", [(Int, GroupName ItemKind)] -> Part
describeTools [(Int, GroupName ItemKind)]
raw]
      ttools :: Text
ttools = [Part] -> Text
makePhrase ([Part] -> Text) -> [Part] -> Text
forall a b. (a -> b) -> a -> b
$
        if [(Int, GroupName ItemKind)] -> Bool
forall a. [a] -> Bool
null [(Int, GroupName ItemKind)]
tools
        then []
        else ["using", [(Int, GroupName ItemKind)] -> Part
describeTools [(Int, GroupName ItemKind)]
tools]
  in (Text
tcraft, Text
traw, Text
ttools)