-- | Descriptions of items.
module Game.LambdaHack.Client.UI.ItemDescription
  ( partItem, partItemShort, partItemShortest, partItemHigh
  , partItemWsDetail, partItemWs, partItemWsShortest, partItemWsShort
  , partItemWsLong, partItemWsRanged
  , partItemShortAW, partItemMediumAW, partItemShortWownW
  , viewItem, itemDesc
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , partItemN, textAllPowers
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import           Data.Char (isAlpha, isAlphaNum)
import qualified Data.EnumMap.Strict as EM
import qualified Data.Text as T
import qualified NLP.Miniutter.English as MU

import           Game.LambdaHack.Client.UI.EffectDescription
import           Game.LambdaHack.Client.UI.Overlay
import           Game.LambdaHack.Common.Faction
import           Game.LambdaHack.Common.Item
import qualified Game.LambdaHack.Common.ItemAspect as IA
import           Game.LambdaHack.Common.Misc
import           Game.LambdaHack.Common.Time
import           Game.LambdaHack.Common.Types
import qualified Game.LambdaHack.Content.ItemKind as IK
import qualified Game.LambdaHack.Core.Dice as Dice
import qualified Game.LambdaHack.Definition.Ability as Ability
import qualified Game.LambdaHack.Definition.Color as Color
import           Game.LambdaHack.Definition.Defs
import           Game.LambdaHack.Definition.Flavour

partItemN :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel -> Int
          -> Time -> ItemFull -> ItemQuant
          -> (MU.Part, MU.Part)
partItemN :: Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemN width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD ranged :: Bool
ranged detailLevel :: DetailLevel
detailLevel maxWordsToShow :: Int
maxWordsToShow localTime :: Time
localTime
          itemFull :: ItemFull
itemFull kit :: ItemQuant
kit =
  let (_, r2 :: Part
r2, r3 :: Part
r3) =
        Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> ([Text], Part, Part)
partItemN3 Int
width FactionId
side FactionDict
factionD Bool
ranged DetailLevel
detailLevel Int
maxWordsToShow
                   Time
localTime ItemFull
itemFull ItemQuant
kit
  in (Part
r2, Part
r3)

-- | The part of speech describing the item parameterized by the number
-- of effects/aspects to show.
partItemN3 :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel -> Int
           -> Time -> ItemFull -> ItemQuant
           -> ([Text], MU.Part, MU.Part)
partItemN3 :: Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> ([Text], Part, Part)
partItemN3 width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD ranged :: Bool
ranged detailLevel :: DetailLevel
detailLevel maxWordsToShow :: Int
maxWordsToShow localTime :: Time
localTime
           itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: ItemFull -> Item
itemBase :: Item
itemBase, ItemKind
itemKind :: ItemFull -> ItemKind
itemKind :: ItemKind
itemKind, Bool
itemSuspect :: ItemFull -> Bool
itemSuspect :: Bool
itemSuspect}
           (itemK :: Int
itemK, itemTimers :: ItemTimers
itemTimers) =
  let flav :: Text
flav = Flavour -> Text
flavourToName (Flavour -> Text) -> Flavour -> Text
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour Item
itemBase
      arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      timeout :: Int
timeout = AspectRecord -> Int
IA.aTimeout AspectRecord
arItem
      temporary :: Bool
temporary = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem
                  Bool -> Bool -> Bool
&& Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
      lenCh :: Int
lenCh = Int
itemK Int -> Int -> Int
forall a. Num a => a -> a -> a
- Time -> ItemQuant -> Int
ncharges Time
localTime (Int
itemK, ItemTimers
itemTimers)
      charges :: Text
charges | Bool
temporary = case ItemTimers
itemTimers of
                  [] -> if Int
lenCh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                        then ""
                        else [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ "partItemN3: charges with null timer"
                                     [Char] -> (FactionId, ItemFull, Int, ItemTimers) -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure`
                                     (FactionId
side, ItemFull
itemFull, Int
itemK, ItemTimers
itemTimers)
                  t :: ItemTimer
t : _ -> if Int
lenCh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                           then "(ready to expire)"
                           else let total :: Delta Time
total = Time -> ItemTimer -> Delta Time
deltaOfItemTimer Time
localTime ItemTimer
t
                                in "for" Text -> Text -> Text
<+> Delta Time -> Text
timeDeltaInSecondsText Delta Time
total
              | Int
lenCh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
              | Int
itemK Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 Bool -> Bool -> Bool
&& Int
lenCh Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 = "(charging)"
              | Int
itemK Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
lenCh = "(all charging)"
              | Bool
otherwise = "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
lenCh Text -> Text -> Text
<+> "charging)"
      skipRecharging :: Bool
skipRecharging = DetailLevel
detailLevel DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
<= DetailLevel
DetailLow Bool -> Bool -> Bool
&& Int
lenCh Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
itemK
      (orTs :: [Text]
orTs, powerTs :: [Text]
powerTs, rangedDamage :: [Text]
rangedDamage) =
        Int -> DetailLevel -> Bool -> ItemFull -> ([Text], [Text], [Text])
textAllPowers Int
width DetailLevel
detailLevel Bool
skipRecharging ItemFull
itemFull
      lsource :: [Text]
lsource = case Item -> Maybe FactionId
jfid Item
itemBase of
        Just fid :: FactionId
fid | ItemKind -> Text
IK.iname ItemKind
itemKind Text -> [Text] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` ["impressed"] ->
          ["by" Text -> Text -> Text
<+> if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side
                    then "us"
                    else Faction -> Text
gname (FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid)]
        _ -> []
      powerTsBeginsWithAlphaOrNum :: Bool
powerTsBeginsWithAlphaOrNum = case (Text -> [Char]) -> [Text] -> [[Char]]
forall a b. (a -> b) -> [a] -> [b]
map Text -> [Char]
T.unpack [Text]
powerTs of
        (c :: Char
c : _) : _ -> Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAlphaNum Char
c
        _ -> Bool
False
      -- Ranged damage displayed even if lack of space, to prevent confusion
      -- and ... when only ranged damage is missing from the description.
      displayPowers :: Bool
displayPowers = Int
maxWordsToShow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1
                      Bool -> Bool -> Bool
|| Bool
powerTsBeginsWithAlphaOrNum Bool -> Bool -> Bool
&& [Text] -> Int
forall a. [a] -> Int
length [Text]
powerTs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1
      ts :: [Text]
ts = [Text]
lsource
           [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (if Bool
displayPowers
               then Int -> [Text] -> [Text]
forall a. Int -> [a] -> [a]
take Int
maxWordsToShow [Text]
powerTs
               else [])
           [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ ["(...)" | Bool
displayPowers Bool -> Bool -> Bool
&& [Text] -> Int
forall a. [a] -> Int
length [Text]
powerTs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxWordsToShow]
           [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (if Bool
displayPowers Bool -> Bool -> Bool
&& Bool
ranged then [Text]
rangedDamage else [])
           [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
charges | Int
maxWordsToShow Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1]
      name :: Text
name | Bool
temporary =
             let adj :: Text
adj = if Int
timeout Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 then "temporarily" else "impermanent"
             in Text
adj Text -> Text -> Text
<+> ItemKind -> Text
IK.iname ItemKind
itemKind
           | Bool
itemSuspect = Text
flav Text -> Text -> Text
<+> ItemKind -> Text
IK.iname ItemKind
itemKind
           | Bool
otherwise = ItemKind -> Text
IK.iname ItemKind
itemKind
  in ([Text]
orTs, Text -> Part
MU.Text Text
name, if Bool
displayPowers
                          then [Part] -> Part
MU.Phrase ([Part] -> Part) -> [Part] -> Part
forall a b. (a -> b) -> a -> b
$ (Text -> Part) -> [Text] -> [Part]
forall a b. (a -> b) -> [a] -> [b]
map Text -> Part
MU.Text [Text]
ts
                          else Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ AspectRecord -> Text
IA.aELabel AspectRecord
arItem)

-- TODO: simplify the code a lot
textAllPowers :: Int -> DetailLevel -> Bool -> ItemFull
              -> ([Text], [Text], [Text])
textAllPowers :: Int -> DetailLevel -> Bool -> ItemFull -> ([Text], [Text], [Text])
textAllPowers width :: Int
width detailLevel :: DetailLevel
detailLevel skipRecharging :: Bool
skipRecharging
              itemFull :: ItemFull
itemFull@ItemFull{ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind, ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco :: ItemDisco
itemDisco} =
  let arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      -- To handle both the cases of item identified and not, we represent
      -- aspects as a list with dice, not a record of integers as in @arItem@.
      -- If item fully known, the dice will be trivial and will display
      -- the same as integers would, so nothing is lost.
      -- If item not known fully and timeouts or any crucial flags
      -- are under @Odds@, they are ignored, so they should be avoided
      -- under @Odds@ in not fully-identified items.
      aspectsFull :: [Aspect]
aspectsFull = case ItemDisco
itemDisco of
        ItemDiscoMean IA.KindMean{..} | Bool
kmConst ->
          AspectRecord -> [Aspect]
IA.aspectRecordToList AspectRecord
kmMean  -- exact and collated
        ItemDiscoMean{} -> ItemKind -> [Aspect]
IK.iaspects ItemKind
itemKind
          -- doesn't completely lose the @Odds@ case, so better than
          -- the above, even if does not collate multiple skill bonuses
        ItemDiscoFull iAspect :: AspectRecord
iAspect -> AspectRecord -> [Aspect]
IA.aspectRecordToList AspectRecord
iAspect
      mtimeout :: Maybe Aspect
mtimeout = (Aspect -> Bool) -> [Aspect] -> Maybe Aspect
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Aspect -> Bool
IK.timeoutAspect [Aspect]
aspectsFull
      elab :: Text
elab = AspectRecord -> Text
IA.aELabel AspectRecord
arItem
      periodic :: Bool
periodic = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
      hurtMeleeAspect :: IK.Aspect -> Bool
      hurtMeleeAspect :: Aspect -> Bool
hurtMeleeAspect (IK.AddSkill Ability.SkHurtMelee _) = Bool
True
      hurtMeleeAspect _ = Bool
False
      active :: Bool
active = AspectRecord -> Bool
IA.goesIntoEqp AspectRecord
arItem
      splitA :: DetailLevel -> [IK.Aspect] -> ([Text], [Text])
      splitA :: DetailLevel -> [Aspect] -> ([Text], [Text])
splitA detLev :: DetailLevel
detLev aspects :: [Aspect]
aspects =
        let ppA :: Aspect -> Text
ppA = Aspect -> Text
kindAspectToSuffix
            ppE :: Effect -> Text
ppE = DetailLevel -> Effect -> Text
effectToSuffix DetailLevel
detLev
            reduce_a :: Dice -> Text
reduce_a = Text -> (Int -> Text) -> Maybe Int -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe "?" Int -> Text
forall a. Show a => a -> Text
tshow (Maybe Int -> Text) -> (Dice -> Maybe Int) -> Dice -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dice -> Maybe Int
Dice.reduceDice
            restEs :: [Effect]
restEs | DetailLevel
detLev DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailHigh
                     Bool -> Bool -> Bool
|| Bool -> Bool
not (Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.MinorEffects AspectRecord
arItem) =
                     ItemKind -> [Effect]
IK.ieffects ItemKind
itemKind
                   | Bool
otherwise = []
            (smashEffs :: [Effect]
smashEffs, noSmashEffs :: [Effect]
noSmashEffs) = (Effect -> Bool) -> [Effect] -> ([Effect], [Effect])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Effect -> Bool
IK.onSmashEffect [Effect]
restEs
            unSmash :: Effect -> Effect
unSmash (IK.OnSmash eff :: Effect
eff) = Effect
eff
            unSmash eff :: Effect
eff = Effect
eff
            onSmashTs :: Text
onSmashTs = Text -> [Text] -> Text
T.intercalate " " ([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 (Effect -> Text
ppE (Effect -> Text) -> (Effect -> Effect) -> Effect -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect -> Effect
unSmash) [Effect]
smashEffs
            unCombine :: Effect -> Effect
unCombine (IK.OnCombine eff :: Effect
eff) = Effect
eff
            unCombine eff :: Effect
eff = Effect
eff
            (combineEffsRaw :: [Effect]
combineEffsRaw, noSmashCombineEffsRaw :: [Effect]
noSmashCombineEffsRaw) =
              (Effect -> Bool) -> [Effect] -> ([Effect], [Effect])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Effect -> Bool
IK.onCombineEffect [Effect]
noSmashEffs
            onCombineRawTs :: Text
onCombineRawTs = Text -> [Text] -> Text
T.intercalate " " ([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 (Effect -> Text
ppE (Effect -> Text) -> (Effect -> Effect) -> Effect -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect -> Effect
unCombine) [Effect]
combineEffsRaw
            onCombineRawTsTooLarge :: Bool
onCombineRawTsTooLarge =
              DetailLevel
detailLevel DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailAll Bool -> Bool -> Bool
&& Text -> Int
T.length Text
onCombineRawTs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 120
            (combineEffs :: [Effect]
combineEffs, noSmashCombineEffs :: [Effect]
noSmashCombineEffs) =
              if Bool
onCombineRawTsTooLarge
              then ([Effect]
combineEffsRaw, [Effect]
noSmashCombineEffsRaw)
              else ([], [Effect]
noSmashEffs)
            unOr :: Effect -> [Effect]
unOr (IK.OrEffect eff1 :: Effect
eff1 eff2 :: Effect
eff2) = Effect -> [Effect]
unOr Effect
eff1 [Effect] -> [Effect] -> [Effect]
forall a. [a] -> [a] -> [a]
++ Effect -> [Effect]
unOr Effect
eff2
            unOr eff :: Effect
eff = [Effect
eff]
            ppAnd :: Effect -> Text
ppAnd (IK.AndEffect (IK.ConsumeItems tools :: [(Int, GroupName ItemKind)]
tools raw :: [(Int, GroupName ItemKind)]
raw) eff :: Effect
eff) =
              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 if Text -> Int
T.length Text
tcraft Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
traw Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Text -> Int
T.length Text
ttools
                    Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
width Int -> Int -> Int
forall a. Num a => a -> a -> a
- 4
                 then Text
tcraft Text -> Text -> Text
<+> Text
traw Text -> Text -> Text
<+> Text
ttools
                 else Text
tcraft Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n---" Text -> Text -> Text
<+> Text
traw Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "\n---" Text -> Text -> Text
<+> Text
ttools
            ppAnd eff :: Effect
eff = Effect -> Text
ppE Effect
eff
            ppOr :: Effect -> Text
ppOr eff :: Effect
eff = "*" Text -> Text -> Text
<+> Text -> [Text] -> Text
T.intercalate "\n* "
                               ([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 Effect -> Text
ppAnd ([Effect] -> [Text]) -> [Effect] -> [Text]
forall a b. (a -> b) -> a -> b
$ Effect -> [Effect]
unOr Effect
eff)
            onCombineTs :: [Text]
onCombineTs =
              (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 Effect -> Text
ppOr ([Effect] -> [Text]) -> [Effect] -> [Text]
forall a b. (a -> b) -> a -> b
$ (Effect -> Effect) -> [Effect] -> [Effect]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Effect
unCombine [Effect]
combineEffs
            rechargingTs :: Text
rechargingTs = Text -> [Text] -> Text
T.intercalate " "
                           ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Text
damageText | ItemKind -> Dice
IK.idamage ItemKind
itemKind Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
/= 0]
                             [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (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)
                                       ((Effect -> Text) -> [Effect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Text
ppE [Effect]
noSmashCombineEffs)
            fragile :: Bool
fragile = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Fragile AspectRecord
arItem
            periodicText :: Text
periodicText =
              if Bool
periodic Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
skipRecharging Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
rechargingTs)
              then case (Maybe Aspect
mtimeout, Bool
fragile) of
                     (Nothing, True) ->
                       "(each turn until gone:" Text -> Text -> Text
<+> Text
rechargingTs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                     (Nothing, False) ->
                       "(each turn:" Text -> Text -> Text
<+> Text
rechargingTs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                         -- timeout 0, so it just fires each turn and it's not
                         -- fragile, so a copy is not destroyed each turn
                     (Just (IK.Timeout t :: Dice
t), True) ->
                       "(every" Text -> Text -> Text
<+> Dice -> Text
reduce_a Dice
t Text -> Text -> Text
<+> "until gone:"
                       Text -> Text -> Text
<+> Text
rechargingTs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                     (Just (IK.Timeout t :: Dice
t), False) ->
                       "(every" Text -> Text -> Text
<+> Dice -> Text
reduce_a Dice
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ":" Text -> Text -> Text
<+> Text
rechargingTs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                     _ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ "" [Char] -> Maybe Aspect -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Maybe Aspect
mtimeout
              else ""
            ppERestEs :: [Text]
ppERestEs = if Bool
periodic
                        then [Text
periodicText]
                        else (Effect -> Text) -> [Effect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Effect -> Text
ppE [Effect]
noSmashCombineEffs
            aes :: [Text]
aes = if Bool
active
                  then (Aspect -> Text) -> [Aspect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Aspect -> Text
ppA [Aspect]
aspects [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
ppERestEs
                  else [Text]
ppERestEs [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Aspect -> Text) -> [Aspect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Aspect -> Text
ppA [Aspect]
aspects
            onSmash :: Text
onSmash = if Text -> Bool
T.null Text
onSmashTs then ""
                      else "(on smash:" Text -> Text -> Text
<+> Text
onSmashTs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
            onCombine :: Text
onCombine = if [Effect] -> Bool
forall a. [a] -> Bool
null [Effect]
combineEffs Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
onCombineRawTs)
                        then "(on combine:" Text -> Text -> Text
<+> Text
onCombineRawTs Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                        else ""
            -- Either exact value or dice of @SkHurtMelee@ needed,
            -- never the average, so @arItem@ not consulted directly.
            -- If item not known fully and @SkHurtMelee@ under @Odds@,
            -- it's ignored.
            damageText :: Text
damageText = case (Aspect -> Bool) -> [Aspect] -> Maybe Aspect
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find Aspect -> Bool
hurtMeleeAspect [Aspect]
aspects of
              Just (IK.AddSkill Ability.SkHurtMelee hurtMelee :: Dice
hurtMelee) ->
                (if ItemKind -> Dice
IK.idamage ItemKind
itemKind Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                 then "0d0"
                 else Dice -> Text
forall a. Show a => a -> Text
tshow (ItemKind -> Dice
IK.idamage ItemKind
itemKind))
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Dice -> Text
affixDice Dice
hurtMelee Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
              _ -> if ItemKind -> Dice
IK.idamage ItemKind
itemKind Dice -> Dice -> Bool
forall a. Eq a => a -> a -> Bool
== 0
                   then ""
                   else Dice -> Text
forall a. Show a => a -> Text
tshow (ItemKind -> Dice
IK.idamage ItemKind
itemKind)
            timeoutText :: Text
timeoutText = case Maybe Aspect
mtimeout of
              Nothing -> ""
              Just (IK.Timeout t :: Dice
t) -> "(cooldown" Text -> Text -> Text
<+> Dice -> Text
reduce_a Dice
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                                       -- timeout is called "cooldown" in UI
              _ -> [Char] -> Text
forall a. HasCallStack => [Char] -> a
error ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ "" [Char] -> Maybe Aspect -> [Char]
forall v. Show v => [Char] -> v -> [Char]
`showFailure` Maybe Aspect
mtimeout
       in ( [Text]
onCombineTs
          , [Text
damageText]
            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text
timeoutText | DetailLevel
detLev DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
> DetailLevel
DetailLow Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
periodic]
            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ [Text]
aes
            [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ if DetailLevel
detLev DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailAll
               then [Text
onCombine, Text
onSmash]
               else [Text
onCombineRawTs] )
      hurtMult :: Int
hurtMult = Bool -> Skills -> Skills -> Int
armorHurtCalculation Bool
True (AspectRecord -> Skills
IA.aSkills AspectRecord
arItem)
                                           Skills
Ability.zeroSkills
      dmg :: Double
dmg = Dice -> Double
Dice.meanDice (Dice -> Double) -> Dice -> Double
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.idamage ItemKind
itemKind
      rawDeltaHP :: Int64
rawDeltaHP = Double -> Int64
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int64) -> Double -> Int64
forall a b. (a -> b) -> a -> b
$ Int -> Double
intToDouble Int
hurtMult Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
xD Double
dmg Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 100
      IK.ThrowMod{Int
throwVelocity :: ThrowMod -> Int
throwVelocity :: Int
IK.throwVelocity} = AspectRecord -> ThrowMod
IA.aToThrow AspectRecord
arItem
      speed :: Speed
speed = Int -> Int -> Speed
speedFromWeight (ItemKind -> Int
IK.iweight ItemKind
itemKind) Int
throwVelocity
      pdeltaHP :: Int64
pdeltaHP = Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
rawDeltaHP Speed
speed
      rangedDamageDesc :: [Text]
rangedDamageDesc = [ "{avg" Text -> Text -> Text
<+> Int64 -> Text
show64With2 Int64
pdeltaHP Text -> Text -> Text
<+> "ranged}"
                         | Int64
pdeltaHP Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> 0 ]
        -- Note that avg melee damage would be too complex to display here,
        -- because in case of @MOwned@ the owner is different than leader,
        -- so the value would be different than when viewing the item.
      splitTry :: [Aspect] -> ([Text], [Text])
splitTry ass :: [Aspect]
ass =
        let splits :: [([Text], [Text])]
splits = (DetailLevel -> ([Text], [Text]))
-> [DetailLevel] -> [([Text], [Text])]
forall a b. (a -> b) -> [a] -> [b]
map (DetailLevel -> [Aspect] -> ([Text], [Text])
`splitA` [Aspect]
ass) [DetailLevel
forall a. Bounded a => a
minBound..DetailLevel
forall a. Bounded a => a
maxBound]
            splitsToTry :: [([Text], [Text])]
splitsToTry = Int -> [([Text], [Text])] -> [([Text], [Text])]
forall a. Int -> [a] -> [a]
drop (DetailLevel -> Int
forall a. Enum a => a -> Int
fromEnum DetailLevel
detailLevel) [([Text], [Text])]
splits
            splitsValid :: [([Text], [Text])]
splitsValid | Text -> Bool
T.null Text
elab = (([Text], [Text]) -> Bool)
-> [([Text], [Text])] -> [([Text], [Text])]
forall a. (a -> Bool) -> [a] -> [a]
filter (([Text], [Text]) -> ([Text], [Text]) -> Bool
forall a. Eq a => a -> a -> Bool
/= ([], [])) [([Text], [Text])]
splitsToTry
                        | Bool
otherwise = [([Text], [Text])]
splitsToTry
        in case [([Text], [Text])]
splitsValid of
          (onCombineTsSplit :: [Text]
onCombineTsSplit, tsSplit :: [Text]
tsSplit) : _ -> ([Text]
onCombineTsSplit, [Text]
tsSplit)
          [] -> ([], [])
      (onCombineTsAss :: [Text]
onCombineTsAss, aspectDescs :: [Text]
aspectDescs) =
        let aMain :: Aspect -> Bool
aMain IK.AddSkill{} = Bool
True
            aMain _ = Bool
False
            (aspectsMain :: [Aspect]
aspectsMain, aspectsAux :: [Aspect]
aspectsAux) = (Aspect -> Bool) -> [Aspect] -> ([Aspect], [Aspect])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition Aspect -> Bool
aMain [Aspect]
aspectsFull
            (onCombineTsSplit :: [Text]
onCombineTsSplit, tsSplit :: [Text]
tsSplit) = [Aspect] -> ([Text], [Text])
splitTry [Aspect]
aspectsMain
        in ( [Text]
onCombineTsSplit
           , (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
$ Text
elab
               Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
tsSplit
               [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ if DetailLevel
detailLevel DetailLevel -> DetailLevel -> Bool
forall a. Ord a => a -> a -> Bool
>= DetailLevel
DetailAll
                  then (Aspect -> Text) -> [Aspect] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Aspect -> Text
kindAspectToSuffix [Aspect]
aspectsAux
                  else [] )
  in ([Text]
onCombineTsAss, [Text]
aspectDescs, [Text]
rangedDamageDesc)

-- | The part of speech describing the item.
partItem :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant
         -> (MU.Part, MU.Part)
partItem :: Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItem width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemN Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailMedium 4

partItemShort :: Int -> FactionId -> FactionDict -> Time -> ItemFull
              -> ItemQuant
              -> (MU.Part, MU.Part)
partItemShort :: Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemN Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailLow 4

partItemShortest :: Int -> FactionId -> FactionDict -> Time -> ItemFull
                 -> ItemQuant
                 -> (MU.Part, MU.Part)
partItemShortest :: Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShortest width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemN Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailLow 1

partItemHigh :: Int -> FactionId -> FactionDict -> Time -> ItemFull -> ItemQuant
             -> ([Text], MU.Part, MU.Part)
partItemHigh :: Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> ([Text], Part, Part)
partItemHigh width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> ([Text], Part, Part)
partItemN3 Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailAll 100

-- The @count@ can be different than @itemK@ in @ItemFull@, e.g., when picking
-- a subset of items to drop.
partItemWsRanged :: Int -> FactionId -> FactionDict -> Bool -> DetailLevel
                 -> Int -> Int -> Time -> ItemFull -> ItemQuant
                 -> MU.Part
partItemWsRanged :: Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD ranged :: Bool
ranged detail :: DetailLevel
detail
                 maxWordsToShow :: Int
maxWordsToShow count :: Int
count localTime :: Time
localTime itemFull :: ItemFull
itemFull kit :: ItemQuant
kit =
  let (name :: Part
name, powers :: Part
powers) = Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemN Int
width FactionId
side FactionDict
factionD Bool
ranged DetailLevel
detail
                                 Int
maxWordsToShow Time
localTime ItemFull
itemFull ItemQuant
kit
      arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      periodic :: Bool
periodic = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Periodic AspectRecord
arItem
      condition :: Bool
condition = Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
      maxCount :: Int
maxCount = Dice -> Int
Dice.supDice (Dice -> Int) -> Dice -> Int
forall a b. (a -> b) -> a -> b
$ ItemKind -> Dice
IK.icount (ItemKind -> Dice) -> ItemKind -> Dice
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull
  in if | Bool
condition Bool -> Bool -> Bool
&& Int
count Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 1 -> [Part] -> Part
MU.Phrase [Part
name, Part
powers]
        | Bool
condition Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
periodic Bool -> Bool -> Bool
&& Int
maxCount Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1 ->
            let percent :: Int
percent = 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
count Int -> Int -> Int
forall a. Integral a => a -> a -> a
`divUp` Int
maxCount
                amount :: Text
amount = Int -> Text
forall a. Show a => a -> Text
tshow Int
count Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-strong"
                         Text -> Text -> Text
<+> "(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
percent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%)"
            in [Part] -> Part
MU.Phrase [Text -> Part
MU.Text Text
amount, Part
name, Part
powers]
        | Bool
condition ->
            [Part] -> Part
MU.Phrase [Text -> Part
MU.Text (Text -> Part) -> Text -> Part
forall a b. (a -> b) -> a -> b
$ Int -> Text
forall a. Show a => a -> Text
tshow Int
count Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "-fold", Part
name, Part
powers]
        | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem -> case Int
count of
            0 -> [Part] -> Part
MU.Phrase ["none of", Part
name, Part
powers]
            1 -> [Part] -> Part
MU.Phrase [Part
name, Part
powers]
            _ -> [Part] -> Part
MU.Phrase [Int -> Part
MU.Car Int
count, "of", Part -> Part
MU.Ws Part
name, Part
powers]
        | Bool
otherwise -> [Part] -> Part
MU.Phrase [Int -> Part -> Part
MU.CarAWs Int
count Part
name, Part
powers]

partItemWsDetail :: DetailLevel
                 -> Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull
                 -> ItemQuant
                 -> MU.Part
partItemWsDetail :: DetailLevel
-> Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsDetail DetailLow = \_ _ _ _ _ _ _ -> ""
partItemWsDetail DetailMedium = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsShortest
partItemWsDetail DetailHigh = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs
partItemWsDetail DetailAll = Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsLong

partItemWs :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull
           -> ItemQuant
           -> MU.Part
partItemWs :: Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWs width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailMedium 4

partItemWsShortest :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull
                   -> ItemQuant
                   -> MU.Part
partItemWsShortest :: Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsShortest width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailLow 1

partItemWsShort :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull
                -> ItemQuant
                -> MU.Part
partItemWsShort :: Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsShort width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailLow 4

partItemWsLong :: Int -> FactionId -> FactionDict -> Int -> Time -> ItemFull
               -> ItemQuant
               -> MU.Part
partItemWsLong :: Int
-> FactionId
-> FactionDict
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsLong width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD =
  Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemWsRanged Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailHigh 100

partItemShortAW :: Int -> FactionId -> FactionDict -> Time -> ItemFull
                -> ItemQuant
                -> MU.Part
partItemShortAW :: Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortAW width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD localTime :: Time
localTime itemFull :: ItemFull
itemFull kit :: ItemQuant
kit =
  let (name :: Part
name, _) = Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort Int
width FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
      arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
  in if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem then Part
name else Part -> Part
MU.AW Part
name

partItemMediumAW :: Int -> FactionId -> FactionDict -> Time -> ItemFull
                 -> ItemQuant
                 -> MU.Part
partItemMediumAW :: Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemMediumAW width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD localTime :: Time
localTime itemFull :: ItemFull
itemFull kit :: ItemQuant
kit =
  let (name :: Part
name, powers :: Part
powers) =
        Int
-> FactionId
-> FactionDict
-> Bool
-> DetailLevel
-> Int
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemN Int
width FactionId
side FactionDict
factionD Bool
False DetailLevel
DetailMedium 100 Time
localTime
                  ItemFull
itemFull ItemQuant
kit
      arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      phrase :: Part
phrase = [Part] -> Part
MU.Phrase [Part
name, Part
powers]
  in if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem then Part
phrase else Part -> Part
MU.AW Part
phrase

partItemShortWownW :: Int -> FactionId -> FactionDict -> MU.Part -> Time
                   -> ItemFull -> ItemQuant
                   -> MU.Part
partItemShortWownW :: Int
-> FactionId
-> FactionDict
-> Part
-> Time
-> ItemFull
-> ItemQuant
-> Part
partItemShortWownW width :: Int
width side :: FactionId
side factionD :: FactionDict
factionD partA :: Part
partA localTime :: Time
localTime itemFull :: ItemFull
itemFull kit :: ItemQuant
kit =
  let (name :: Part
name, _) = Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> (Part, Part)
partItemShort Int
width FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
  in Part -> Part -> Part
MU.WownW Part
partA Part
name

viewItem :: ItemFull -> Color.AttrCharW32
{-# INLINE viewItem #-}
viewItem :: ItemFull -> AttrCharW32
viewItem itemFull :: ItemFull
itemFull =
  Color -> Char -> AttrCharW32
Color.attrChar2ToW32 (Flavour -> Color
flavourToColor (Flavour -> Color) -> Flavour -> Color
forall a b. (a -> b) -> a -> b
$ Item -> Flavour
jflavour (Item -> Flavour) -> Item -> Flavour
forall a b. (a -> b) -> a -> b
$ ItemFull -> Item
itemBase ItemFull
itemFull)
                       (ItemKind -> Char
IK.isymbol (ItemKind -> Char) -> ItemKind -> Char
forall a b. (a -> b) -> a -> b
$ ItemFull -> ItemKind
itemKind ItemFull
itemFull)

itemDesc :: Int -> Bool -> FactionId -> FactionDict -> Int -> CStore -> Time
         -> LevelId -> ItemFull -> ItemQuant
         -> AttrString
itemDesc :: Int
-> Bool
-> FactionId
-> FactionDict
-> Int
-> CStore
-> Time
-> LevelId
-> ItemFull
-> ItemQuant
-> AttrString
itemDesc width :: Int
width markParagraphs :: Bool
markParagraphs side :: FactionId
side factionD :: FactionDict
factionD aHurtMeleeOfOwner :: Int
aHurtMeleeOfOwner store :: CStore
store localTime :: Time
localTime
         jlid :: LevelId
jlid itemFull :: ItemFull
itemFull@ItemFull{Item
itemBase :: Item
itemBase :: ItemFull -> Item
itemBase, ItemKind
itemKind :: ItemKind
itemKind :: ItemFull -> ItemKind
itemKind, ItemDisco
itemDisco :: ItemDisco
itemDisco :: ItemFull -> ItemDisco
itemDisco, Bool
itemSuspect :: Bool
itemSuspect :: ItemFull -> Bool
itemSuspect}
         kit :: ItemQuant
kit =
  let (orTs :: [Text]
orTs, name :: Part
name, powers :: Part
powers) =
        Int
-> FactionId
-> FactionDict
-> Time
-> ItemFull
-> ItemQuant
-> ([Text], Part, Part)
partItemHigh Int
width FactionId
side FactionDict
factionD Time
localTime ItemFull
itemFull ItemQuant
kit
      arItem :: AspectRecord
arItem = ItemFull -> AspectRecord
aspectRecordFull ItemFull
itemFull
      npowers :: Text
npowers = [Part] -> Text
makePhrase [Part
name, Part
powers]
      IK.ThrowMod{Int
throwVelocity :: Int
throwVelocity :: ThrowMod -> Int
IK.throwVelocity, Int
throwLinger :: ThrowMod -> Int
throwLinger :: Int
IK.throwLinger} = AspectRecord -> ThrowMod
IA.aToThrow AspectRecord
arItem
      speed :: Speed
speed = Int -> Int -> Speed
speedFromWeight (ItemKind -> Int
IK.iweight ItemKind
itemKind) Int
throwVelocity
      range :: Int
range = Speed -> Int -> Int
rangeFromSpeedAndLinger Speed
speed Int
throwLinger
      tspeed :: Text
tspeed | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem
               Bool -> Bool -> Bool
|| ItemKind -> Int
IK.iweight ItemKind
itemKind Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== 0 = ""
             | Speed
speed Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
< Speed
speedLimp = "When thrown, it drops at once."
             | Speed
speed Speed -> Speed -> Bool
forall a. Ord a => a -> a -> Bool
< Speed
speedWalk = "When thrown, it drops after one meter."
             | Bool
otherwise =
               "Can be thrown at"
               Text -> Text -> Text
<+> [Char] -> Text
T.pack (Int -> [Char]
displaySpeed (Int -> [Char]) -> Int -> [Char]
forall a b. (a -> b) -> a -> b
$ Speed -> Int
fromSpeed Speed
speed)
               Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Int
throwLinger Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= 100
                  then " dropping after" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
range Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "m."
                  else "."
      tsuspect :: [Text]
tsuspect = ["You are unsure what it does." | Bool
itemSuspect]
      (desc :: Text
desc, aspectSentences :: Text
aspectSentences, damageAnalysis :: Text
damageAnalysis) =
        let aspects :: [Aspect]
aspects = case ItemDisco
itemDisco of
              ItemDiscoMean IA.KindMean{..} | Bool
kmConst ->
                AspectRecord -> [Aspect]
IA.aspectRecordToList AspectRecord
kmMean  -- exact and collated
              ItemDiscoMean{} -> ItemKind -> [Aspect]
IK.iaspects ItemKind
itemKind
                -- doesn't completely lose the @Odds@ case, so better than
                -- the above, even if does not collate multiple skill bonuses
              ItemDiscoFull iAspect :: AspectRecord
iAspect -> AspectRecord -> [Aspect]
IA.aspectRecordToList AspectRecord
iAspect
            sentences :: [Text]
sentences = [Text]
tsuspect [Text] -> [Text] -> [Text]
forall a. [a] -> [a] -> [a]
++ (Aspect -> Maybe Text) -> [Aspect] -> [Text]
forall a b. (a -> Maybe b) -> [a] -> [b]
mapMaybe Aspect -> Maybe Text
aspectToSentence [Aspect]
aspects
            aHurtMeleeOfItem :: Int
aHurtMeleeOfItem = Skill -> AspectRecord -> Int
IA.getSkill Skill
Ability.SkHurtMelee AspectRecord
arItem
            meanDmg :: Int
meanDmg = Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Dice -> Double
Dice.meanDice (ItemKind -> Dice
IK.idamage ItemKind
itemKind)
            dmgAn :: Text
dmgAn = if Int
meanDmg Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then "" else
              let multRaw :: Int
multRaw = Int
aHurtMeleeOfOwner
                            Int -> Int -> Int
forall a. Num a => a -> a -> a
+ if CStore
store CStore -> [CStore] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [CStore
CEqp, CStore
COrgan]
                              then 0
                              else Int
aHurtMeleeOfItem
                  mult :: Int
mult = 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 100 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (-95) Int
multRaw)
                  percentDeltaHP :: Int64
percentDeltaHP = Int -> Int64
xM Int
meanDmg Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`divUp` 100
                  rawDeltaHP :: Int64
rawDeltaHP = Int -> Int64
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast Int
mult Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
percentDeltaHP
                  pmult :: Int
pmult = 100 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int -> Int -> Int
forall a. Ord a => a -> a -> a
min 100 (Int -> Int -> Int
forall a. Ord a => a -> a -> a
max (-95) Int
aHurtMeleeOfItem)
                  prawDeltaHP :: Int64
prawDeltaHP = Int -> Int64
forall a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast Int
pmult Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
percentDeltaHP
                  pdeltaHP :: Int64
pdeltaHP = Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
prawDeltaHP Speed
speed
                  minDeltaHP :: Int64
minDeltaHP = 5 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
percentDeltaHP
                  mDeltaHP :: Int64
mDeltaHP = Int64 -> Speed -> Int64
modifyDamageBySpeed Int64
minDeltaHP Speed
speed
              in
                "Against defenceless foes you'd inflict around"
                  -- rounding and non-id items
                Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
meanDmg
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
mult Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
show64With2 Int64
rawDeltaHP
                Text -> Text -> Text
<+> "melee damage (min" Text -> Text -> Text
<+> Int64 -> Text
show64With2 Int64
minDeltaHP Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")"
                Text -> Text -> Text
<+> (if Int64
pdeltaHP Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
<= 0 then "" else
                       "and"
                       Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow Int
meanDmg
                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow Int
pmult Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "%"
                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "*" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "speed^2"
                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
tshow (Speed -> Int
fromSpeed Speed
speedThrust
                                        Int -> Int -> Int
forall a. Integral a => a -> a -> a
`divUp` 10) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "^2"
                       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int64 -> Text
show64With2 Int64
pdeltaHP
                       Text -> Text -> Text
<+> "ranged damage (min" Text -> Text -> Text
<+> Int64 -> Text
show64With2 Int64
mDeltaHP Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ")")
                Text -> Text -> Text
<+> "with it"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if Dice -> Int
Dice.infDice (ItemKind -> Dice
IK.idamage ItemKind
itemKind)
                      Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Dice -> Int
Dice.supDice (ItemKind -> Dice
IK.idamage ItemKind
itemKind)
                   then "."
                   else "on average."
        in (ItemKind -> Text
IK.idesc ItemKind
itemKind, Text -> [Text] -> Text
T.intercalate " " [Text]
sentences, Text
tspeed Text -> Text -> Text
<+> Text
dmgAn)
      weight :: Int
weight = ItemKind -> Int
IK.iweight ItemKind
itemKind
      (scaledWeight :: Text
scaledWeight, unitWeight :: Part
unitWeight)
        | Int
weight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 1000 =
          (Double -> Text
forall a. Show a => a -> Text
tshow (Double -> Text) -> Double -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Double
intToDouble Int
weight Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ 1000, "kg")
        | Bool
otherwise = (Int -> Text
forall a. Show a => a -> Text
tshow Int
weight, "g")
      onLevel :: Text
onLevel = "on level" Text -> Text -> Text
<+> Int -> Text
forall a. Show a => a -> Text
tshow (Int -> Int
forall a. Num a => a -> a
abs (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ LevelId -> Int
forall a. Enum a => a -> Int
fromEnum LevelId
jlid) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "."
      discoFirst :: Text
discoFirst = (if Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Unique AspectRecord
arItem
                    then "Discovered"
                    else "First seen")
                   Text -> Text -> Text
<+> Text
onLevel
      whose :: FactionId -> Text
whose fid :: FactionId
fid = Faction -> Text
gname (FactionDict
factionD FactionDict -> FactionId -> Faction
forall k a. Enum k => EnumMap k a -> k -> a
EM.! FactionId
fid)
      sourceDesc :: Text
sourceDesc =
        case Item -> Maybe FactionId
jfid Item
itemBase of
          Just fid :: FactionId
fid | Flag -> AspectRecord -> Bool
IA.checkFlag Flag
Ability.Condition AspectRecord
arItem ->
            "Caused by" Text -> Text -> Text
<+> (if FactionId
fid FactionId -> FactionId -> Bool
forall a. Eq a => a -> a -> Bool
== FactionId
side then "us" else FactionId -> Text
whose FactionId
fid)
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ". First observed" Text -> Text -> Text
<+> Text
onLevel
          Just fid :: FactionId
fid ->
            "Coming from" Text -> Text -> Text
<+> FactionId -> Text
whose FactionId
fid
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> "." Text -> Text -> Text
<+> Text
discoFirst
          _ -> Text
discoFirst
      -- Organs are almost always either empty or more than singular,
      -- so the "organs" below is fine. Also, some organs come in pairs
      -- or more, so we don't know the number without much more work,
      -- so @squashedWWandW@ would be out of place. Also, mentioning
      -- two hands and two legs is not that enlightening and the number
      -- is not shown in organ lore, so this should wait until we add
      -- proper hyperlinks both ways instead of relying of names.
      ikitToPart :: [(GroupName a, b)] -> Part
ikitToPart = Text -> Part
MU.Text (Text -> Part)
-> ([(GroupName a, b)] -> Text) -> [(GroupName a, b)] -> Part
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate ", " ([Text] -> Text)
-> ([(GroupName a, b)] -> [Text]) -> [(GroupName a, b)] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((GroupName a, b) -> Text) -> [(GroupName a, b)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (GroupName a -> Text
forall a. GroupName a -> Text
fromGroupName (GroupName a -> Text)
-> ((GroupName a, b) -> GroupName a) -> (GroupName a, b) -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName a, b) -> GroupName a
forall a b. (a, b) -> a
fst)
      (ikitOrganNames :: [(GroupName ItemKind, CStore)]
ikitOrganNames, ikitOtherNames :: [(GroupName ItemKind, CStore)]
ikitOtherNames) =
        ((GroupName ItemKind, CStore) -> Bool)
-> [(GroupName ItemKind, CStore)]
-> ([(GroupName ItemKind, CStore)], [(GroupName ItemKind, CStore)])
forall a. (a -> Bool) -> [a] -> ([a], [a])
partition ((CStore -> CStore -> Bool
forall a. Eq a => a -> a -> Bool
== CStore
COrgan) (CStore -> Bool)
-> ((GroupName ItemKind, CStore) -> CStore)
-> (GroupName ItemKind, CStore)
-> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GroupName ItemKind, CStore) -> CStore
forall a b. (a, b) -> b
snd) ([(GroupName ItemKind, CStore)]
 -> ([(GroupName ItemKind, CStore)],
     [(GroupName ItemKind, CStore)]))
-> [(GroupName ItemKind, CStore)]
-> ([(GroupName ItemKind, CStore)], [(GroupName ItemKind, CStore)])
forall a b. (a -> b) -> a -> b
$ ItemKind -> [(GroupName ItemKind, CStore)]
IK.ikit ItemKind
itemKind
      ikitDesc :: Text
ikitDesc | [(GroupName ItemKind, CStore)] -> Bool
forall a. [a] -> Bool
null [(GroupName ItemKind, CStore)]
ikitOrganNames = ""
               | Bool
otherwise =
        [Part] -> Text
makeSentence
          [ "the actor has organs of this kind:"
          , [(GroupName ItemKind, CStore)] -> Part
forall a b. [(GroupName a, b)] -> Part
ikitToPart [(GroupName ItemKind, CStore)]
ikitOrganNames ]
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> if [(GroupName ItemKind, CStore)] -> Bool
forall a. [a] -> Bool
null [(GroupName ItemKind, CStore)]
ikitOtherNames
           then ""
           else "\n\n"
                Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Part] -> Text
makeSentence
                     [ "the actor starts in possession of the following:"
                     , [(GroupName ItemKind, CStore)] -> Part
forall a b. [(GroupName a, b)] -> Part
ikitToPart [(GroupName ItemKind, CStore)]
ikitOtherNames ]
      colorSymbol :: AttrCharW32
colorSymbol = ItemFull -> AttrCharW32
viewItem ItemFull
itemFull
      blurb :: Text
blurb =
       (((" "
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
npowers
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
markParagraphs then "\n\n" else " ")
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate "\n\n" [Text]
orTs
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
markParagraphs Bool -> Bool -> Bool
&& Bool -> Bool
not ([Text] -> Bool
forall a. [a] -> Bool
null [Text]
orTs) then "\n\n" else "")
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
desc
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
markParagraphs Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
desc) then "\n\n" else ""))
        Text -> Text -> Text
<+> (if Int
weight Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0
             then [Part] -> Text
makeSentence
                    ["Weighs around", Text -> Part
MU.Text Text
scaledWeight Part -> Part -> Part
forall a. Semigroup a => a -> a -> a
<> Part
unitWeight]
             else ""))
        Text -> Text -> Text
<+> Text
aspectSentences
        Text -> Text -> Text
<+> Text
sourceDesc
        Text -> Text -> Text
<+> Text
damageAnalysis)
       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if Bool
markParagraphs Bool -> Bool -> Bool
&& Bool -> Bool
not (Text -> Bool
T.null Text
ikitDesc) then "\n\n" else "\n")
       Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
ikitDesc
  in AttrCharW32
colorSymbol AttrCharW32 -> AttrString -> AttrString
forall a. a -> [a] -> [a]
: Text -> AttrString
textToAS Text
blurb