{-# LANGUAGE DeriveGeneric #-}
-- | Basic types for content definitions.
module Game.LambdaHack.Definition.Defs
  ( GroupName, displayGroupName
  , ContentId, contentIdIndex
  , ContentSymbol, displayContentSymbol
  , X, Y
  , Freqs, renameFreqs
  , Rarity, linearInterpolation
  , CStore(..), ppCStore, ppCStoreIn, verbCStore
  , SLore(..), ItemDialogMode(..), ppSLore, headingSLore
  , ppItemDialogMode, ppItemDialogModeIn, ppItemDialogModeFrom, loreFromMode
  , Direction(..)
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Control.DeepSeq
import Data.Binary
import GHC.Generics (Generic)

import Game.LambdaHack.Definition.DefsInternal

-- | X spacial dimension for points and vectors.
type X = Int

-- | Y xpacial dimension for points and vectors.
type Y = Int

-- | For each group that the kind belongs to, denoted by a @GroupName@
-- in the first component of a pair, the second component of a pair shows
-- how common the kind is within the group.
type Freqs c = [(GroupName c, Int)]

renameFreqs :: (Text -> Text) -> Freqs c -> Freqs c
renameFreqs :: (Text -> Text) -> Freqs c -> Freqs c
renameFreqs Text -> Text
f = ((GroupName c, Int) -> (GroupName c, Int)) -> Freqs c -> Freqs c
forall a b. (a -> b) -> [a] -> [b]
map ((GroupName c -> GroupName c)
-> (GroupName c, Int) -> (GroupName c, Int)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (Text -> GroupName c
forall c. Text -> GroupName c
GroupName (Text -> GroupName c)
-> (GroupName c -> Text) -> GroupName c -> GroupName c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
f (Text -> Text) -> (GroupName c -> Text) -> GroupName c -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GroupName c -> Text
forall c. GroupName c -> Text
fromGroupName))

-- | Rarity on given depths. The first element of the pair is normally
-- in (0, 10] interval and, e.g., if there are 20 levels, 0.5 represents
-- the first level and 10 the last. Exceptionally, it may be larger than 10,
-- meaning appearance in the dungeon is not possible under normal circumstances
-- and the value remains constant above the interval bound.
type Rarity = [(Double, Int)]

-- We assume depths are greater or equal to one and the rarity @dataset@
-- is non-empty, sorted and the first elements of the pairs are positive.
-- The convention for adding implicit outer intervals is that
-- the value increases linearly, starting from 0 at 0. Similarly,
-- if the last interval ends before 10, the value drops linearly,
-- in a way that would reach 0 a step after 10, but staying constant
-- from 10 onward. If the last interval ends after 10, the value stays constant
-- after the interval's upper bound.
--
-- Note that rarity [(1, 1)] means constant value 1 only thanks to @ceiling@.
-- OTOH, [(1, 10)] is not equivalent to [(10/150, 10)] in a 150-deep dungeon,
-- since its value at the first level is drastically lower. This only
-- matters if content creators mix the two notations, so care must be taken
-- in such cases. Otherwise, for any given level, all kinds scale consistently
-- and the simpler notation just paintes the dungeon in larger strokes.
linearInterpolation :: Int -> Int -> Rarity -> Int
linearInterpolation :: Int -> Int -> Rarity -> Int
linearInterpolation !Int
levelDepthInt !Int
totalDepthInt !Rarity
dataset =
  let levelDepth10 :: Double
levelDepth10 = Int -> Double
intToDouble (Int -> Double) -> Int -> Double
forall a b. (a -> b) -> a -> b
$ Int
levelDepthInt Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10
      totalDepth :: Double
totalDepth = Int -> Double
intToDouble Int
totalDepthInt
      findInterval :: (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))
      findInterval :: (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))
findInterval x1y1 :: (Double, Int)
x1y1@(Double
x1Last, Int
y1Last) [] =  -- we are past the last interval
        let stepLevel :: Double
stepLevel = Double
10 Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
totalDepth
              -- this is the distance representing one level, the same
              -- as the distance from 0 to the representation of level 1
            yConstant :: Int
yConstant = if Double
x1Last Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
>= Double
10
                        then Int
y1Last
                        else Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Int -> Double
intToDouble Int
y1Last Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
stepLevel
                                      Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
10 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
stepLevel Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1Last))
              -- this is the value of the interpolation formula at the end
              -- with y2 == 0, levelDepth10 == totalDepth * 10,
              -- and x2 == 10 + stepLevel
        in if Int
levelDepthInt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
totalDepthInt  -- value stays constant
           then ((Double
x1Last, Int
yConstant), (Double
x1Last Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
1, Int
yConstant))
                  -- this artificial interval is enough to emulate
                  -- the value staying constant indefinitely
           else ((Double, Int)
x1y1, (Double
10 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
stepLevel, Int
0))
      findInterval !(Double, Int)
x1y1 ((!Double
x, !Int
y) : Rarity
rest) =
        if Double
levelDepth10 Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalDepth
        then ((Double, Int)
x1y1, (Double
x, Int
y))
        else (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))
findInterval (Double
x, Int
y) Rarity
rest
      ((Double
x1, Int
y1), (Double
x2, Int
y2)) = (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))
findInterval (Double
0, Int
0) Rarity
dataset
  in Int
y1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
ceiling
            (Int -> Double
intToDouble (Int
y2 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
y1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* (Double
levelDepth10 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalDepth)
             Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ ((Double
x2 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
x1) Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
totalDepth))

-- | Actor's item stores.
data CStore =
    CGround
  | COrgan
  | CEqp
  | CStash
  deriving (Int -> CStore -> ShowS
[CStore] -> ShowS
CStore -> String
(Int -> CStore -> ShowS)
-> (CStore -> String) -> ([CStore] -> ShowS) -> Show CStore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CStore] -> ShowS
$cshowList :: [CStore] -> ShowS
show :: CStore -> String
$cshow :: CStore -> String
showsPrec :: Int -> CStore -> ShowS
$cshowsPrec :: Int -> CStore -> ShowS
Show, ReadPrec [CStore]
ReadPrec CStore
Int -> ReadS CStore
ReadS [CStore]
(Int -> ReadS CStore)
-> ReadS [CStore]
-> ReadPrec CStore
-> ReadPrec [CStore]
-> Read CStore
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CStore]
$creadListPrec :: ReadPrec [CStore]
readPrec :: ReadPrec CStore
$creadPrec :: ReadPrec CStore
readList :: ReadS [CStore]
$creadList :: ReadS [CStore]
readsPrec :: Int -> ReadS CStore
$creadsPrec :: Int -> ReadS CStore
Read, CStore -> CStore -> Bool
(CStore -> CStore -> Bool)
-> (CStore -> CStore -> Bool) -> Eq CStore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CStore -> CStore -> Bool
$c/= :: CStore -> CStore -> Bool
== :: CStore -> CStore -> Bool
$c== :: CStore -> CStore -> Bool
Eq, Eq CStore
Eq CStore
-> (CStore -> CStore -> Ordering)
-> (CStore -> CStore -> Bool)
-> (CStore -> CStore -> Bool)
-> (CStore -> CStore -> Bool)
-> (CStore -> CStore -> Bool)
-> (CStore -> CStore -> CStore)
-> (CStore -> CStore -> CStore)
-> Ord CStore
CStore -> CStore -> Bool
CStore -> CStore -> Ordering
CStore -> CStore -> CStore
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: CStore -> CStore -> CStore
$cmin :: CStore -> CStore -> CStore
max :: CStore -> CStore -> CStore
$cmax :: CStore -> CStore -> CStore
>= :: CStore -> CStore -> Bool
$c>= :: CStore -> CStore -> Bool
> :: CStore -> CStore -> Bool
$c> :: CStore -> CStore -> Bool
<= :: CStore -> CStore -> Bool
$c<= :: CStore -> CStore -> Bool
< :: CStore -> CStore -> Bool
$c< :: CStore -> CStore -> Bool
compare :: CStore -> CStore -> Ordering
$ccompare :: CStore -> CStore -> Ordering
$cp1Ord :: Eq CStore
Ord, Int -> CStore
CStore -> Int
CStore -> [CStore]
CStore -> CStore
CStore -> CStore -> [CStore]
CStore -> CStore -> CStore -> [CStore]
(CStore -> CStore)
-> (CStore -> CStore)
-> (Int -> CStore)
-> (CStore -> Int)
-> (CStore -> [CStore])
-> (CStore -> CStore -> [CStore])
-> (CStore -> CStore -> [CStore])
-> (CStore -> CStore -> CStore -> [CStore])
-> Enum CStore
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: CStore -> CStore -> CStore -> [CStore]
$cenumFromThenTo :: CStore -> CStore -> CStore -> [CStore]
enumFromTo :: CStore -> CStore -> [CStore]
$cenumFromTo :: CStore -> CStore -> [CStore]
enumFromThen :: CStore -> CStore -> [CStore]
$cenumFromThen :: CStore -> CStore -> [CStore]
enumFrom :: CStore -> [CStore]
$cenumFrom :: CStore -> [CStore]
fromEnum :: CStore -> Int
$cfromEnum :: CStore -> Int
toEnum :: Int -> CStore
$ctoEnum :: Int -> CStore
pred :: CStore -> CStore
$cpred :: CStore -> CStore
succ :: CStore -> CStore
$csucc :: CStore -> CStore
Enum, CStore
CStore -> CStore -> Bounded CStore
forall a. a -> a -> Bounded a
maxBound :: CStore
$cmaxBound :: CStore
minBound :: CStore
$cminBound :: CStore
Bounded, (forall x. CStore -> Rep CStore x)
-> (forall x. Rep CStore x -> CStore) -> Generic CStore
forall x. Rep CStore x -> CStore
forall x. CStore -> Rep CStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CStore x -> CStore
$cfrom :: forall x. CStore -> Rep CStore x
Generic)

instance Binary CStore

instance NFData CStore

ppCStore :: CStore -> (Text, Text)
ppCStore :: CStore -> (Text, Text)
ppCStore CStore
CGround = (Text
"on", Text
"the ground")
ppCStore CStore
COrgan = (Text
"in", Text
"body")
ppCStore CStore
CEqp = (Text
"in", Text
"equipment outfit")
ppCStore CStore
CStash = (Text
"in", Text
"shared inventory stash")

ppCStoreIn :: CStore -> Text
ppCStoreIn :: CStore -> Text
ppCStoreIn CStore
c = let (Text
tIn, Text
t) = CStore -> (Text, Text)
ppCStore CStore
c in Text
tIn Text -> Text -> Text
<+> Text
t

verbCStore :: CStore -> Text
verbCStore :: CStore -> Text
verbCStore CStore
CGround = Text
"remove"
verbCStore CStore
COrgan = Text
"implant"
verbCStore CStore
CEqp = Text
"equip"
verbCStore CStore
CStash = Text
"stash"

-- | Item slot and lore categories.
data SLore =
    SItem
  | SOrgan
  | STrunk
  | SCondition
  | SBlast
  | SEmbed
  | SBody  -- contains the sum of @SOrgan@, @STrunk@ and @SCondition@
           -- but only present in the current pointman's body
  deriving (Int -> SLore -> ShowS
[SLore] -> ShowS
SLore -> String
(Int -> SLore -> ShowS)
-> (SLore -> String) -> ([SLore] -> ShowS) -> Show SLore
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SLore] -> ShowS
$cshowList :: [SLore] -> ShowS
show :: SLore -> String
$cshow :: SLore -> String
showsPrec :: Int -> SLore -> ShowS
$cshowsPrec :: Int -> SLore -> ShowS
Show, ReadPrec [SLore]
ReadPrec SLore
Int -> ReadS SLore
ReadS [SLore]
(Int -> ReadS SLore)
-> ReadS [SLore]
-> ReadPrec SLore
-> ReadPrec [SLore]
-> Read SLore
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SLore]
$creadListPrec :: ReadPrec [SLore]
readPrec :: ReadPrec SLore
$creadPrec :: ReadPrec SLore
readList :: ReadS [SLore]
$creadList :: ReadS [SLore]
readsPrec :: Int -> ReadS SLore
$creadsPrec :: Int -> ReadS SLore
Read, SLore -> SLore -> Bool
(SLore -> SLore -> Bool) -> (SLore -> SLore -> Bool) -> Eq SLore
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SLore -> SLore -> Bool
$c/= :: SLore -> SLore -> Bool
== :: SLore -> SLore -> Bool
$c== :: SLore -> SLore -> Bool
Eq, Eq SLore
Eq SLore
-> (SLore -> SLore -> Ordering)
-> (SLore -> SLore -> Bool)
-> (SLore -> SLore -> Bool)
-> (SLore -> SLore -> Bool)
-> (SLore -> SLore -> Bool)
-> (SLore -> SLore -> SLore)
-> (SLore -> SLore -> SLore)
-> Ord SLore
SLore -> SLore -> Bool
SLore -> SLore -> Ordering
SLore -> SLore -> SLore
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SLore -> SLore -> SLore
$cmin :: SLore -> SLore -> SLore
max :: SLore -> SLore -> SLore
$cmax :: SLore -> SLore -> SLore
>= :: SLore -> SLore -> Bool
$c>= :: SLore -> SLore -> Bool
> :: SLore -> SLore -> Bool
$c> :: SLore -> SLore -> Bool
<= :: SLore -> SLore -> Bool
$c<= :: SLore -> SLore -> Bool
< :: SLore -> SLore -> Bool
$c< :: SLore -> SLore -> Bool
compare :: SLore -> SLore -> Ordering
$ccompare :: SLore -> SLore -> Ordering
$cp1Ord :: Eq SLore
Ord, Int -> SLore
SLore -> Int
SLore -> [SLore]
SLore -> SLore
SLore -> SLore -> [SLore]
SLore -> SLore -> SLore -> [SLore]
(SLore -> SLore)
-> (SLore -> SLore)
-> (Int -> SLore)
-> (SLore -> Int)
-> (SLore -> [SLore])
-> (SLore -> SLore -> [SLore])
-> (SLore -> SLore -> [SLore])
-> (SLore -> SLore -> SLore -> [SLore])
-> Enum SLore
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SLore -> SLore -> SLore -> [SLore]
$cenumFromThenTo :: SLore -> SLore -> SLore -> [SLore]
enumFromTo :: SLore -> SLore -> [SLore]
$cenumFromTo :: SLore -> SLore -> [SLore]
enumFromThen :: SLore -> SLore -> [SLore]
$cenumFromThen :: SLore -> SLore -> [SLore]
enumFrom :: SLore -> [SLore]
$cenumFrom :: SLore -> [SLore]
fromEnum :: SLore -> Int
$cfromEnum :: SLore -> Int
toEnum :: Int -> SLore
$ctoEnum :: Int -> SLore
pred :: SLore -> SLore
$cpred :: SLore -> SLore
succ :: SLore -> SLore
$csucc :: SLore -> SLore
Enum, SLore
SLore -> SLore -> Bounded SLore
forall a. a -> a -> Bounded a
maxBound :: SLore
$cmaxBound :: SLore
minBound :: SLore
$cminBound :: SLore
Bounded, (forall x. SLore -> Rep SLore x)
-> (forall x. Rep SLore x -> SLore) -> Generic SLore
forall x. Rep SLore x -> SLore
forall x. SLore -> Rep SLore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SLore x -> SLore
$cfrom :: forall x. SLore -> Rep SLore x
Generic)

instance Binary SLore

instance NFData SLore

data ItemDialogMode =
    MStore CStore  -- ^ a leader's store
  | MOwned         -- ^ all party's items
  | MSkills        -- ^ not items, but determined by leader's items
  | MLore SLore    -- ^ not party's items, but all known generalized items
  | MPlaces        -- ^ places; not items at all, but definitely a lore
  | MFactions      -- ^ factions in this game, with some data from previous
  | MModes         -- ^ scenarios; not items at all, but definitely a lore
  deriving (Int -> ItemDialogMode -> ShowS
[ItemDialogMode] -> ShowS
ItemDialogMode -> String
(Int -> ItemDialogMode -> ShowS)
-> (ItemDialogMode -> String)
-> ([ItemDialogMode] -> ShowS)
-> Show ItemDialogMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ItemDialogMode] -> ShowS
$cshowList :: [ItemDialogMode] -> ShowS
show :: ItemDialogMode -> String
$cshow :: ItemDialogMode -> String
showsPrec :: Int -> ItemDialogMode -> ShowS
$cshowsPrec :: Int -> ItemDialogMode -> ShowS
Show, ReadPrec [ItemDialogMode]
ReadPrec ItemDialogMode
Int -> ReadS ItemDialogMode
ReadS [ItemDialogMode]
(Int -> ReadS ItemDialogMode)
-> ReadS [ItemDialogMode]
-> ReadPrec ItemDialogMode
-> ReadPrec [ItemDialogMode]
-> Read ItemDialogMode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ItemDialogMode]
$creadListPrec :: ReadPrec [ItemDialogMode]
readPrec :: ReadPrec ItemDialogMode
$creadPrec :: ReadPrec ItemDialogMode
readList :: ReadS [ItemDialogMode]
$creadList :: ReadS [ItemDialogMode]
readsPrec :: Int -> ReadS ItemDialogMode
$creadsPrec :: Int -> ReadS ItemDialogMode
Read, ItemDialogMode -> ItemDialogMode -> Bool
(ItemDialogMode -> ItemDialogMode -> Bool)
-> (ItemDialogMode -> ItemDialogMode -> Bool) -> Eq ItemDialogMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ItemDialogMode -> ItemDialogMode -> Bool
$c/= :: ItemDialogMode -> ItemDialogMode -> Bool
== :: ItemDialogMode -> ItemDialogMode -> Bool
$c== :: ItemDialogMode -> ItemDialogMode -> Bool
Eq, Eq ItemDialogMode
Eq ItemDialogMode
-> (ItemDialogMode -> ItemDialogMode -> Ordering)
-> (ItemDialogMode -> ItemDialogMode -> Bool)
-> (ItemDialogMode -> ItemDialogMode -> Bool)
-> (ItemDialogMode -> ItemDialogMode -> Bool)
-> (ItemDialogMode -> ItemDialogMode -> Bool)
-> (ItemDialogMode -> ItemDialogMode -> ItemDialogMode)
-> (ItemDialogMode -> ItemDialogMode -> ItemDialogMode)
-> Ord ItemDialogMode
ItemDialogMode -> ItemDialogMode -> Bool
ItemDialogMode -> ItemDialogMode -> Ordering
ItemDialogMode -> ItemDialogMode -> ItemDialogMode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ItemDialogMode -> ItemDialogMode -> ItemDialogMode
$cmin :: ItemDialogMode -> ItemDialogMode -> ItemDialogMode
max :: ItemDialogMode -> ItemDialogMode -> ItemDialogMode
$cmax :: ItemDialogMode -> ItemDialogMode -> ItemDialogMode
>= :: ItemDialogMode -> ItemDialogMode -> Bool
$c>= :: ItemDialogMode -> ItemDialogMode -> Bool
> :: ItemDialogMode -> ItemDialogMode -> Bool
$c> :: ItemDialogMode -> ItemDialogMode -> Bool
<= :: ItemDialogMode -> ItemDialogMode -> Bool
$c<= :: ItemDialogMode -> ItemDialogMode -> Bool
< :: ItemDialogMode -> ItemDialogMode -> Bool
$c< :: ItemDialogMode -> ItemDialogMode -> Bool
compare :: ItemDialogMode -> ItemDialogMode -> Ordering
$ccompare :: ItemDialogMode -> ItemDialogMode -> Ordering
$cp1Ord :: Eq ItemDialogMode
Ord, (forall x. ItemDialogMode -> Rep ItemDialogMode x)
-> (forall x. Rep ItemDialogMode x -> ItemDialogMode)
-> Generic ItemDialogMode
forall x. Rep ItemDialogMode x -> ItemDialogMode
forall x. ItemDialogMode -> Rep ItemDialogMode x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ItemDialogMode x -> ItemDialogMode
$cfrom :: forall x. ItemDialogMode -> Rep ItemDialogMode x
Generic)

instance NFData ItemDialogMode

instance Binary ItemDialogMode

ppSLore :: SLore -> Text
ppSLore :: SLore -> Text
ppSLore SLore
SItem = Text
"item"
ppSLore SLore
SOrgan = Text
"organ"
ppSLore SLore
STrunk = Text
"creature"
ppSLore SLore
SCondition = Text
"condition"
ppSLore SLore
SBlast = Text
"blast"
ppSLore SLore
SEmbed = Text
"terrain"
ppSLore SLore
SBody = Text
"body"

headingSLore :: SLore -> Text
headingSLore :: SLore -> Text
headingSLore SLore
SItem = Text
"miscellaneous item"
headingSLore SLore
SOrgan = Text
"vital anatomic organ"
headingSLore SLore
STrunk = Text
"autonomous entity"
headingSLore SLore
SCondition = Text
"momentary bodily condition"
headingSLore SLore
SBlast = Text
"explosion blast particle"
headingSLore SLore
SEmbed = Text
"landmark feature"
headingSLore SLore
SBody = Text
"body part"

ppItemDialogMode :: ItemDialogMode -> (Text, Text)
ppItemDialogMode :: ItemDialogMode -> (Text, Text)
ppItemDialogMode (MStore CStore
cstore) = CStore -> (Text, Text)
ppCStore CStore
cstore
ppItemDialogMode ItemDialogMode
MOwned = (Text
"among", Text
"our total team belongings")
ppItemDialogMode ItemDialogMode
MSkills = (Text
"among", Text
"skills")
ppItemDialogMode (MLore SLore
SBody) = (Text
"in", Text
"body")
ppItemDialogMode (MLore SLore
slore) = (Text
"among", SLore -> Text
ppSLore SLore
slore Text -> Text -> Text
<+> Text
"lore")
ppItemDialogMode ItemDialogMode
MPlaces = (Text
"among", Text
"place lore")
ppItemDialogMode ItemDialogMode
MFactions = (Text
"among", Text
"faction lore")
ppItemDialogMode ItemDialogMode
MModes = (Text
"among", Text
"adventure lore")

ppItemDialogModeIn :: ItemDialogMode -> Text
ppItemDialogModeIn :: ItemDialogMode -> Text
ppItemDialogModeIn ItemDialogMode
c = let (Text
tIn, Text
t) = ItemDialogMode -> (Text, Text)
ppItemDialogMode ItemDialogMode
c in Text
tIn Text -> Text -> Text
<+> Text
t

ppItemDialogModeFrom :: ItemDialogMode -> Text
ppItemDialogModeFrom :: ItemDialogMode -> Text
ppItemDialogModeFrom ItemDialogMode
c = let (Text
_tIn, Text
t) = ItemDialogMode -> (Text, Text)
ppItemDialogMode ItemDialogMode
c in Text
"from" Text -> Text -> Text
<+> Text
t

loreFromMode :: ItemDialogMode -> SLore
loreFromMode :: ItemDialogMode -> SLore
loreFromMode ItemDialogMode
c = case ItemDialogMode
c of
  MStore CStore
COrgan -> SLore
SOrgan
  MStore CStore
_ -> SLore
SItem
  ItemDialogMode
MOwned -> SLore
SItem
  ItemDialogMode
MSkills -> SLore
forall a. HasCallStack => a
undefined  -- artificial slots
  MLore SLore
slore -> SLore
slore
  ItemDialogMode
MPlaces -> SLore
forall a. HasCallStack => a
undefined  -- artificial slots
  ItemDialogMode
MFactions -> SLore
forall a. HasCallStack => a
undefined  -- artificial slots
  ItemDialogMode
MModes -> SLore
forall a. HasCallStack => a
undefined  -- artificial slots

data Direction = Forward | Backward
  deriving (Int -> Direction -> ShowS
[Direction] -> ShowS
Direction -> String
(Int -> Direction -> ShowS)
-> (Direction -> String)
-> ([Direction] -> ShowS)
-> Show Direction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Direction] -> ShowS
$cshowList :: [Direction] -> ShowS
show :: Direction -> String
$cshow :: Direction -> String
showsPrec :: Int -> Direction -> ShowS
$cshowsPrec :: Int -> Direction -> ShowS
Show, ReadPrec [Direction]
ReadPrec Direction
Int -> ReadS Direction
ReadS [Direction]
(Int -> ReadS Direction)
-> ReadS [Direction]
-> ReadPrec Direction
-> ReadPrec [Direction]
-> Read Direction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Direction]
$creadListPrec :: ReadPrec [Direction]
readPrec :: ReadPrec Direction
$creadPrec :: ReadPrec Direction
readList :: ReadS [Direction]
$creadList :: ReadS [Direction]
readsPrec :: Int -> ReadS Direction
$creadsPrec :: Int -> ReadS Direction
Read, Direction -> Direction -> Bool
(Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool) -> Eq Direction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Direction -> Direction -> Bool
$c/= :: Direction -> Direction -> Bool
== :: Direction -> Direction -> Bool
$c== :: Direction -> Direction -> Bool
Eq, Eq Direction
Eq Direction
-> (Direction -> Direction -> Ordering)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Bool)
-> (Direction -> Direction -> Direction)
-> (Direction -> Direction -> Direction)
-> Ord Direction
Direction -> Direction -> Bool
Direction -> Direction -> Ordering
Direction -> Direction -> Direction
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Direction -> Direction -> Direction
$cmin :: Direction -> Direction -> Direction
max :: Direction -> Direction -> Direction
$cmax :: Direction -> Direction -> Direction
>= :: Direction -> Direction -> Bool
$c>= :: Direction -> Direction -> Bool
> :: Direction -> Direction -> Bool
$c> :: Direction -> Direction -> Bool
<= :: Direction -> Direction -> Bool
$c<= :: Direction -> Direction -> Bool
< :: Direction -> Direction -> Bool
$c< :: Direction -> Direction -> Bool
compare :: Direction -> Direction -> Ordering
$ccompare :: Direction -> Direction -> Ordering
$cp1Ord :: Eq Direction
Ord, (forall x. Direction -> Rep Direction x)
-> (forall x. Rep Direction x -> Direction) -> Generic Direction
forall x. Rep Direction x -> Direction
forall x. Direction -> Rep Direction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Direction x -> Direction
$cfrom :: forall x. Direction -> Rep Direction x
Generic)

instance NFData Direction

instance Binary Direction