blob: e071b6b2634abe2574e64cb1f4fb0c7beb2fa44d (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
|
module WWW.Colors.Instances where
import Clay.Color qualified as Clay
import Data.Colour
import Data.Colour.SRGB (toSRGB24, sRGB24, RGB (..))
import Diagrams.Attributes
import GHC.Float (double2Float, float2Double)
instance Color Clay.Color where
toAlphaColour :: Clay.Color -> AlphaColour Double
toAlphaColour col = case Clay.toRgba col of
Clay.Rgba r g b a ->
let rgb = sRGB24 (fromInteger r) (fromInteger g) (fromInteger b)
in withOpacity rgb (float2Double a)
_ -> error "Should not happen"
fromAlphaColour :: AlphaColour Double -> Clay.Color
fromAlphaColour col =
let c = fromAlphaColour col :: Colour Double
a = alphaChannel col
rgb = toInteger <$> toSRGB24 c
in Clay.rgba (channelRed rgb) (channelGreen rgb) (channelBlue rgb) (double2Float a)
|
