1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
|
{-# 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 ((.&.))
import GHC.Generics (Generic)
import Game.LambdaHack.Definition.Color
data FancyName = Plain | Fancy | Liquid | GlassPlain | GlassFancy | Story
deriving (Show, Eq, Ord, Enum, Bounded, Generic)
-- | The type of item flavours.
data Flavour = Flavour
{ fancyName :: FancyName -- ^ how fancy should the colour description be
, baseColor :: Color -- ^ the colour of the flavour
}
deriving (Show, Eq, Ord, Generic)
instance Enum Flavour where
fromEnum Flavour{..} =
unsafeShiftL (fromEnum fancyName) 8 + fromEnum baseColor
toEnum n = Flavour (toEnum $ unsafeShiftR n 8)
(toEnum $ n .&. (2 ^ (8 :: Int) - 1))
instance Binary Flavour where
put = put . (toIntegralCrash :: Int -> Word16) . fromEnum
get = fmap (toEnum . (into :: Word16 -> Int)) get -- @Int doesn't suffice
dummyFlavour :: Flavour
dummyFlavour = Flavour Story Black
stdFlavList :: [Flavour]
stdFlavList = [Flavour fn bc | fn <- [minBound..maxBound], bc <- stdCol]
-- | Turn a colour set into a flavour set.
zipPlain, zipFancy, zipLiquid, zipGlassPlain, zipGlassFancy, zipStory :: [Color] -> [Flavour]
zipPlain = map (Flavour Plain)
zipFancy = map (Flavour Fancy)
zipLiquid = map (Flavour Liquid)
zipGlassPlain = map (Flavour GlassPlain)
zipGlassFancy = map (Flavour GlassFancy)
zipStory = map (Flavour Story)
-- | Get the underlying base colour of a flavour.
flavourToColor :: Flavour -> Color
flavourToColor Flavour{baseColor} = baseColor
-- | Construct the full name of a flavour.
flavourToName :: Flavour -> Text
flavourToName Flavour{fancyName=Plain, ..} = colorToPlainName baseColor
flavourToName Flavour{fancyName=Fancy, ..} = colorToFancyName baseColor
flavourToName Flavour{fancyName=Liquid, ..} = colorToLiquidName baseColor
flavourToName Flavour{fancyName=GlassPlain, ..} =
colorToGlassPlainName baseColor
flavourToName Flavour{fancyName=GlassFancy, ..} =
colorToGlassFancyName baseColor
flavourToName Flavour{fancyName=Story, ..} =
colorToStoryName baseColor
-- | Human-readable names for item colors. The plain set.
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 = 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 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 = 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 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 = 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 = colorToPlainName color <+> "glass"
-- | Human-readable names for item colors. The fancy glass set.
colorToGlassFancyName :: Color -> Text
colorToGlassFancyName color = colorToFancyName color <+> "crystal"
-- | Human-readable names for story item colors.
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 = 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 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 = colorToFancyName c
|
