{-# LANGUAGE DeriveGeneric #-}
-- | The appearance of in-game items, as communicated to the player.
module Game.LambdaHack.Definition.Flavour
  ( -- * The @Flavour@ type
    Flavour(Flavour)
  , -- * Constructors
    zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy, zipStory
  , -- * 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{..} =
    Int -> Int -> Int
forall a. Bits a => a -> Int -> a
unsafeShiftL (FancyName -> Int
forall a. Enum a => a -> Int
fromEnum FancyName
fancyName) 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 n :: 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 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
.&. (2 Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^ (8 :: Int) Int -> Int -> Int
forall a. Num a => a -> a -> a
- 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 a b.
(Integral a, Integral b, IsIntSubType a b ~ 'True) =>
a -> b
intCast :: Word16 -> Int)) Get Word16
forall t. Binary t => Get t
get

-- | 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 -> Text
colorToPlainName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
Fancy, ..} = Color -> Text
colorToFancyName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
Liquid, ..} = Color -> Text
colorToLiquidName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
GlassPlain, ..} =
  Color -> Text
colorToGlassPlainName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
GlassFancy, ..} =
  Color -> Text
colorToGlassFancyName Color
baseColor
flavourToName Flavour{fancyName :: Flavour -> FancyName
fancyName=FancyName
Story, ..} =
  Color -> Text
colorToStoryName Color
baseColor

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

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

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

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

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

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

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