{-# LANGUAGE DeriveGeneric #-}
-- | Description of effects.
module Game.LambdaHack.Client.UI.EffectDescription
  ( DetailLevel(..), defaultDetailLevel
  , effectToSuffix, detectToObject, detectToVerb
  , skillName, skillDesc, skillToDecorator, skillsInDisplayOrder
  , 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
$cshowsPrec :: Int -> DetailLevel -> ShowS
showsPrec :: Int -> DetailLevel -> ShowS
$cshow :: DetailLevel -> String
show :: DetailLevel -> String
$cshowList :: [DetailLevel] -> ShowS
showList :: [DetailLevel] -> ShowS
Show, DetailLevel -> DetailLevel -> Bool
(DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool) -> Eq DetailLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DetailLevel -> DetailLevel -> Bool
== :: DetailLevel -> DetailLevel -> Bool
$c/= :: DetailLevel -> DetailLevel -> Bool
/= :: 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
$ccompare :: DetailLevel -> DetailLevel -> Ordering
compare :: DetailLevel -> DetailLevel -> Ordering
$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
>= :: DetailLevel -> DetailLevel -> Bool
$cmax :: DetailLevel -> DetailLevel -> DetailLevel
max :: DetailLevel -> DetailLevel -> DetailLevel
$cmin :: DetailLevel -> DetailLevel -> DetailLevel
min :: DetailLevel -> DetailLevel -> 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
$csucc :: DetailLevel -> DetailLevel
succ :: DetailLevel -> DetailLevel
$cpred :: DetailLevel -> DetailLevel
pred :: DetailLevel -> DetailLevel
$ctoEnum :: Int -> DetailLevel
toEnum :: Int -> DetailLevel
$cfromEnum :: DetailLevel -> Int
fromEnum :: DetailLevel -> Int
$cenumFrom :: DetailLevel -> [DetailLevel]
enumFrom :: DetailLevel -> [DetailLevel]
$cenumFromThen :: DetailLevel -> DetailLevel -> [DetailLevel]
enumFromThen :: DetailLevel -> DetailLevel -> [DetailLevel]
$cenumFromTo :: DetailLevel -> DetailLevel -> [DetailLevel]
enumFromTo :: DetailLevel -> DetailLevel -> [DetailLevel]
$cenumFromThenTo :: DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
enumFromThenTo :: DetailLevel -> DetailLevel -> DetailLevel -> [DetailLevel]
Enum, DetailLevel
DetailLevel -> DetailLevel -> Bounded DetailLevel
forall a. a -> a -> Bounded a
$cminBound :: DetailLevel
minBound :: DetailLevel
$cmaxBound :: DetailLevel
maxBound :: 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
$cfrom :: forall x. DetailLevel -> Rep DetailLevel x
from :: forall x. DetailLevel -> Rep DetailLevel x
$cto :: forall x. Rep DetailLevel x -> DetailLevel
to :: forall x. Rep DetailLevel x -> DetailLevel
Generic)

instance Binary DetailLevel

defaultDetailLevel :: DetailLevel
defaultDetailLevel :: DetailLevel
defaultDetailLevel = DetailLevel
DetailAll  -- TODO: take from config file, #217

-- | 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 Effect
effect =
  case Effect
effect of
    Burn 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
> Int
1 then Text
"burns" else Text
"burn")
    Explode GroupName ItemKind
t -> Text
"of" Text -> Text -> Text
<+> GroupName ItemKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName ItemKind
t Text -> Text -> Text
<+> Text
"explosion"
    RefillHP Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Text
"of healing" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
affixBonus Int
p)
    RefillHP Int
0 -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"" String -> Effect -> String
forall v. Show v => String -> v -> String
`showFailure` Effect
effect
    RefillHP Int
p -> Text
"of wounding" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs Int
p)
    RefillCalm Int
p | Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 -> Text
"of soothing" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
affixBonus Int
p)
    RefillCalm Int
0 -> String -> Text
forall a. HasCallStack => String -> a
error (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String
"" String -> Effect -> String
forall v. Show v => String -> v -> String
`showFailure` Effect
effect
    RefillCalm Int
p -> Text
"of dismaying" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Text) -> Int -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Int
forall a. Num a => a -> a
abs Int
p)
    Effect
Dominate -> Text
"of domination"
    Effect
Impress -> Text
"of impression"
    Effect
PutToSleep -> Text
"of sleep"
    Effect
Yell -> Text
"of alarm"  -- minor, but if under timeout, differentiates items
    Summon GroupName ItemKind
grp Dice
d -> [Part] -> Text
makePhrase
      [ Part
"of summoning"
      , if Dice -> Int
Dice.supDice Dice
d Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
1 then Part
"" 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 c. GroupName c -> Text
displayGroupName GroupName ItemKind
grp ]
    Effect
ApplyPerfume -> Text
"of smell removal"
    Ascend Bool
True -> Text
"of ascending"
    Ascend Bool
False -> Text
"of descending"
    Escape{} -> Text
"of escaping"
    Paralyze Dice
dice ->
      let time :: Text
time = case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
            Maybe Int
Nothing -> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> Text
"* 0.05s"
            Just 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 Text
"of paralysis for" Text -> Text -> Text
<+> Text
time
    ParalyzeInWater Dice
dice ->
      let time :: Text
time = case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
            Maybe Int
Nothing -> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> Text
"* 0.05s"
            Just 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 Text
"of retardation for" Text -> Text -> Text
<+> Text
time
    InsertMove Dice
dice ->
      let moves :: Text
moves = case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
            Maybe Int
Nothing -> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> Text
"tenths of a move"
            Just Int
p ->
              let (Int
d, Int
m) = Int
p Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
10
              in if Int
m Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
                 then [Part] -> Text
makePhrase [Int -> Part -> Part
MU.CarWs Int
d Part
"move"]
                 else [Part] -> Text
makePhrase [Int -> Part -> Part
MU.Car1Ws Int
p Part
"tenth", Part
"of a move"]
      in Text
"of speed surge for" Text -> Text -> Text
<+> Text
moves
    Teleport Dice
dice | Dice -> Int
Dice.supDice Dice
dice Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
9 ->
      Text
"of blinking" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice)
    Teleport Dice
dice -> Text
"of teleport" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice)
    CreateItem Maybe Int
_ CStore
COrgan GroupName ItemKind
grp TimerDice
tim ->
      let stime :: Text
stime = if TimerDice -> Bool
isTimerNone TimerDice
tim then Text
"" else Text
"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
<> Text
":"
      in Text
"(keep" Text -> Text -> Text
<+> Text
stime Text -> Text -> Text
<+> GroupName ItemKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName ItemKind
grp Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    CreateItem Maybe Int
_ CStore
_ GroupName ItemKind
grp TimerDice
_ ->
      [Part] -> Text
makePhrase [Part
"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 c. GroupName c -> Text
displayGroupName GroupName ItemKind
grp]
    DestroyItem{} -> Text
"of loss"
    ConsumeItems{} -> Text
"of consumption from the ground"
      -- too much noise from crafting
    DropItem Int
n Int
k CStore
store GroupName ItemKind
grp ->
      let (Text
preT, Text
postT) =
            if | Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
&& Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound -> (Text
"one", Text
"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 -> (Text
"all", Text
"kinds")
               | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 Bool -> Bool -> Bool
|| CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
/= CStore
COrgan -> (Text
"", Text
"")
               | Int
k Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
forall a. Bounded a => a
maxBound -> (Text
"", Text
"condition fully")
               | Bool
otherwise -> (Text
"", Text
"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
<> Text
"-fold")
          (Text
verb, Text
fromStore) =
            if CStore
store CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan
            then (Text
"nullify", Text
"")
            else (Text
"drop", Text
"from" Text -> Text -> Text
<+> (Text, Text) -> Text
forall a b. (a, b) -> b
snd (CStore -> (Text, Text)
ppCStore CStore
store))
      in Text
"of" Text -> Text -> Text
<+> Text
verb Text -> Text -> Text
<+> Text
preT Text -> Text -> Text
<+> GroupName ItemKind -> Text
forall c. GroupName c -> Text
displayGroupName GroupName ItemKind
grp Text -> Text -> Text
<+> Text
postT Text -> Text -> Text
<+> Text
fromStore
    Recharge Int
n Dice
dice ->
      let times :: Text
times = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
<+> Text
"times"
      in case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
        Maybe Int
Nothing -> Text
"of recharge" Text -> Text -> Text
<+> Text
times
                   Text -> Text -> Text
<+> Text
"by" Text -> Text -> Text
<+> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> Text
"* 0.05s"
        Just 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 Text
"of recharge" Text -> Text -> Text
<+> Text
times
                     Text -> Text -> Text
<+> Text
"by" Text -> Text -> Text
<+> Delta Time -> Text
timeDeltaInSecondsText Delta Time
dt
    Discharge Int
n Dice
dice ->
      let times :: Text
times = if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 then Text
"" else Int -> Text
forall a. Show a => a -> Text
tshow Int
n Text -> Text -> Text
<+> Text
"times"
      in case Dice -> Maybe Int
Dice.reduceDice Dice
dice of
        Maybe Int
Nothing -> Text
"of discharge" Text -> Text -> Text
<+> Text
times
                   Text -> Text -> Text
<+> Text
"by" Text -> Text -> Text
<+> Dice -> Text
forall a. Show a => a -> Text
tshow Dice
dice Text -> Text -> Text
<+> Text
"* 0.05s"
        Just 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 Text
"of discharge" Text -> Text -> Text
<+> Text
times
                     Text -> Text -> Text
<+> Text
"by" Text -> Text -> Text
<+> Delta Time -> Text
timeDeltaInSecondsText Delta Time
dt
    Effect
PolyItem -> Text
"of repurpose on the ground"
    Effect
RerollItem -> Text
"of deeply reshape on the ground"
    Effect
DupItem -> Text
"of multiplication on the ground"
    Effect
Identify -> Text
"of identify"
    Detect DetectKind
d Int
radius ->
      Text
"of" Text -> Text -> Text
<+> DetectKind -> Text
detectToObject DetectKind
d Text -> Text -> Text
<+> Text
"location" Text -> Text -> Text
<+> Text -> Text
wrapInParens (Int -> Text
forall a. Show a => a -> Text
tshow Int
radius)
    SendFlying ThrowMod
tmod -> Text
"of impact" Text -> Text -> Text
<+> Text -> ThrowMod -> Text
tmodToSuff Text
"" ThrowMod
tmod
    PushActor ThrowMod
tmod -> Text
"of pushing" Text -> Text -> Text
<+> Text -> ThrowMod -> Text
tmodToSuff Text
"" ThrowMod
tmod
    PullActor ThrowMod
tmod -> Text
"of pulling" Text -> Text -> Text
<+> Text -> ThrowMod -> Text
tmodToSuff Text
"" ThrowMod
tmod
    AtMostOneOf [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] -> [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 = Part
"marvel"
          header :: Text
header = [Part] -> Text
makePhrase [Part
"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 Text
"(sometimes)" else Text
""
      in case [Text]
ts of
        [] -> Text
""
        [Text
wonder] -> Text
wonder Text -> Text -> Text
<+> Text
sometimes
        [Text]
_ | DetailLevel
detailLevel DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh -> Text
header
        [Text]
_ -> Text
header Text -> Text -> Text
<+> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]" Text -> Text -> Text
<+> Text
sometimes
    OneOf [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] -> [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 = Part
"wonder"
          header :: Text
header = [Part] -> Text
makePhrase [Part
"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 Text
"(sometimes)" else Text
""
      in case [Text]
ts of
        [] -> Text
""
        [Text
wonder] -> Text
wonder Text -> Text -> Text
<+> Text
sometimes
        [Text]
_ | DetailLevel
detailLevel DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
< DetailLevel
DetailHigh -> Text
header
        [Text]
_ -> Text
header Text -> Text -> Text
<+> Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
", " [Text]
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]" Text -> Text -> Text
<+> Text
sometimes
    OnSmash Effect
_ -> Text
""  -- printed inside a separate section
    OnCombine Effect
_ -> Text
""  -- printed inside a separate section
    OnUser Effect
eff -> let t :: Text
t = DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detailLevel Effect
eff
                  in if Text -> Bool
T.null Text
t then Text
"" else Text
"(on user:" Text -> Text -> Text
<+> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    Effect
NopEffect -> Text
""  -- never printed
    AndEffect (ConsumeItems [(Int, GroupName ItemKind)]
tools [(Int, GroupName ItemKind)]
raw) Effect
eff -> case DetailLevel
detailLevel of
     DetailLevel
DetailLow -> Text
"of crafting"
     DetailLevel
DetailMedium -> Text
"of crafting (recipes in lore menu)"
     DetailLevel
_ ->
       let (Text
tcraft, Text
traw, 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
    AndEffect Effect
eff1 Effect
eff2 ->
      let t :: Text
t = Text -> [Text] -> Text
T.intercalate Text
" 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 Text
"of conjunctive processing" else Text
t
    OrEffect Effect
eff1 Effect
eff2 ->
      let t :: Text
t = Text -> [Text] -> Text
T.intercalate Text
" 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 Text
"of alternative processing" else Text
t
    SeqEffect [Effect]
effs ->
      let t :: Text
t = Text -> [Text] -> Text
T.intercalate Text
" 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 Text
"of sequential processing" else Text
t
    When Condition
cond 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 Text
""  -- no 'conditional processing' --- probably a hack
         else Text
"(when" Text -> Text -> Text
<+> Text
object Text -> Text -> Text
<+> Text
"then" Text -> Text -> Text
<+> Text
object2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    Unless Condition
cond 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 Text
""
         else Text
"(unless" Text -> Text -> Text
<+> Text
object Text -> Text -> Text
<+> Text
"then" Text -> Text -> Text
<+> Text
object2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    IfThenElse Condition
cond Effect
eff1 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 Text
""
         else Text
"(if" Text -> Text -> Text
<+> Text
object Text -> Text -> Text
<+> Text
"then" Text -> Text -> Text
<+> Text
object1
                               Text -> Text -> Text
<+> Text
"else" Text -> Text -> Text
<+> Text
object2 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
    VerbNoLonger{} -> Text
""  -- no description for a flavour effect
    VerbMsg{} -> Text
""  -- no description for an effect that prints a description
    VerbMsgFail{} -> Text
""

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

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

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

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

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

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

skillDesc :: Skill -> Text
skillDesc :: Skill -> Text
skillDesc Skill
skill =
  let skName :: Text
skName = Skill -> Text
skillName Skill
skill
      capSkillName :: Text
capSkillName = Text
"The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' skill"
      capStatName :: Text
capStatName = Text
"The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords ([Text] -> [Text]
forall a. HasCallStack => [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
<> Text
"' stat"
  in case Skill
skill of
    Skill
SkMove -> Text
capStatName Text -> Text -> Text
<+>
      Text
"determines whether the character can move. Actors not capable of movement can't be dominated."
    Skill
SkMelee -> Text
capStatName Text -> 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."
    Skill
SkDisplace -> Text
capStatName Text -> 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."
    Skill
SkAlter -> Text
capStatName Text -> 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."
    Skill
SkWait -> Text
capStatName Text -> Text -> Text
<+>
      Text
"determines whether the character can wait, brace for combat (potentially blocking the effects of some attacks), sleep and lurk."
    Skill
SkMoveItem -> Text
capStatName Text -> Text -> Text
<+>
      Text
"determines whether the character can pick up items and manage inventory."
    Skill
SkProject -> Text
capStatName Text -> 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."
    Skill
SkApply -> Text
capStatName Text -> 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."
    Skill
SkSwimming -> Text
capSkillName Text -> Text -> Text
<+>
      Text
"is the degree of avoidance of bad effects of terrain containing water, whether shallow or deep."
    Skill
SkFlying -> Text
capSkillName Text -> Text -> Text
<+>
      Text
"is the degree of avoidance of bad effects of any hazards spread on the ground."
    Skill
SkHurtMelee -> Text
capSkillName Text -> 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."
    Skill
SkArmorMelee -> Text
capSkillName Text -> 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."
    Skill
SkArmorRanged -> Text
capSkillName Text -> 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."
    Skill
SkMaxHP -> Text
capSkillName Text -> 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."
    Skill
SkMaxCalm -> Text
capSkillName Text -> 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."
    Skill
SkSpeed -> Text
capSkillName Text -> 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."
    Skill
SkSight -> Text
capSkillName Text -> 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."
    Skill
SkSmell -> Text
capSkillName Text -> 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."
    Skill
SkShine -> Text
capSkillName Text -> 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."
    Skill
SkNocto -> Text
capSkillName Text -> 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."
    Skill
SkHearing -> Text
capSkillName Text -> 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."
    Skill
SkAggression -> Text
"The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' property" Text -> Text -> Text
<+>
      Text
"represents the willingness of the actor to engage in combat, especially close quarters, and conversely, to break engagement when overpowered."
    Skill
SkOdor -> Text
"The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' property" Text -> 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."
    Skill
SkDeflectRanged -> Text
"The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' property" Text -> Text -> Text
<+>
      Text
"tells whether complete invulnerability to ranged attacks, piercing and of every other kind, is effective, and from how many sources."
    Skill
SkDeflectMelee -> Text
"The '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
skName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' property" Text -> 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 Actor
b Int
t =
  let tshow200 :: a -> Text
tshow200 a
n = let n200 :: a
n200 = a -> a -> a
forall a. Ord a => a -> a -> a
min a
200 (a -> a) -> a -> a
forall a b. (a -> b) -> a -> b
$ a -> a -> a
forall a. Ord a => a -> a -> a
max (-a
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 Text
"$" else Text
""
      -- Some values can be negative, for others 0 is equivalent but shorter.
      tshowRadius :: a -> Text
tshowRadius a
r = case a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare a
r a
0 of
                        Ordering
GT -> a -> Text
forall a. Show a => a -> Text
tshow (a
r a -> a -> a
forall a. Num a => a -> a -> a
- a
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".5m"
                        Ordering
EQ -> Text
"0m"
                        Ordering
LT -> a -> Text
forall a. Show a => a -> Text
tshow (a
r a -> a -> a
forall a. Num a => a -> a -> a
+ a
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
".5m"
  in case Skill
skill of
    Skill
SkMove -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkMelee -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkDisplace -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkAlter -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkWait -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkMoveItem -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkProject -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkApply -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkSwimming -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkFlying -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
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
<> Text
"%"
    Skill
SkArmorMelee -> Text
"[" 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
<> Text
"%]"
    Skill
SkArmorRanged -> Text
"{" 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
<> Text
"%}"
    Skill
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 Int
0 Int
t
    Skill
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 Int
0 Int
t
    Skill
SkSpeed -> String -> Text
T.pack (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Int -> String
displaySpeed Int
t
    Skill
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 Int
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 Text
""
             else Text
"(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
<> Text
")"
    Skill
SkSmell -> Int -> Text
forall {a}. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    Skill
SkShine -> Int -> Text
forall {a}. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    Skill
SkNocto -> Int -> Text
forall {a}. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    Skill
SkHearing -> Int -> Text
forall {a}. (Ord a, Num a, Show a) => a -> Text
tshowRadius Int
t
    Skill
SkAggression -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkOdor -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkDeflectRanged -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t
    Skill
SkDeflectMelee -> Int -> Text
forall a. Show a => a -> Text
tshow Int
t

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

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

aspectToSentence :: Aspect -> Maybe Text
aspectToSentence :: Aspect -> Maybe Text
aspectToSentence Aspect
feat =
  case Aspect
feat of
    Timeout{} -> Maybe Text
forall a. Maybe a
Nothing
    AddSkill{} -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Fragile -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Lobable -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Durable -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Equipable -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Benign -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"It affects the opponent in a benign way."
    SetFlag Flag
Precious -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"It seems precious."
    SetFlag Flag
Blast -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Condition -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Unique -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"It is one of a kind."
    SetFlag Flag
MetaGame -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"It's so characteristic that it's recognizable every time after being identified once, even under very different circumstances."
    SetFlag Flag
MinorEffects -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
MinorAspects -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
Meleeable -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
"It is considered for melee strikes."
    SetFlag Flag
Periodic -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
UnderRanged -> Maybe Text
forall a. Maybe a
Nothing
    SetFlag Flag
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 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 Text
"Individual specimens sometimes have yet other properties."

affixBonus :: Int -> Text
affixBonus :: Int -> Text
affixBonus Int
p = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare Int
p Int
0 of
  Ordering
EQ -> Text
"0"
  Ordering
LT -> Int -> Text
forall a. Show a => a -> Text
tshow Int
p
  Ordering
GT -> Text
"+" 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 Text
"" = Text
""
wrapInParens Text
t = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"

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

affixDice :: Dice.Dice -> Text
affixDice :: Dice -> Text
affixDice Dice
d = Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"+?" 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 c) -> Part
carAWs (Int
k, GroupName c
grp) = Int -> Part -> Part
MU.CarAWs Int
k (Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ GroupName c -> Text
forall c. GroupName c -> Text
displayGroupName GroupName c
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 {c}. (Int, GroupName c) -> Part
carAWs

describeToolsAlternative :: [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative :: [[(Int, GroupName ItemKind)]] -> Text
describeToolsAlternative [[(Int, GroupName ItemKind)]]
grps =
  Text -> [Text] -> Text
T.intercalate Text
" 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 (\[(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 [(Int, GroupName ItemKind)]
tools [(Int, GroupName ItemKind)]
raw Effect
eff =
  let unCreate :: Effect -> [(Int, GroupName ItemKind)]
unCreate (CreateItem (Just Int
k) CStore
_ GroupName ItemKind
grp TimerDice
_) = [(Int
k, GroupName ItemKind
grp)]
      unCreate (SeqEffect [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 Effect
_ = []
      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
$
        Part
"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 [Part
"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 [Part
"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 [Part
"using", [(Int, GroupName ItemKind)] -> Part
describeTools [(Int, GroupName ItemKind)]
tools]
  in (Text
tcraft, Text
traw, Text
ttools)