From c9cc52175073c5e690ea7eb30aad23d0d1776435 Mon Sep 17 00:00:00 2001 From: Chris Wells Date: Wed, 4 Dec 2024 13:23:40 -0600 Subject: Trying to write css --- src/WWW/Colors/Instances.hs | 12 ++++++------ 1 file changed, 6 insertions(+), 6 deletions(-) (limited to 'src/WWW/Colors/Instances.hs') 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 -- cgit v1.2.3