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

import Prelude ()

import Game.LambdaHack.Core.Prelude

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

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

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

-- If ever needed, we can use a symbol table here, since content
-- is never serialized. But we'd need to cover the few cases
-- (e.g., @litemFreq@) where @GroupName@ goes into savegame.
newtype GroupName a = GroupName {GroupName a -> Text
fromGroupName :: Text}
  deriving (Int -> GroupName a -> ShowS
[GroupName a] -> ShowS
GroupName a -> String
(Int -> GroupName a -> ShowS)
-> (GroupName a -> String)
-> ([GroupName a] -> ShowS)
-> Show (GroupName a)
forall a. Int -> GroupName a -> ShowS
forall a. [GroupName a] -> ShowS
forall a. GroupName a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GroupName a] -> ShowS
$cshowList :: forall a. [GroupName a] -> ShowS
show :: GroupName a -> String
$cshow :: forall a. GroupName a -> String
showsPrec :: Int -> GroupName a -> ShowS
$cshowsPrec :: forall a. Int -> GroupName a -> ShowS
Show, GroupName a -> GroupName a -> Bool
(GroupName a -> GroupName a -> Bool)
-> (GroupName a -> GroupName a -> Bool) -> Eq (GroupName a)
forall a. GroupName a -> GroupName a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GroupName a -> GroupName a -> Bool
$c/= :: forall a. GroupName a -> GroupName a -> Bool
== :: GroupName a -> GroupName a -> Bool
$c== :: forall a. GroupName a -> GroupName a -> Bool
Eq, Eq (GroupName a)
Eq (GroupName a) =>
(GroupName a -> GroupName a -> Ordering)
-> (GroupName a -> GroupName a -> Bool)
-> (GroupName a -> GroupName a -> Bool)
-> (GroupName a -> GroupName a -> Bool)
-> (GroupName a -> GroupName a -> Bool)
-> (GroupName a -> GroupName a -> GroupName a)
-> (GroupName a -> GroupName a -> GroupName a)
-> Ord (GroupName a)
GroupName a -> GroupName a -> Bool
GroupName a -> GroupName a -> Ordering
GroupName a -> GroupName a -> GroupName a
forall a. Eq (GroupName a)
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
forall a. GroupName a -> GroupName a -> Bool
forall a. GroupName a -> GroupName a -> Ordering
forall a. GroupName a -> GroupName a -> GroupName a
min :: GroupName a -> GroupName a -> GroupName a
$cmin :: forall a. GroupName a -> GroupName a -> GroupName a
max :: GroupName a -> GroupName a -> GroupName a
$cmax :: forall a. GroupName a -> GroupName a -> GroupName a
>= :: GroupName a -> GroupName a -> Bool
$c>= :: forall a. GroupName a -> GroupName a -> Bool
> :: GroupName a -> GroupName a -> Bool
$c> :: forall a. GroupName a -> GroupName a -> Bool
<= :: GroupName a -> GroupName a -> Bool
$c<= :: forall a. GroupName a -> GroupName a -> Bool
< :: GroupName a -> GroupName a -> Bool
$c< :: forall a. GroupName a -> GroupName a -> Bool
compare :: GroupName a -> GroupName a -> Ordering
$ccompare :: forall a. GroupName a -> GroupName a -> Ordering
$cp1Ord :: forall a. Eq (GroupName a)
Ord, Int -> GroupName a -> Int
GroupName a -> Int
(Int -> GroupName a -> Int)
-> (GroupName a -> Int) -> Hashable (GroupName a)
forall a. Int -> GroupName a -> Int
forall a. GroupName a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: GroupName a -> Int
$chash :: forall a. GroupName a -> Int
hashWithSalt :: Int -> GroupName a -> Int
$chashWithSalt :: forall a. Int -> GroupName a -> Int
Hashable, Get (GroupName a)
[GroupName a] -> Put
GroupName a -> Put
(GroupName a -> Put)
-> Get (GroupName a)
-> ([GroupName a] -> Put)
-> Binary (GroupName a)
forall a. Get (GroupName a)
forall a. [GroupName a] -> Put
forall a. GroupName a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [GroupName a] -> Put
$cputList :: forall a. [GroupName a] -> Put
get :: Get (GroupName a)
$cget :: forall a. Get (GroupName a)
put :: GroupName a -> Put
$cput :: forall a. GroupName a -> Put
Binary, GroupName a -> ()
(GroupName a -> ()) -> NFData (GroupName a)
forall a. GroupName a -> ()
forall a. (a -> ()) -> NFData a
rnf :: GroupName a -> ()
$crnf :: forall a. GroupName a -> ()
NFData)

-- | 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 a = [(GroupName a, Int)]

-- | 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
* 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@(x1Last :: Double
x1Last, y1Last :: Int
y1Last) [] =  -- we are past the last interval
        let stepLevel :: Double
stepLevel = 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
>= 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
/ (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
+ 1, Int
yConstant))
                  -- this artificial interval is enough to emulate
                  -- the value staying constant indefinitely
           else ((Double, Int)
x1y1, (10 Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
stepLevel, 0))
      findInterval !(Double, Int)
x1y1 ((!Double
x, !Int
y) : rest :: 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
      ((x1 :: Double
x1, y1 :: Int
y1), (x2 :: Double
x2, y2 :: Int
y2)) = (Double, Int) -> Rarity -> ((Double, Int), (Double, Int))
findInterval (0, 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))

-- | Content identifiers for the content type @c@.
newtype ContentId c = ContentId Word16
  deriving (Int -> ContentId c -> ShowS
[ContentId c] -> ShowS
ContentId c -> String
(Int -> ContentId c -> ShowS)
-> (ContentId c -> String)
-> ([ContentId c] -> ShowS)
-> Show (ContentId c)
forall c. Int -> ContentId c -> ShowS
forall c. [ContentId c] -> ShowS
forall c. ContentId c -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentId c] -> ShowS
$cshowList :: forall c. [ContentId c] -> ShowS
show :: ContentId c -> String
$cshow :: forall c. ContentId c -> String
showsPrec :: Int -> ContentId c -> ShowS
$cshowsPrec :: forall c. Int -> ContentId c -> ShowS
Show, ContentId c -> ContentId c -> Bool
(ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool) -> Eq (ContentId c)
forall c. ContentId c -> ContentId c -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentId c -> ContentId c -> Bool
$c/= :: forall c. ContentId c -> ContentId c -> Bool
== :: ContentId c -> ContentId c -> Bool
$c== :: forall c. ContentId c -> ContentId c -> Bool
Eq, Eq (ContentId c)
Eq (ContentId c) =>
(ContentId c -> ContentId c -> Ordering)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> Bool)
-> (ContentId c -> ContentId c -> ContentId c)
-> (ContentId c -> ContentId c -> ContentId c)
-> Ord (ContentId c)
ContentId c -> ContentId c -> Bool
ContentId c -> ContentId c -> Ordering
ContentId c -> ContentId c -> ContentId c
forall c. Eq (ContentId c)
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
forall c. ContentId c -> ContentId c -> Bool
forall c. ContentId c -> ContentId c -> Ordering
forall c. ContentId c -> ContentId c -> ContentId c
min :: ContentId c -> ContentId c -> ContentId c
$cmin :: forall c. ContentId c -> ContentId c -> ContentId c
max :: ContentId c -> ContentId c -> ContentId c
$cmax :: forall c. ContentId c -> ContentId c -> ContentId c
>= :: ContentId c -> ContentId c -> Bool
$c>= :: forall c. ContentId c -> ContentId c -> Bool
> :: ContentId c -> ContentId c -> Bool
$c> :: forall c. ContentId c -> ContentId c -> Bool
<= :: ContentId c -> ContentId c -> Bool
$c<= :: forall c. ContentId c -> ContentId c -> Bool
< :: ContentId c -> ContentId c -> Bool
$c< :: forall c. ContentId c -> ContentId c -> Bool
compare :: ContentId c -> ContentId c -> Ordering
$ccompare :: forall c. ContentId c -> ContentId c -> Ordering
$cp1Ord :: forall c. Eq (ContentId c)
Ord, Int -> ContentId c
ContentId c -> Int
ContentId c -> [ContentId c]
ContentId c -> ContentId c
ContentId c -> ContentId c -> [ContentId c]
ContentId c -> ContentId c -> ContentId c -> [ContentId c]
(ContentId c -> ContentId c)
-> (ContentId c -> ContentId c)
-> (Int -> ContentId c)
-> (ContentId c -> Int)
-> (ContentId c -> [ContentId c])
-> (ContentId c -> ContentId c -> [ContentId c])
-> (ContentId c -> ContentId c -> [ContentId c])
-> (ContentId c -> ContentId c -> ContentId c -> [ContentId c])
-> Enum (ContentId c)
forall c. Int -> ContentId c
forall c. ContentId c -> Int
forall c. ContentId c -> [ContentId c]
forall c. ContentId c -> ContentId c
forall c. ContentId c -> ContentId c -> [ContentId c]
forall c.
ContentId c -> ContentId c -> ContentId c -> [ContentId c]
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 :: ContentId c -> ContentId c -> ContentId c -> [ContentId c]
$cenumFromThenTo :: forall c.
ContentId c -> ContentId c -> ContentId c -> [ContentId c]
enumFromTo :: ContentId c -> ContentId c -> [ContentId c]
$cenumFromTo :: forall c. ContentId c -> ContentId c -> [ContentId c]
enumFromThen :: ContentId c -> ContentId c -> [ContentId c]
$cenumFromThen :: forall c. ContentId c -> ContentId c -> [ContentId c]
enumFrom :: ContentId c -> [ContentId c]
$cenumFrom :: forall c. ContentId c -> [ContentId c]
fromEnum :: ContentId c -> Int
$cfromEnum :: forall c. ContentId c -> Int
toEnum :: Int -> ContentId c
$ctoEnum :: forall c. Int -> ContentId c
pred :: ContentId c -> ContentId c
$cpred :: forall c. ContentId c -> ContentId c
succ :: ContentId c -> ContentId c
$csucc :: forall c. ContentId c -> ContentId c
Enum, Int -> ContentId c -> Int
ContentId c -> Int
(Int -> ContentId c -> Int)
-> (ContentId c -> Int) -> Hashable (ContentId c)
forall c. Int -> ContentId c -> Int
forall c. ContentId c -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ContentId c -> Int
$chash :: forall c. ContentId c -> Int
hashWithSalt :: Int -> ContentId c -> Int
$chashWithSalt :: forall c. Int -> ContentId c -> Int
Hashable, Get (ContentId c)
[ContentId c] -> Put
ContentId c -> Put
(ContentId c -> Put)
-> Get (ContentId c)
-> ([ContentId c] -> Put)
-> Binary (ContentId c)
forall c. Get (ContentId c)
forall c. [ContentId c] -> Put
forall c. ContentId c -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [ContentId c] -> Put
$cputList :: forall c. [ContentId c] -> Put
get :: Get (ContentId c)
$cget :: forall c. Get (ContentId c)
put :: ContentId c -> Put
$cput :: forall c. ContentId c -> Put
Binary)

toContentId :: Word16 -> ContentId c
{-# INLINE toContentId #-}
toContentId :: Word16 -> ContentId c
toContentId = Word16 -> ContentId c
forall c. Word16 -> ContentId c
ContentId

fromContentId :: ContentId c -> Word16
{-# INLINE fromContentId #-}
fromContentId :: ContentId c -> Word16
fromContentId (ContentId k :: Word16
k) = Word16
k

contentIdIndex :: ContentId k -> Int
{-# INLINE contentIdIndex #-}
contentIdIndex :: ContentId k -> Int
contentIdIndex (ContentId k :: Word16
k) = Word16 -> Int
forall a. Enum a => a -> Int
fromEnum Word16
k

-- | 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 CGround = ("on", "the ground")
ppCStore COrgan = ("in", "body")
ppCStore CEqp = ("in", "equipment outfit")
ppCStore CStash = ("in", "shared inventory stash")

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

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

-- | Item slot and lore categories.
data SLore =
    SItem
  | SOrgan
  | STrunk
  | SCondition
  | SBlast
  | SEmbed
  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
  | MOrgans        -- ^ leader's organs
  | 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
  | 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 SItem = "item"
ppSLore SOrgan = "organ"
ppSLore STrunk = "creature"
ppSLore SCondition = "condition"
ppSLore SBlast = "blast"
ppSLore SEmbed = "terrain"

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

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

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

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

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