diff options
| author | Chris Wells <chris@mathematicaster.org> | 2025-02-03 16:24:25 -0600 |
|---|---|---|
| committer | Chris Wells <chris@mathematicaster.org> | 2025-02-03 16:24:25 -0600 |
| commit | f2a3c23634c7a5f8c23f68f24ff5dde95d472e16 (patch) | |
| tree | d60ac3cb766075a4d16a496a90f2726ef7b4d132 /src/WWW/Colors | |
| parent | c9cc52175073c5e690ea7eb30aad23d0d1776435 (diff) | |
| download | assets-f2a3c23634c7a5f8c23f68f24ff5dde95d472e16.tar assets-f2a3c23634c7a5f8c23f68f24ff5dde95d472e16.tar.gz assets-f2a3c23634c7a5f8c23f68f24ff5dde95d472e16.tar.bz2 assets-f2a3c23634c7a5f8c23f68f24ff5dde95d472e16.tar.lz assets-f2a3c23634c7a5f8c23f68f24ff5dde95d472e16.tar.xz assets-f2a3c23634c7a5f8c23f68f24ff5dde95d472e16.tar.zst assets-f2a3c23634c7a5f8c23f68f24ff5dde95d472e16.zip | |
Working on assets
Diffstat (limited to 'src/WWW/Colors')
| -rw-r--r-- | src/WWW/Colors/Instances.hs | 6 | ||||
| -rw-r--r-- | src/WWW/Colors/QQ.hs | 2 |
2 files changed, 6 insertions, 2 deletions
diff --git a/src/WWW/Colors/Instances.hs b/src/WWW/Colors/Instances.hs index 3fc7667..3dd6e6a 100644 --- a/src/WWW/Colors/Instances.hs +++ b/src/WWW/Colors/Instances.hs @@ -2,6 +2,7 @@ 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 @@ -13,7 +14,7 @@ instance Color Clay.Color where toAlphaColour col = case Clay.toRgba col of Clay.Rgba r g b a -> let rgb = sRGB24 (fromInteger r) (fromInteger g) (fromInteger b) - in alphaColourConvert $ withOpacity rgb a + in alphaColourConvert $ rgb `withOpacity` a _ -> error "Should not happen" fromAlphaColour :: AlphaColour Double -> Clay.Color @@ -21,3 +22,6 @@ instance Color Clay.Color where 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 diff --git a/src/WWW/Colors/QQ.hs b/src/WWW/Colors/QQ.hs index 281a93a..f1dc256 100644 --- a/src/WWW/Colors/QQ.hs +++ b/src/WWW/Colors/QQ.hs @@ -20,7 +20,7 @@ data Color' = Color' !Double !Double !Double !Double deriving Lift instance Color Color' where - toAlphaColour (Color' r g b a) = withOpacity (sRGB r g b) a + toAlphaColour (Color' r g b a) = sRGB r g b `withOpacity` a fromAlphaColour col = let a = alphaChannel col RGB r g b = toSRGB $ fromAlphaColour @(Colour Double) col |