blob: 3dd6e6aac67137136f74e91f49cb3d23a18be67f (
plain)
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
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
module WWW.Colors.Instances where
import Clay.Color qualified as Clay
import Clay.Property qualified as Clay
import Data.Colour
import Data.Colour.SRGB (toSRGB24, sRGB24, RGB (..))
import Diagrams.Attributes
-- | Not perfect, but good enough for building what I need
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 alphaColourConvert $ rgb `withOpacity` a
_ -> error "Should not happen"
fromAlphaColour :: AlphaColour Double -> Clay.Color
fromAlphaColour col =
let a = alphaChannel $ alphaColourConvert col
RGB r g b = toInteger <$> toSRGB24 (fromAlphaColour @(Colour Double) col)
in Clay.rgba r g b a
instance Clay.Val SomeColor where
value = Clay.value . fromAlphaColour @Clay.Color . someToAlpha
|
