diff options
Diffstat (limited to 'src/WWW/Colors/Instances.hs')
| -rw-r--r-- | src/WWW/Colors/Instances.hs | 12 |
1 files changed, 6 insertions, 6 deletions
diff --git a/src/WWW/Colors/Instances.hs b/src/WWW/Colors/Instances.hs index e071b6b..3fc7667 100644 --- a/src/WWW/Colors/Instances.hs +++ b/src/WWW/Colors/Instances.hs @@ -1,23 +1,23 @@ +{-# OPTIONS_GHC -fno-warn-orphans #-} 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) +-- | 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 withOpacity rgb (float2Double a) + in alphaColourConvert $ withOpacity rgb 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) + let a = alphaChannel $ alphaColourConvert col + RGB r g b = toInteger <$> toSRGB24 (fromAlphaColour @(Colour Double) col) + in Clay.rgba r g b a |