{-# LANGUAGE CPP #-} {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE DeriveAnyClass #-} {-# LANGUAGE DeriveDataTypeable #-} {-# LANGUAGE DeriveFunctor #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PatternSynonyms #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE UndecidableInstances #-} {-# LANGUAGE ViewPatterns #-} -- | -- Module : Data.Array.Accelerate.Data.Colour.HSL -- Copyright : [2016..2020] Trevor L. McDonell -- License : BSD3 -- -- Maintainer : Trevor L. McDonell -- Stability : experimental -- Portability : non-portable (GHC extensions) -- -- Colours in the HSL (hue-saturation-lightness) cylindrical-coordinate -- representation of points in the RGB colour space. -- -- -- module Data.Array.Accelerate.Data.Colour.HSL ( Colour, HSL(..), pattern HSL_, hsl, clamp, toRGB, fromRGB, hue, saturation, lightness, ) where import Data.Array.Accelerate as A hiding ( clamp ) import Data.Array.Accelerate.Sugar.Elt import Data.Primitive.Vec import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..) ) import Data.Array.Accelerate.Data.Colour.Names as C import Data.Functor import Data.Typeable import qualified Prelude as P -- | A HSL colour value -- type Colour = HSL Float -- | Construct a HSL colour value from the individual channel components. The -- hue component is measured in degrees and wrapped to the range [0..360), while -- the saturation and value are clamped to the range [0..1]. -- hsl :: Exp Float -- ^ hue component -> Exp Float -- ^ saturation component -> Exp Float -- ^ lightness component -> Exp Colour hsl h s l = clamp $ lift (HSL h s l) clamp :: Exp Colour -> Exp Colour clamp (unlift -> HSL h s l) = lift $ HSL (fmod h 360) (c s) (c l) where c x = 0 `max` x `min` 1 fmod :: Exp Float -> Exp Float -> Exp Float fmod n d = n - f * d where f = fromIntegral (floor (n / d) :: Exp Int) -- | Convert a HSL colour to an RGB colour-space value -- toRGB :: Exp (HSL Float) -> Exp (RGB Float) toRGB (unlift -> HSL h s l) = rgb where c = (1 - abs (2*l-1)) * s h' = h / 60 x = c * (1 - abs ((h' `fmod` 2) - 1)) -- -- m = l - 0.5*c c' = c + m x' = x + m -- rgb = h' < 1 ? ( lift (RGB c' x' m) , h' < 2 ? ( lift (RGB x' c' m) , h' < 3 ? ( lift (RGB m c' x') , h' < 4 ? ( lift (RGB m x' c') , h' < 5 ? ( lift (RGB x' m c') , ( lift (RGB c' m x') )))))) -- | Convert a point in the RGB colour-space to a point in the HSL colour-space. -- fromRGB :: Exp (RGB Float) -> Exp (HSL Float) fromRGB (unlift -> RGB r g b) = lift (HSL h s l) where mx = P.maximum [r,g,b] mn = P.minimum [r,g,b] c = mx - mn -- l = 0.5 * (mx + mn) s = c == 0 ? ( 0, c / (1 - abs (2*l-1)) ) h = c == 0 ? ( 0, h0 * 60 ) -- h0 = mx == r ? ( ((g-b)/c) `fmod` 6 , mx == g ? ( ((b-r)/c) + 2 , mx == b ? ( ((r-g)/c) + 4 , {- otherwise -} 0 ))) -- | Return the HSL-hue of an RGB colour -- hue :: Exp (RGB Float) -> Exp Float hue (unlift . fromRGB -> HSL h _ _) = h -- | Return the HSL-saturation of an RGB colour -- saturation :: Exp (RGB Float) -> Exp Float saturation (unlift . fromRGB -> HSL _ s _) = s -- | Return the HSL-lightness of an RGB colour -- lightness :: Exp (RGB Float) -> Exp Float lightness (unlift . fromRGB -> HSL _ _ l) = l -- Accelerate bits -- --------------- -- HSL colour space -- data HSL a = HSL a a a deriving (P.Show, P.Eq, Functor, Typeable, Generic) pattern HSL_ :: (Elt (HSL a), Elt a, VecElt a, EltR (HSL a) ~ Vec3 a) => Exp a -> Exp a -> Exp a -> Exp (HSL a) pattern HSL_ h s l = V3 h s l {-# COMPLETE HSL_ #-} instance Elt (HSL Float) where type EltR (HSL Float) = Vec3 Float eltR = eltR @(Vec3 Float) tagsR = tagsR @(Vec3 Float) toElt (Vec3 r g b) = HSL r g b fromElt (HSL r g b) = Vec3 r g b instance Lift Exp (HSL (Exp Float)) where type Plain (HSL (Exp Float)) = HSL Float lift (HSL h s l) = HSL_ h s l instance Unlift Exp (HSL (Exp Float)) where unlift (HSL_ h s l) = HSL h s l instance P.Num a => P.Num (HSL a) where (+) (HSL h1 s1 v1 ) (HSL h2 s2 v2) = HSL (h1 + h2) (s1 + s2) (v1 + v2) (-) (HSL h1 s1 v1) (HSL h2 s2 v2) = HSL (h1 - h2) (s1 - s2) (v1 - v2) (*) (HSL h1 s1 v1) (HSL h2 s2 v2) = HSL (h1 * h2) (s1 * s2) (v1 * v2) abs (HSL h1 s1 v1) = HSL (abs h1) (abs s1) (abs v1) signum (HSL h1 s1 v1) = HSL (signum h1) (signum s1) (signum v1) fromInteger i = let f = P.fromInteger i in HSL f f f instance (P.Num a, P.Fractional a) => P.Fractional (HSL a) where (/) (HSL h1 s1 l1) (HSL h2 s2 l2) = HSL (h1/h2) (s1/s2) (l1/l2) recip (HSL h1 s1 l1) = HSL (recip h1) (recip s1) (recip l1) fromRational r = let f = P.fromRational r in HSL f f f instance (A.Num a, Unlift Exp (HSL (Exp a)), Plain (HSL (Exp a)) ~ HSL a) => P.Num (Exp (HSL a)) where (+) = lift2 ((+) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) (-) = lift2 ((-) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) (*) = lift2 ((*) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) abs = lift1 (abs :: HSL (Exp a) -> HSL (Exp a)) signum = lift1 (signum :: HSL (Exp a) -> HSL (Exp a)) fromInteger i = let f = P.fromInteger i :: Exp a in lift $ HSL f f f instance (A.Fractional a, Unlift Exp (HSL (Exp a)), Plain (HSL (Exp a)) ~ HSL a) => P.Fractional (Exp (HSL a)) where (/) = lift2 ((/) :: HSL (Exp a) -> HSL (Exp a) -> HSL (Exp a)) recip = lift1 (recip :: HSL (Exp a) -> HSL (Exp a)) fromRational r = let f = P.fromRational r :: Exp a in lift $ HSL f f f -- Named colours -- ------------- instance NamedColour (HSL Float) where -- Whites antiqueWhite = HSL 34.3044 0.7779 0.9118 azure = HSL 180.0000 1.0000 0.9706 bisque = HSL 32.5411 1.0000 0.8843 blanchedAlmond = HSL 36.0122 1.0000 0.9020 cornsilk = HSL 47.9825 1.0000 0.9314 eggshell = HSL 33.0000 0.9091 0.8900 floralWhite = HSL 40.0000 1.0000 0.9706 gainsboro = HSL 0.0000 0.0000 0.8627 ghostWhite = HSL 240.0000 1.0000 0.9863 honeydew = HSL 120.0000 1.0000 0.9706 ivory = HSL 60.0000 1.0000 0.9706 lavender = HSL 240.0000 0.6667 0.9412 lavenderBlush = HSL 340.0000 1.0000 0.9706 lemonChiffon = HSL 54.0031 1.0000 0.9020 linen = HSL 30.0000 0.6667 0.9412 mintCream = HSL 150.0000 1.0000 0.9804 mistyRose = HSL 5.9694 1.0000 0.9412 moccasin = HSL 38.1048 1.0000 0.8549 navajoWhite = HSL 35.8582 1.0000 0.8392 oldLace = HSL 39.1131 0.8526 0.9471 papayaWhip = HSL 37.1585 1.0000 0.9176 peachPuff = HSL 28.2842 1.0000 0.8628 seashell = HSL 24.7376 1.0000 0.9666 snow = HSL 0.0000 1.0000 0.9902 thistle = HSL 300.0000 0.2429 0.7981 titaniumWhite = HSL 70.0000 1.0000 0.9700 wheat = HSL 39.0881 0.7675 0.8314 white = HSL 0.0000 0.0000 1.0000 whiteSmoke = HSL 0.0000 0.0000 0.9608 zincWhite = HSL 280.0000 1.0000 0.9850 -- Greys coldGrey = HSL 164.9999 0.0417 0.5200 dimGrey = HSL 0.0000 0.0000 0.4118 grey = HSL 0.0000 0.0000 0.7529 lightGrey = HSL 0.0000 0.0000 0.8275 slateGrey = HSL 209.9761 0.1260 0.5020 slateGreyDark = HSL 180.0000 0.2540 0.2470 slateGreyLight = HSL 210.0225 0.1428 0.5334 warmGrey = HSL 60.0000 0.0989 0.4550 -- Blacks black = HSL 0.0000 0.0000 0.0000 ivoryBlack = HSL 20.0000 0.1034 0.1450 lampBlack = HSL 150.0000 0.2174 0.2300 -- Reds alizarinCrimson = HSL 355.1351 0.7708 0.5200 brick = HSL 34.2857 0.6712 0.3650 cadmiumRedDeep = HSL 2.8571 0.8936 0.4700 coral = HSL 16.1125 1.0000 0.6568 coralLight = HSL 0.0000 0.7888 0.7216 deepPink = HSL 327.5716 1.0000 0.5392 englishRed = HSL 11.5068 0.7849 0.4650 firebrick = HSL 0.0000 0.6793 0.4156 geraniumLake = HSL 351.2195 0.8542 0.4800 hotPink = HSL 330.0000 1.0000 0.7059 indianRed = HSL 357.0000 0.7692 0.3900 lightSalmon = HSL 17.1511 1.0000 0.7392 madderLakeDeep = HSL 359.1549 0.7634 0.5350 maroon = HSL 337.4940 0.5715 0.4392 pink = HSL 349.5103 1.0000 0.8764 pinkLight = HSL 350.9466 1.0000 0.8568 raspberry = HSL 330.0000 0.5588 0.3400 red = HSL 0.0000 1.0000 0.5000 roseMadder = HSL 359.1177 0.7556 0.5500 salmon = HSL 6.1766 0.9315 0.7138 tomato = HSL 9.1297 1.0000 0.6392 venetianRed = HSL 358.3562 0.7849 0.4650 -- Browns beige = HSL 34.2857 0.1628 0.5700 brown = HSL 0.0000 0.5044 0.3324 brownMadder = HSL 0.0000 0.7143 0.5100 brownOchre = HSL 20.4878 0.6308 0.3250 burlywood = HSL 33.7984 0.5687 0.7000 burntSienna = HSL 18.7500 0.8000 0.3000 burntUmber = HSL 9.0000 0.5882 0.3400 chocolate = HSL 25.0064 0.7501 0.4706 deepOchre = HSL 24.0000 0.6364 0.2750 flesh = HSL 19.2000 1.0000 0.6250 fleshOchre = HSL 14.4828 1.0000 0.5650 goldOchre = HSL 30.4762 0.6774 0.4650 greenishUmber = HSL 12.0000 1.0000 0.5250 khaki = HSL 54.0031 0.7693 0.7451 khakiDark = HSL 55.5970 0.3832 0.5804 lightBeige = HSL 60.0000 0.5558 0.9117 peru = HSL 29.5797 0.5867 0.5255 rosyBrown = HSL 0.0000 0.2515 0.6490 rawSienna = HSL 25.7143 0.8140 0.4300 rawUmber = HSL 34.7368 0.7308 0.2600 sepia = HSL 16.0000 0.6818 0.2200 sienna = HSL 19.3038 0.5609 0.4020 saddleBrown = HSL 25.0021 0.7595 0.3098 sandyBrown = HSL 27.5603 0.8707 0.6667 tan = HSL 34.2951 0.4375 0.6862 vanDykeBrown = HSL 22.2857 0.8974 0.1950 -- Oranges cadmiumOrange = HSL 22.4242 1.0000 0.5050 cadmiumRedLight = HSL 357.5758 1.0000 0.5050 carrot = HSL 33.0000 0.8511 0.5300 darkOrange = HSL 32.9400 1.0000 0.5000 marsOrange = HSL 22.3529 0.7612 0.3350 marsYellow = HSL 25.8228 0.7980 0.4950 orange = HSL 30.0000 1.0000 0.5000 orangeRed = HSL 16.2360 1.0000 0.5000 yellowOchre = HSL 31.5000 0.8163 0.4900 -- Yellows aureolineYellow = HSL 36.2791 1.0000 0.5700 banana = HSL 51.2727 0.7143 0.6150 cadmiumLemon = HSL 53.3333 1.0000 0.5050 cadmiumYellow = HSL 34.1936 1.0000 0.5350 gold = HSL 50.5860 1.0000 0.5000 goldenrod = HSL 42.9065 0.7440 0.4902 goldenrodDark = HSL 42.6588 0.8873 0.3824 goldenrodLight = HSL 60.0000 0.8001 0.9020 goldenrodPale = HSL 54.7112 0.6665 0.8000 lightGoldenrod = HSL 50.5643 0.7605 0.7216 melon = HSL 31.2500 0.6857 0.6500 naplesYellowDeep = HSL 38.0645 1.0000 0.5350 yellow = HSL 60.0000 1.0000 0.5000 yellowLight = HSL 60.0000 1.0000 0.9392 -- Greens chartreuse = HSL 90.1200 1.0000 0.5000 chromeoxideGreen = HSL 74.2857 0.7241 0.2900 cinnabarGreen = HSL 95.5556 0.6279 0.4300 cobaltGreen = HSL 121.8182 0.4074 0.4050 emeraldGreen = HSL 145.8228 1.0000 0.3950 forestGreen = HSL 120.0000 0.6070 0.3392 green = HSL 120.0000 1.0000 0.5000 greenDark = HSL 120.0000 1.0000 0.1961 greenPale = HSL 120.0000 0.9252 0.7902 greenYellow = HSL 83.6558 1.0000 0.5922 lawnGreen = HSL 90.4736 1.0000 0.4941 limeGreen = HSL 120.0000 0.6078 0.5000 mint = HSL 132.0000 0.9259 0.8650 olive = HSL 102.0000 0.3704 0.2700 oliveDrab = HSL 79.6330 0.6044 0.3471 oliveGreenDark = HSL 82.0060 0.3896 0.3020 permanentGreen = HSL 130.4000 0.9036 0.4150 sapGreen = HSL 104.2857 0.7241 0.2900 seaGreen = HSL 146.4546 0.5027 0.3628 seaGreenDark = HSL 120.0000 0.2515 0.6490 seaGreenMedium = HSL 146.7152 0.4979 0.4686 seaGreenLight = HSL 176.7196 0.6952 0.4118 springGreen = HSL 149.8800 1.0000 0.5000 springGreenMedium = HSL 156.9584 1.0000 0.4902 terreVerte = HSL 89.0323 0.7209 0.2150 viridianLight = HSL 121.0526 1.0000 0.7150 yellowGreen = HSL 79.7433 0.6078 0.5000 -- Cyans aquamarine = HSL 159.8486 1.0000 0.7490 aquamarineMedium = HSL 159.6187 0.5073 0.6020 cyan = HSL 180.0000 1.0000 0.5000 cyanWhite = HSL 180.0000 1.0000 0.9392 turquoise = HSL 174.0038 0.7207 0.5647 turquoiseDark = HSL 180.8638 1.0000 0.4098 turquoiseMedium = HSL 177.8109 0.5982 0.5510 turquoisePale = HSL 180.0000 0.6493 0.8098 -- Blues aliceBlue = HSL 208.0612 1.0000 0.9706 blue = HSL 240.0000 1.0000 0.5000 blueLight = HSL 194.7317 0.5329 0.7902 blueMedium = HSL 240.0000 1.0000 0.4020 cadet = HSL 181.8588 0.2550 0.5000 cobalt = HSL 224.6512 0.4725 0.4550 cornflower = HSL 218.5443 0.7919 0.6608 cerulean = HSL 186.1538 0.9512 0.4100 dodgerBlue = HSL 209.5988 1.0000 0.5588 indigo = HSL 210.0000 0.8333 0.1800 manganeseBlue = HSL 176.3077 0.9701 0.3350 midnightBlue = HSL 240.0000 0.6351 0.2686 navy = HSL 240.0000 1.0000 0.2510 peacock = HSL 196.2712 0.5960 0.4950 powderBlue = HSL 186.6856 0.5194 0.7961 royalBlue = HSL 224.9976 0.7274 0.5686 slateBlue = HSL 248.3548 0.5349 0.5784 slateBlueDark = HSL 248.4733 0.3900 0.3921 slateBlueLight = HSL 248.3880 1.0000 0.7196 slateBlueMedium = HSL 248.5176 0.7975 0.6706 skyBlue = HSL 197.4095 0.7144 0.7255 skyBlueDeep = HSL 195.0600 1.0000 0.5000 skyBlueLight = HSL 202.9623 0.9200 0.7549 steelBlue = HSL 207.2740 0.4400 0.4902 steelBlueLight = HSL 213.9246 0.4107 0.7804 turquoiseBlue = HSL 162.3077 1.0000 0.3900 ultramarine = HSL 243.4616 0.8667 0.3000 -- Magentas blueViolet = HSL 271.1495 0.7594 0.5274 cobaltVioletDeep = HSL 293.8776 0.6533 0.3750 magenta = HSL 300.0000 1.0000 0.5000 orchid = HSL 302.2660 0.5889 0.6470 orchidDark = HSL 280.1292 0.6063 0.4980 orchidMedium = HSL 288.0898 0.5889 0.5804 permanentViolet = HSL 349.8592 0.7172 0.5050 plum = HSL 300.0000 0.4729 0.7471 purple = HSL 276.9253 0.8740 0.5334 purpleMedium = HSL 259.6330 0.5977 0.6490 ultramarineViolet = HSL 285.5172 0.5088 0.2850 violet = HSL 289.5652 0.2371 0.4850 violetDark = HSL 282.0834 1.0000 0.4138 violetRed = HSL 321.8198 0.7333 0.4706 violetRedMedium = HSL 322.2464 0.8090 0.4314 violetRedPale = HSL 340.3670 0.5977 0.6490