{-# LANGUAGE DeriveGeneric #-}
-- | The appearance of in-game items, as communicated to the player.
module Game.LambdaHack.Definition.Flavour
  ( -- * The @Flavour@ type
    Flavour
  , -- * Constructors
    zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy, zipStory
  , dummyFlavour, stdFlavList
  , -- * Accessors
    flavourToColor, flavourToName
    -- * Assorted
  , colorToPlainName, colorToFancyName, colorToTeamName
#ifdef EXPOSE_INTERNAL
    -- * Internal operations
  , FancyName, colorToLiquidName, colorToGlassPlainName, colorToGlassFancyName
#endif
  ) where

import Prelude ()

import Game.LambdaHack.Core.Prelude

import Data.Binary
import Data.Bits (unsafeShiftL, unsafeShiftR, (.&.))
import GHC.Generics (Generic)

import Game.LambdaHack.Definition.Color

data FancyName = Plain | Fancy | Liquid | GlassPlain | GlassFancy | Story
  deriving (Int -> FancyName -> ShowS
[FancyName] -> ShowS
FancyName -> String
(Int -> FancyName -> ShowS)
-> (FancyName -> String)
-> ([FancyName] -> ShowS)
-> Show FancyName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FancyName] -> ShowS
$cshowList :: [FancyName] -> ShowS
show :: FancyName -> String
$cshow :: FancyName -> String
showsPrec :: Int -> FancyName -> ShowS
$cshowsPrec :: Int -> FancyName -> ShowS
Show, FancyName -> FancyName -> Bool
(FancyName -> FancyName -> Bool)
-> (FancyName -> FancyName -> Bool) -> Eq FancyName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FancyName -> FancyName -> Bool
$c/= :: FancyName -> FancyName -> Bool
== :: FancyName -> FancyName -> Bool
$c== :: FancyName -> FancyName -> Bool
Eq, Eq FancyName
Eq FancyName
-> (FancyName -> FancyName -> Ordering)
-> (FancyName -> FancyName -> Bool)
-> (FancyName -> FancyName -> Bool)
-> (FancyName -> FancyName -> Bool)
-> (FancyName -> FancyName -> Bool)
-> (FancyName -> FancyName -> FancyName)
-> (FancyName -> FancyName -> FancyName)
-> Ord FancyName
FancyName -> FancyName -> Bool
FancyName -> FancyName -> Ordering
FancyName -> FancyName -> FancyName
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 :: FancyName -> FancyName -> FancyName
$cmin :: FancyName -> FancyName -> FancyName
max :: FancyName -> FancyName -> FancyName
$cmax :: FancyName -> FancyName -> FancyName
>= :: FancyName -> FancyName -> Bool
$c>= :: FancyName -> FancyName -> Bool
> :: FancyName -> FancyName -> Bool
$c> :: FancyName -> FancyName -> Bool
<= :: FancyName -> FancyName -> Bool
$c<= :: FancyName -> FancyName -> Bool
< :: FancyName -> FancyName -> Bool
$c< :: FancyName -> FancyName -> Bool
compare :: FancyName -> FancyName -> Ordering
$ccompare :: FancyName -> FancyName -> Ordering
$cp1Ord :: Eq FancyName
Ord, Int -> FancyName
FancyName -> Int
FancyName -> [FancyName]
FancyName -> FancyName
FancyName -> FancyName -> [FancyName]
FancyName -> FancyName -> FancyName -> [FancyName]
(FancyName -> FancyName)
-> (FancyName -> FancyName)
-> (Int -> FancyName)
-> (FancyName -> Int)
-> (FancyName -> [FancyName])
-> (FancyName -> FancyName -> [FancyName])
-> (FancyName -> FancyName -> [FancyName])
-> (FancyName -> FancyName -> FancyName -> [FancyName])
-> Enum FancyName
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 :: FancyName -> FancyName -> FancyName -> [FancyName]
$cenumFromThenTo :: FancyName -> FancyName -> FancyName -> [FancyName]
enumFromTo :: FancyName -> FancyName -> [FancyName]
$cenumFromTo :: FancyName -> FancyName -> [FancyName]
enumFromThen :: FancyName -> FancyName -> [FancyName]
$cenumFromThen :: FancyName -> FancyName -> [FancyName]
enumFrom :: FancyName -> [FancyName]
$cenumFrom :: FancyName -> [FancyName]
fromEnum :: FancyName -> Int
$cfromEnum :: FancyName -> Int
toEnum :: Int -> FancyName
$ctoEnum :: Int -> FancyName
pred :: FancyName -> FancyName
$cpred :: FancyName -> FancyName
succ :: FancyName -> FancyName
$csucc :: FancyName -> FancyName
Enum, FancyName
FancyName -> FancyName -> Bounded FancyName
forall a. a -> a -> Bounded a
maxBound :: FancyName
$cmaxBound :: FancyName
minBound :: FancyName
$cminBound :: FancyName
Bounded, (forall x. FancyName -> Rep FancyName x)
-> (forall x. Rep FancyName x -> FancyName) -> Generic FancyName
forall x. Rep FancyName x -> FancyName
forall x. FancyName -> Rep FancyName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FancyName x -> FancyName
$cfrom :: forall x. FancyName -> Rep FancyName x
Generic)

-- | The type of item flavours.
data Flavour = Flavour
  { Flavour -> FancyName
fancyName :: FancyName  -- ^ how fancy should the colour description be
  , Flavour -> Color
baseColor :: Color      -- ^ the colour of the flavour
  }
  deriving (Int -> Flavour -> ShowS
[Flavour] -> ShowS
Flavour -> String
(Int -> Flavour -> ShowS)
-> (Flavour -> String) -> ([Flavour] -> ShowS) -> Show Flavour
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Flavour] -> ShowS
$cshowList :: [Flavour] -> ShowS
show :: Flavour -> String
$cshow :: Flavour -> String
showsPrec :: Int -> Flavour -> ShowS
$cshowsPrec :: Int -> Flavour -> ShowS
Show, Flavour -> Flavour -> Bool
(Flavour -> Flavour -> Bool)
-> (Flavour -> Flavour -> Bool) -> Eq Flavour
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Flavour -> Flavour -> Bool
$c/= :: Flavour -> Flavour -> Bool
== :: Flavour -> Flavour -> Bool
$c== :: Flavour -> Flavour -> Bool
Eq, Eq Flavour
Eq Flavour
-> (Flavour -> Flavour -> Ordering)
-> (Flavour -> Flavour -> Bool)
-> (Flavour -> Flavour -> Bool)
-> (Flavour -> Flavour -> Bool)
-> (Flavour -> Flavour -> Bool)
-> (Flavour -> Flavour -> Flavour)
-> (Flavour -> Flavour -> Flavour)
-> Ord Flavour
Flavour -> Flavour -> Bool
Flavour -> Flavour -> Ordering
Flavour -> Flavour -> Flavour
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 :: Flavour -> Flavour -> Flavour
$cmin :: Flavour -> Flavour -> Flavour
max :: Flavour -> Flavour -> Flavour
$cmax :: Flavour -> Flavour -> Flavour
>= :: Flavour -> Flavour -> Bool
$c>= :: Flavour -> Flavour -> Bool
> :: Flavour -> Flavour -> Bool
$c> :: Flavour -> Flavour -> Bool
<= :: Flavour -> Flavour -> Bool
$c<= :: Flavour -> Flavour -> Bool
< :: Flavour -> Flavour -> Bool
$c< :: Flavour -> Flavour -> Bool
compare :: Flavour -> Flavour -> Ordering
$ccompare :: Flavour -> Flavour -> Ordering
$cp1Ord :: Eq Flavour
Ord, (forall x. Flavour -> Rep Flavour x)
-> (forall x. Rep Flavour x -> Flavour) -> Generic Flavour
forall x. Rep Flavour x -> Flavour
forall x. Flavour -> Rep Flavour x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Flavour x -> Flavour
$cfrom :: forall x. Flavour -> Rep Flavour x
Generic)

instance Enum Flavour where
  fromEnum :: Flavour -> Int
fromEnum Flavour{Color
FancyName
baseColor :: Color
fancyName :: FancyName
baseColor :: Flavour -> Color
fancyName :: Flavour -> FancyName
..} =
    Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (FancyName -> Int
forall a. Enum a => a -> Int
fromEnum FancyName
fancyName) Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Color -> Int
forall a. Enum a => a -> Int
fromEnum Color
baseColor
  toEnum :: Int -> Flavour
toEnum Int
n = FancyName -> Color -> Flavour
Flavour (Int -> FancyName
forall a. Enum a => Int -> a
toEnum (Int -> FancyName) -> Int -> FancyName
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftR Int
n Int
8)
                     (Int -> Color
forall a. Enum a => Int -> a
toEnum (Int -> Color) -> Int -> Color
forall a b. (a -> b) -> a -> b
$ Int
n Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. (Int
2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
8 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1))

instance Binary Flavour where
  put :: Flavour -> Put
put = Word16 -> Put
forall t. Binary t => t -> Put
put (Word16 -> Put) -> (Flavour -> Word16) -> Flavour -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Word16
forall a b. (Integral a, Integral b, Bits a, Bits b) => a -> b
toIntegralCrash :: Int -> Word16) (Int -> Word16) -> (Flavour -> Int) -> Flavour -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Flavour -> Int
forall a. Enum a => a -> Int
fromEnum
  get :: Get Flavour
get = (Word16 -> Flavour) -> Get Word16 -> Get Flavour
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Int -> Flavour
forall a. Enum a => Int -> a
toEnum (Int -> Flavour) -> (Word16 -> Int) -> Word16 -> Flavour
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word16 -> Int
forall target source. From source target => source -> target
into :: Word16 -> Int)) Get Word16
forall t. Binary t => Get t
get  -- @Int doesn't suffice

dummyFlavour :: Flavour
dummyFlavour :: Flavour
dummyFlavour = FancyName -> Color -> Flavour
Flavour FancyName
Story Color
Black

stdFlavList :: [Flavour]
stdFlavList :: [Flavour]
stdFlavList = [FancyName -> Color -> Flavour
Flavour FancyName
fn Color
bc | FancyName
fn <- [FancyName
forall a. Bounded a => a
minBound..FancyName
forall a. Bounded a => a
maxBound], Color
bc <- [Color]
stdCol]

-- | Turn a colour set into a flavour set.
zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy, zipStory :: [Color] -> [Flavour]
zipPlain :: [Color] -> [Flavour]
zipPlain = (Color -> Flavour) -> [Color] -> [Flavour]
forall a b. (a -> b) -> [a] -> [b]
map (FancyName -> Color -> Flavour
Flavour FancyName
Plain)
zipFancy :: [Color] -> [Flavour]
zipFancy = (Color -> Flavour) -> [Color] -> [Flavour]
forall a b. (a -> b) -> [a] -> [b]
map (FancyName -> Color -> Flavour
Flavour FancyName
Fancy)
zipLiquid :: [Color] -> [Flavour]
zipLiquid = (Color -> Flavour) -> [Color] -> [Flavour]
forall a b. (a -> b) -> [a] -> [b]
map (FancyName -> Color -> Flavour
Flavour FancyName
Liquid)
zipGlassPlain :: [Color] -> [Flavour]
zipGlassPlain = (Color -> Flavour) -> [Color] -> [Flavour]
forall a b. (a -> b) -> [a] -> [b]
map (FancyName -> Color -> Flavour
Flavour FancyName
GlassPlain)
zipGlassFancy :: [Color] -> [Flavour]
zipGlassFancy = (Color -> Flavour) -> [Color] -> [Flavour]
forall a b. (a -> b) -> [a] -> [b]
map (FancyName -> Color -> Flavour
Flavour FancyName
GlassFancy)
zipStory :: [Color] -> [Flavour]
zipStory = (Color -> Flavour) -> [Color] -> [Flavour]
forall a b. (a -> b) -> [a] -> [b]
map (FancyName -> Color -> Flavour
Flavour FancyName
Story)

-- | Get the underlying base colour of a flavour.
flavourToColor :: Flavour -> Color
flavourToColor :: Flavour -> Color
flavourToColor Flavour{Color
baseColor :: Color
baseColor :: Flavour -> Color
baseColor} = Color
baseColor

-- | Construct the full name of a flavour.
flavourToName :: Flavour -> Text
flavourToName :: Flavour -> Text
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
Plain, Color
baseColor :: Color
baseColor :: Flavour -> Color
..} = Color -> Text
colorToPlainName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
Fancy, Color
baseColor :: Color
baseColor :: Flavour -> Color
..} = Color -> Text
colorToFancyName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
Liquid, Color
baseColor :: Color
baseColor :: Flavour -> Color
..} = Color -> Text
colorToLiquidName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
GlassPlain, Color
baseColor :: Color
baseColor :: Flavour -> Color
..} =
  Color -> Text
colorToGlassPlainName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
GlassFancy, Color
baseColor :: Color
baseColor :: Flavour -> Color
..} =
  Color -> Text
colorToGlassFancyName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
Story, Color
baseColor :: Color
baseColor :: Flavour -> Color
..} =
  Color -> Text
colorToStoryName Color
baseColor

-- | Human-readable names for item colors. The plain set.
colorToPlainName :: Color -> Text
colorToPlainName :: Color -> Text
colorToPlainName Color
Black     = Text
"black"
colorToPlainName Color
Red       = Text
"red"
colorToPlainName Color
Green     = Text
"green"
colorToPlainName Color
Brown     = Text
"brown"
colorToPlainName Color
Blue      = Text
"blue"
colorToPlainName Color
Magenta   = Text
"purple"
colorToPlainName Color
Cyan      = Text
"cyan"
colorToPlainName Color
White     = Text
"ivory"
colorToPlainName Color
AltWhite  = String -> Text
forall a. HasCallStack => String -> a
error String
"colorToPlainName: illegal color"
colorToPlainName Color
BrBlack   = Text
"gray"
colorToPlainName Color
BrRed     = Text
"coral"
colorToPlainName Color
BrGreen   = Text
"lime"
colorToPlainName Color
BrYellow  = Text
"yellow"
colorToPlainName Color
BrBlue    = Text
"azure"
colorToPlainName Color
BrMagenta = Text
"pink"
colorToPlainName Color
BrCyan    = Text
"aquamarine"
colorToPlainName Color
BrWhite   = Text
"white"

-- | Human-readable names for item colors. The fancy set.
colorToFancyName :: Color -> Text
colorToFancyName :: Color -> Text
colorToFancyName Color
Black     = Text
"smoky-black"
colorToFancyName Color
Red       = Text
"apple-red"
colorToFancyName Color
Green     = Text
"forest-green"
colorToFancyName Color
Brown     = Text
"mahogany"
colorToFancyName Color
Blue      = Text
"royal-blue"
colorToFancyName Color
Magenta   = Text
"indigo"
colorToFancyName Color
Cyan      = Text
"teal"
colorToFancyName Color
White     = Text
"silver-gray"
colorToFancyName Color
AltWhite  = String -> Text
forall a. HasCallStack => String -> a
error String
"colorToFancyName: illegal color"
colorToFancyName Color
BrBlack   = Text
"charcoal"
colorToFancyName Color
BrRed     = Text
"salmon"
colorToFancyName Color
BrGreen   = Text
"emerald"
colorToFancyName Color
BrYellow  = Text
"amber"
colorToFancyName Color
BrBlue    = Text
"sky-blue"
colorToFancyName Color
BrMagenta = Text
"magenta"
colorToFancyName Color
BrCyan    = Text
"turquoise"
colorToFancyName Color
BrWhite   = Text
"ghost-white"

-- | Human-readable names for item colors. The liquid set.
colorToLiquidName :: Color -> Text
colorToLiquidName :: Color -> Text
colorToLiquidName Color
Black     = Text
"tarry"
colorToLiquidName Color
Red       = Text
"bloody"
colorToLiquidName Color
Green     = Text
"moldy"
colorToLiquidName Color
Brown     = Text
"muddy"
colorToLiquidName Color
Blue      = Text
"oily"
colorToLiquidName Color
Magenta   = Text
"swirling"
colorToLiquidName Color
Cyan      = Text
"bubbling"
colorToLiquidName Color
White     = Text
"cloudy"
colorToLiquidName Color
AltWhite  = String -> Text
forall a. HasCallStack => String -> a
error String
"colorToLiquidName: illegal color"
colorToLiquidName Color
BrBlack   = Text
"pitchy"
colorToLiquidName Color
BrRed     = Text
"red-speckled"
colorToLiquidName Color
BrGreen   = Text
"sappy"
colorToLiquidName Color
BrYellow  = Text
"golden"
colorToLiquidName Color
BrBlue    = Text
"blue-speckled"
colorToLiquidName Color
BrMagenta = Text
"hazy"
colorToLiquidName Color
BrCyan    = Text
"misty"
colorToLiquidName Color
BrWhite   = Text
"shining"

-- | Human-readable names for item colors. The plain glass set.
colorToGlassPlainName :: Color -> Text
colorToGlassPlainName :: Color -> Text
colorToGlassPlainName Color
color = Color -> Text
colorToPlainName Color
color Text -> Text -> Text
<+> Text
"glass"

-- | Human-readable names for item colors. The fancy glass set.
colorToGlassFancyName :: Color -> Text
colorToGlassFancyName :: Color -> Text
colorToGlassFancyName Color
color = Color -> Text
colorToFancyName Color
color Text -> Text -> Text
<+> Text
"crystal"

-- | Human-readable names for story item colors.
colorToStoryName :: Color -> Text
colorToStoryName :: Color -> Text
colorToStoryName Color
Black     = Text
"unfathomable"
colorToStoryName Color
Red       = Text
"depressing"
colorToStoryName Color
Green     = Text
"confidence-boosting"
colorToStoryName Color
Brown     = Text
"mundane"
colorToStoryName Color
Blue      = Text
"fleeting"
colorToStoryName Color
Magenta   = Text
"complex"
colorToStoryName Color
Cyan      = Text
"wierd"
colorToStoryName Color
White     = Text
"obvious"
colorToStoryName Color
AltWhite  = String -> Text
forall a. HasCallStack => String -> a
error String
"colorToStoryName: illegal color"
colorToStoryName Color
BrBlack   = Text
"inconclusive"
colorToStoryName Color
BrRed     = Text
"troubling"
colorToStoryName Color
BrGreen   = Text
"cherished"
colorToStoryName Color
BrYellow  = Text
"glaring"
colorToStoryName Color
BrBlue    = Text
"profound"
colorToStoryName Color
BrMagenta = Text
"torturous"
colorToStoryName Color
BrCyan    = Text
"peculiar"
colorToStoryName Color
BrWhite   = Text
"explosive"

-- | Simple names for team colors (bright colours preferred).
colorToTeamName :: Color -> Text
colorToTeamName :: Color -> Text
colorToTeamName Color
BrBlack   = Text
"black"
colorToTeamName Color
BrRed     = Text
"red"
colorToTeamName Color
BrGreen   = Text
"green"
colorToTeamName Color
BrYellow  = Text
"yellow"
colorToTeamName Color
BrBlue    = Text
"blue"
colorToTeamName Color
BrMagenta = Text
"pink"
colorToTeamName Color
BrCyan    = Text
"cyan"
colorToTeamName Color
BrWhite   = Text
"white"
colorToTeamName Color
c = Color -> Text
colorToFancyName Color
c