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
|
{-# LANGUAGE DeriveDataTypeable #-}
{-# OPTIONS_HADDOCK hide #-}
-- | Data type for representing colors.
module Graphics.Gloss.Internals.Data.Color
( Color (..)
, makeColor
, makeColorI
, makeRawColor
, makeRawColorI
, rgbaOfColor
, clampColor)
where
import Data.Data
-- | An abstract color value.
-- We keep the type abstract so we can be sure that the components
-- are in the required range. To make a custom color use 'makeColor'.
data Color
-- | Holds the color components. All components lie in the range [0..1.
= RGBA !Float !Float !Float !Float
deriving (Show, Eq, Data, Typeable)
instance Num Color where
(+) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)
= RGBA (r1 + r2) (g1 + g2) (b1 + b2) 1
{-# INLINE (+) #-}
(-) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)
= RGBA (r1 - r2) (g1 - g2) (b1 - b2) 1
{-# INLINE (-) #-}
(*) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _)
= RGBA (r1 * r2) (g1 * g2) (b1 * b2) 1
{-# INLINE (*) #-}
abs (RGBA r1 g1 b1 _)
= RGBA (abs r1) (abs g1) (abs b1) 1
{-# INLINE abs #-}
signum (RGBA r1 g1 b1 _)
= RGBA (signum r1) (signum g1) (signum b1) 1
{-# INLINE signum #-}
fromInteger i
= let f = fromInteger i
in RGBA f f f 1
{-# INLINE fromInteger #-}
-- | Make a custom color. All components are clamped to the range [0..1].
makeColor
:: Float -- ^ Red component.
-> Float -- ^ Green component.
-> Float -- ^ Blue component.
-> Float -- ^ Alpha component.
-> Color
makeColor r g b a
= clampColor
$ RGBA r g b a
{-# INLINE makeColor #-}
-- | Make a custom color. All components are clamped to the range [0..255].
makeColorI :: Int -> Int -> Int -> Int -> Color
makeColorI r g b a
= clampColor
$ RGBA (fromIntegral r / 255)
(fromIntegral g / 255)
(fromIntegral b / 255)
(fromIntegral a / 255)
{-# INLINE makeColorI #-}
-- | Make a custom color.
--
-- Using this function over `makeColor` avoids clamping the components,
-- which saves time. However, if the components are out of range then
-- this will result in integer overflow at rendering time, and the actual
-- picture you get will be implementation dependent.
--
-- You'll only need to use this function when using the @gloss-raster@
-- package that builds a new color for every pixel. If you're just working
-- with the Picture data type then it there is no need for raw colors.
--
makeRawColor :: Float -> Float -> Float -> Float -> Color
makeRawColor r g b a
= RGBA r g b a
{-# INLINE makeRawColor #-}
-- | Make a custom color, taking pre-clamped components.
makeRawColorI :: Int -> Int -> Int -> Int -> Color
makeRawColorI r g b a
= RGBA (fromIntegral r / 255)
(fromIntegral g / 255)
(fromIntegral b / 255)
(fromIntegral a / 255)
{-# INLINE makeRawColorI #-}
-- | Take the RGBA components of a color.
rgbaOfColor :: Color -> (Float, Float, Float, Float)
rgbaOfColor (RGBA r g b a) = (r, g, b, a)
{-# INLINE rgbaOfColor #-}
-- | Clamp components of a raw color into the required range.
clampColor :: Color -> Color
clampColor cc
= let (r, g, b, a) = rgbaOfColor cc
clamp x = (min (max x 0.0) 1.0)
in RGBA (clamp r) (clamp g) (clamp b) (clamp a)
|
