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
179
180
|
-- | Predefined and custom colors.
module Graphics.Gloss.Data.Color
( -- ** Color data type
Color
, makeColor
, makeColorI
, rgbaOfColor
-- ** Color functions
, mixColors
, addColors
, dim, bright
, light, dark
, withRed
, withGreen
, withBlue
, withAlpha
-- ** Pre-defined colors
, greyN, black, white
-- *** Primary
, red, green, blue
-- *** Secondary
, yellow, cyan, magenta
-- *** Tertiary
, rose, violet, azure, aquamarine, chartreuse, orange
)
where
import Graphics.Gloss.Rendering
-- Color functions ------------------------------------------------------------
-- | Mix two colors with the given ratios.
mixColors
:: Float -- ^ Proportion of first color.
-> Float -- ^ Proportion of second color.
-> Color -- ^ First color.
-> Color -- ^ Second color.
-> Color -- ^ Resulting color.
mixColors m1 m2 c1 c2
= let (r1, g1, b1, a1) = rgbaOfColor c1
(r2, g2, b2, a2) = rgbaOfColor c2
-- Normalise mixing proportions to ratios.
m12 = m1 + m2
m1' = m1 / m12
m2' = m2 / m12
-- Colors components should be added via sum of squares,
-- otherwise the result will be too dark.
r1s = r1 * r1; r2s = r2 * r2
g1s = g1 * g1; g2s = g2 * g2
b1s = b1 * b1; b2s = b2 * b2
in makeColor
(sqrt (m1' * r1s + m2' * r2s))
(sqrt (m1' * g1s + m2' * g2s))
(sqrt (m1' * b1s + m2' * b2s))
((m1 * a1 + m2 * a2) / m12)
-- | Add RGB components of a color component-wise,
-- then normalise them to the highest resulting one.
-- The alpha components are averaged.
addColors :: Color -> Color -> Color
addColors c1 c2
= let (r1, g1, b1, a1) = rgbaOfColor c1
(r2, g2, b2, a2) = rgbaOfColor c2
in normalizeColor
(r1 + r2)
(g1 + g2)
(b1 + b2)
((a1 + a2) / 2)
-- | Make a dimmer version of a color, scaling towards black.
dim :: Color -> Color
dim c
= let (r, g, b, a) = rgbaOfColor c
in makeColor (r / 1.2) (g / 1.2) (b / 1.2) a
-- | Make a brighter version of a color, scaling towards white.
bright :: Color -> Color
bright c
= let (r, g, b, a) = rgbaOfColor c
in makeColor (r * 1.2) (g * 1.2) (b * 1.2) a
-- | Lighten a color, adding white.
light :: Color -> Color
light c
= let (r, g, b, a) = rgbaOfColor c
in makeColor (r + 0.2) (g + 0.2) (b + 0.2) a
-- | Darken a color, adding black.
dark :: Color -> Color
dark c
= let (r, g, b, a) = rgbaOfColor c
in makeColor (r - 0.2) (g - 0.2) (b - 0.2) a
-------------------------------------------------------------------------------
-- | Set the red value of a `Color`.
withRed :: Float -> Color -> Color
withRed r c
= let (_, g, b, a) = rgbaOfColor c
in makeColor r g b a
-- | Set the green value of a `Color`.
withGreen :: Float -> Color -> Color
withGreen g c
= let (r, _, b, a) = rgbaOfColor c
in makeColor r g b a
-- | Set the blue value of a `Color`.
withBlue :: Float -> Color -> Color
withBlue b c
= let (r, g, _, a) = rgbaOfColor c
in makeColor r g b a
-- | Set the alpha value of a `Color`.
withAlpha :: Float -> Color -> Color
withAlpha a c
= let (r, g, b, _) = rgbaOfColor c
in makeColor r g b a
-- Pre-defined Colors ---------------------------------------------------------
-- | A greyness of a given order.
--
-- Range is 0 = black, to 1 = white.
greyN :: Float -> Color
greyN n = makeRawColor n n n 1.0
black, white :: Color
black = makeRawColor 0.0 0.0 0.0 1.0
white = makeRawColor 1.0 1.0 1.0 1.0
-- Colors from the additive color wheel.
red, green, blue :: Color
red = makeRawColor 1.0 0.0 0.0 1.0
green = makeRawColor 0.0 1.0 0.0 1.0
blue = makeRawColor 0.0 0.0 1.0 1.0
-- secondary
yellow, cyan, magenta :: Color
yellow = addColors red green
cyan = addColors green blue
magenta = addColors red blue
-- tertiary
rose, violet, azure, aquamarine, chartreuse, orange :: Color
rose = addColors red magenta
violet = addColors magenta blue
azure = addColors blue cyan
aquamarine = addColors cyan green
chartreuse = addColors green yellow
orange = addColors yellow red
-------------------------------------------------------------------------------
-- | Normalise a color to the value of its largest RGB component.
normalizeColor :: Float -> Float -> Float -> Float -> Color
normalizeColor r g b a
= let m = maximum [r, g, b]
in makeColor (r / m) (g / m) (b / m) a
|
