{-# LANGUAGE DeriveGeneric #-}
module Game.LambdaHack.Definition.Flavour
(
Flavour(Flavour)
,
zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy, zipStory
,
flavourToColor, flavourToName
, colorToPlainName, colorToFancyName, colorToTeamName
#ifdef EXPOSE_INTERNAL
, 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)
data Flavour = Flavour
{ Flavour -> FancyName
fancyName :: FancyName
, Flavour -> Color
baseColor :: Color
}
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
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)
flavourToColor :: Flavour -> Color
flavourToColor :: Flavour -> Color
flavourToColor Flavour{Color
baseColor :: Color
baseColor :: Flavour -> Color
baseColor} = Color
baseColor
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
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"
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"
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"
colorToGlassPlainName :: Color -> Text
colorToGlassPlainName :: Color -> Text
colorToGlassPlainName color :: Color
color = Color -> Text
colorToPlainName Color
color Text -> Text -> Text
<+> "glass"
colorToGlassFancyName :: Color -> Text
colorToGlassFancyName :: Color -> Text
colorToGlassFancyName color :: Color
color = Color -> Text
colorToFancyName Color
color Text -> Text -> Text
<+> "crystal"
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"
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