diff --git a/Data/Array/Accelerate/Data/Colour/HSL.hs b/Data/Array/Accelerate/Data/Colour/HSL.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Colour/HSL.hs @@ -0,0 +1,438 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} +#if __GLASGOW_HASKELL__ <= 708 +{-# LANGUAGE OverlappingInstances #-} +{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-} +#endif +-- | +-- Module : Data.Array.Accelerate.Data.Colour.HSL +-- Copyright : [2016] 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(..), + + hsl, + clamp, + toRGB, fromRGB, + hue, + saturation, + lightness, + +) where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Smart +import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) ) +import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, Tuple(..) ) + +import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..) ) +import Data.Array.Accelerate.Data.Colour.Names as C + +import Data.Functor +import Data.Typeable +import Prelude ( fromInteger ) -- ghc < 8 bug +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) + +-- Represent colours in Accelerate as a 3-tuple +-- +type instance EltRepr (HSL a) = EltRepr (a, a, a) + +instance Elt a => Elt (HSL a) where + eltType (_ :: HSL a) = eltType (undefined :: (a,a,a)) + toElt c = let (h,s,l) = toElt c in HSL h s l + fromElt (HSL h s l) = fromElt (h,s,l) + +instance Elt a => IsProduct Elt (HSL a) where + type ProdRepr (HSL a) = ((((),a), a), a) + fromProd _ (HSL h s l) = ((((), h), s), l) + toProd _ ((((),h),s),l) = HSL h s l + prod cst _ = prod cst (undefined :: (a,a,a)) + +instance (Lift Exp a, Elt (Plain a)) => Lift Exp (HSL a) where + type Plain (HSL a) = HSL (Plain a) + lift (HSL h s l) = Exp . Tuple $ NilTup `SnocTup` lift h `SnocTup` lift s `SnocTup` lift l + +instance Elt a => Unlift Exp (HSL (Exp a)) where + unlift c = let h = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c + s = Exp $ SuccTupIdx ZeroTupIdx `Prj` c + l = Exp $ ZeroTupIdx `Prj` c + in 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 = 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 = fromRational r + in HSL f f f + + +instance {-# OVERLAPS #-} A.Num 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 = fromInteger i :: Exp a + in lift $ HSL f f f + +instance {-# OVERLAPS #-} A.Fractional 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 = 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 + diff --git a/Data/Array/Accelerate/Data/Colour/HSV.hs b/Data/Array/Accelerate/Data/Colour/HSV.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Colour/HSV.hs @@ -0,0 +1,438 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} +#if __GLASGOW_HASKELL__ <= 708 +{-# LANGUAGE OverlappingInstances #-} +{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-} +#endif +-- | +-- Module : Data.Array.Accelerate.Data.Colour.HSV +-- Copyright : [2016] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +-- Colours in the HSV (hue-saturation-value) cylindrical-coordinate +-- representation of points in the RGB colour space. +-- + +module Data.Array.Accelerate.Data.Colour.HSV ( + + Colour, + HSV(..), + + hsv, + clamp, + toRGB, fromRGB, + hue, + saturation, + value, + +) where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Smart +import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) ) +import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, Tuple(..) ) + +import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..) ) +import Data.Array.Accelerate.Data.Colour.Names as C + +import Data.Functor +import Data.Typeable +import Prelude ( fromInteger ) -- ghc < 8 bug +import qualified Prelude as P + + +-- | A HSV colour value +-- +type Colour = HSV Float + +-- | Construct a HSV 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]. +-- +hsv :: Exp Float -- ^ hue component + -> Exp Float -- ^ saturation component + -> Exp Float -- ^ value component + -> Exp Colour +hsv h s v + = clamp + $ lift (HSV h s v) + + +clamp :: Exp Colour -> Exp Colour +clamp (unlift -> HSV h s v) + = lift + $ HSV (fmod h 360) (c s) (c v) + 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 HSV colour to an RGB colour-space value +-- +toRGB :: Exp (HSV Float) -> Exp (RGB Float) +toRGB (unlift -> HSV h s v) = rgb + where + c = v * s + h' = h / 60 + x = c * (1 - abs ((h' `fmod` 2) - 1)) + -- + m = v - 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 HSV colour-space. +-- +fromRGB :: Exp (RGB Float) -> Exp (HSV Float) +fromRGB (unlift -> RGB r g b) = lift (HSV h s v) + where + mx = P.maximum [r,g,b] + mn = P.minimum [r,g,b] + c = mx - mn + -- + v = mx + s = c == 0 ? ( 0, c / mx ) + 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 HSV-hue of an RGB colour +-- +hue :: Exp (RGB Float) -> Exp Float +hue (unlift . fromRGB -> HSV h _ _) = h + +-- | Return the HSV-saturation of an RGB colour +-- +saturation :: Exp (RGB Float) -> Exp Float +saturation (unlift . fromRGB -> HSV _ s _) = s + +-- | Return the HSV-value of an RGB colour +-- +value :: Exp (RGB Float) -> Exp Float +value (unlift . fromRGB -> HSV _ _ v) = v + + +-- Accelerate bits +-- --------------- + +-- HSV colour space +-- +data HSV a = HSV a a a + deriving (P.Show, P.Eq, Functor, Typeable) + +-- Represent colours in Accelerate as a 3-tuple +-- +type instance EltRepr (HSV a) = EltRepr (a, a, a) + +instance Elt a => Elt (HSV a) where + eltType (_ :: HSV a) = eltType (undefined :: (a,a,a)) + toElt c = let (h,s,v) = toElt c in HSV h s v + fromElt (HSV h s v) = fromElt (h,s,v) + +instance Elt a => IsProduct Elt (HSV a) where + type ProdRepr (HSV a) = ((((),a), a), a) + fromProd _ (HSV h s v) = ((((), h), s), v) + toProd _ ((((),h),s),v) = HSV h s v + prod cst _ = prod cst (undefined :: (a,a,a)) + +instance (Lift Exp a, Elt (Plain a)) => Lift Exp (HSV a) where + type Plain (HSV a) = HSV (Plain a) + lift (HSV h s v) = Exp . Tuple $ NilTup `SnocTup` lift h `SnocTup` lift s `SnocTup` lift v + +instance Elt a => Unlift Exp (HSV (Exp a)) where + unlift c = let h = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c + s = Exp $ SuccTupIdx ZeroTupIdx `Prj` c + v = Exp $ ZeroTupIdx `Prj` c + in HSV h s v + +instance P.Num a => P.Num (HSV a) where + (+) (HSV h1 s1 v1 ) (HSV h2 s2 v2) + = HSV (h1 + h2) (s1 + s2) (v1 + v2) + + (-) (HSV h1 s1 v1) (HSV h2 s2 v2) + = HSV (h1 - h2) (s1 - s2) (v1 - v2) + + (*) (HSV h1 s1 v1) (HSV h2 s2 v2) + = HSV (h1 * h2) (s1 * s2) (v1 * v2) + + abs (HSV h1 s1 v1) + = HSV (abs h1) (abs s1) (abs v1) + + signum (HSV h1 s1 v1) + = HSV (signum h1) (signum s1) (signum v1) + + fromInteger i + = let f = fromInteger i + in HSV f f f + +instance (P.Num a, P.Fractional a) => P.Fractional (HSV a) where + (/) (HSV h1 s1 v1) (HSV h2 s2 v2) + = HSV (h1/h2) (s1/s2) (v1/v2) + + recip (HSV h1 s1 v1) + = HSV (recip h1) (recip s1) (recip v1) + + fromRational r + = let f = fromRational r + in HSV f f f + + +instance {-# OVERLAPS #-} A.Num a => P.Num (Exp (HSV a)) where + (+) = lift2 ((+) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) + (-) = lift2 ((-) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) + (*) = lift2 ((*) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) + abs = lift1 (abs :: HSV (Exp a) -> HSV (Exp a)) + signum = lift1 (signum :: HSV (Exp a) -> HSV (Exp a)) + fromInteger i = let f = fromInteger i :: Exp a + in lift $ HSV f f f + +instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (HSV a)) where + (/) = lift2 ((/) :: HSV (Exp a) -> HSV (Exp a) -> HSV (Exp a)) + recip = lift1 (recip :: HSV (Exp a) -> HSV (Exp a)) + fromRational r = let f = fromRational r :: Exp a + in lift $ HSV f f f + + +-- Named colours +-- ------------- + +instance NamedColour (HSV Float) where + -- Whites + antiqueWhite = HSV 34.3044 0.1400 0.9804 + azure = HSV 180.0000 0.0588 1.0000 + bisque = HSV 32.5411 0.2314 1.0000 + blanchedAlmond = HSV 36.0122 0.1961 1.0000 + cornsilk = HSV 47.9825 0.1373 1.0000 + eggshell = HSV 33.0000 0.2020 0.9900 + floralWhite = HSV 40.0000 0.0588 1.0000 + gainsboro = HSV 0.0000 0.0000 0.8627 + ghostWhite = HSV 240.0000 0.0275 1.0000 + honeydew = HSV 120.0000 0.0588 1.0000 + ivory = HSV 60.0000 0.0588 1.0000 + lavender = HSV 240.0000 0.0800 0.9804 + lavenderBlush = HSV 340.0000 0.0588 1.0000 + lemonChiffon = HSV 54.0031 0.1961 1.0000 + linen = HSV 30.0000 0.0800 0.9804 + mintCream = HSV 150.0000 0.0392 1.0000 + mistyRose = HSV 5.9694 0.1176 1.0000 + moccasin = HSV 38.1048 0.2902 1.0000 + navajoWhite = HSV 35.8582 0.3216 1.0000 + oldLace = HSV 39.1131 0.0909 0.9922 + papayaWhip = HSV 37.1585 0.1647 1.0000 + peachPuff = HSV 28.2842 0.2745 1.0000 + seashell = HSV 24.7376 0.0667 1.0000 + snow = HSV 0.0000 0.0196 1.0000 + thistle = HSV 300.0000 0.1158 0.8471 + titaniumWhite = HSV 70.0000 0.0600 1.0000 + wheat = HSV 39.0881 0.2694 0.9608 + white = HSV 0.0000 0.0000 1.0000 + whiteSmoke = HSV 0.0000 0.0000 0.9608 + zincWhite = HSV 280.0000 0.0300 1.0000 + + -- Greys + coldGrey = HSV 164.9999 0.0741 0.5400 + dimGrey = HSV 0.0000 0.0000 0.4118 + grey = HSV 0.0000 0.0000 0.7529 + lightGrey = HSV 0.0000 0.0000 0.8275 + slateGrey = HSV 209.9761 0.2222 0.5647 + slateGreyDark = HSV 180.0000 0.4051 0.3098 + slateGreyLight = HSV 210.0225 0.2222 0.6000 + warmGrey = HSV 60.0000 0.1800 0.5000 + + -- Blacks + black = HSV 0.0000 0.0000 0.0000 + ivoryBlack = HSV 20.0000 0.1875 0.1600 + lampBlack = HSV 150.0000 0.3571 0.2800 + + -- Reds + alizarinCrimson = HSV 355.1351 0.8315 0.8900 + brick = HSV 34.2857 0.8033 0.6100 + cadmiumRedDeep = HSV 2.8571 0.9438 0.8900 + coral = HSV 16.1125 0.6863 1.0000 + coralLight = HSV 0.0000 0.4666 0.9412 + deepPink = HSV 327.5716 0.9216 1.0000 + englishRed = HSV 11.5068 0.8795 0.8300 + firebrick = HSV 0.0000 0.8090 0.6980 + geraniumLake = HSV 351.2195 0.9213 0.8900 + hotPink = HSV 330.0000 0.5882 1.0000 + indianRed = HSV 357.0000 0.8696 0.6900 + lightSalmon = HSV 17.1511 0.5216 1.0000 + madderLakeDeep = HSV 359.1549 0.7978 0.8900 + maroon = HSV 337.4940 0.7273 0.6902 + pink = HSV 349.5103 0.2471 1.0000 + pinkLight = HSV 350.9466 0.2863 1.0000 + raspberry = HSV 330.0000 0.7170 0.5300 + red = HSV 0.0000 1.0000 1.0000 + roseMadder = HSV 359.1177 0.7640 0.8900 + salmon = HSV 6.1766 0.5440 0.9804 + tomato = HSV 9.1297 0.7216 1.0000 + venetianRed = HSV 358.3562 0.8795 0.8300 + + -- Browns + beige = HSV 34.2857 0.2187 0.6400 + brown = HSV 0.0000 0.6706 0.5000 + brownMadder = HSV 0.0000 0.8140 0.8600 + brownOchre = HSV 20.4878 0.7736 0.5300 + burlywood = HSV 33.7984 0.3919 0.8706 + burntSienna = HSV 18.7500 0.8889 0.5400 + burntUmber = HSV 9.0000 0.7407 0.5400 + chocolate = HSV 25.0064 0.8572 0.8235 + deepOchre = HSV 24.0000 0.7778 0.4500 + flesh = HSV 19.2000 0.7500 1.0000 + fleshOchre = HSV 14.4828 0.8700 1.0000 + goldOchre = HSV 30.4762 0.8077 0.7800 + greenishUmber = HSV 12.0000 0.9500 1.0000 + khaki = HSV 54.0031 0.4167 0.9412 + khakiDark = HSV 55.5970 0.4339 0.7412 + lightBeige = HSV 60.0000 0.1021 0.9608 + peru = HSV 29.5797 0.6926 0.8039 + rosyBrown = HSV 0.0000 0.2394 0.7373 + rawSienna = HSV 25.7143 0.8974 0.7800 + rawUmber = HSV 34.7368 0.8444 0.4500 + sepia = HSV 16.0000 0.8108 0.3700 + sienna = HSV 19.3038 0.7187 0.6275 + saddleBrown = HSV 25.0021 0.8633 0.5451 + sandyBrown = HSV 27.5603 0.6065 0.9569 + tan = HSV 34.2951 0.3333 0.8235 + vanDykeBrown = HSV 22.2857 0.9459 0.3700 + + -- Oranges + cadmiumOrange = HSV 22.4242 0.9900 1.0000 + cadmiumRedLight = HSV 357.5758 0.9900 1.0000 + carrot = HSV 33.0000 0.8602 0.9300 + darkOrange = HSV 32.9400 1.0000 1.0000 + marsOrange = HSV 22.3529 0.8644 0.5900 + marsYellow = HSV 25.8228 0.8876 0.8900 + orange = HSV 30.0000 1.0000 1.0000 + orangeRed = HSV 16.2360 1.0000 1.0000 + yellowOchre = HSV 31.5000 0.8989 0.8900 + + -- Yellows + aureolineYellow = HSV 36.2791 0.8600 1.0000 + banana = HSV 51.2727 0.6180 0.8900 + cadmiumLemon = HSV 53.3333 0.9900 1.0000 + cadmiumYellow = HSV 34.1936 0.9300 1.0000 + gold = HSV 50.5860 1.0000 1.0000 + goldenrod = HSV 42.9065 0.8532 0.8549 + goldenrodDark = HSV 42.6588 0.9403 0.7216 + goldenrodLight = HSV 60.0000 0.1600 0.9804 + goldenrodPale = HSV 54.7112 0.2857 0.9333 + lightGoldenrod = HSV 50.5643 0.4538 0.9333 + melon = HSV 31.2500 0.5393 0.8900 + naplesYellowDeep = HSV 38.0645 0.9300 1.0000 + yellow = HSV 60.0000 1.0000 1.0000 + yellowLight = HSV 60.0000 0.1216 1.0000 + + -- Greens + chartreuse = HSV 90.1200 1.0000 1.0000 + chromeoxideGreen = HSV 74.2857 0.8400 0.5000 + cinnabarGreen = HSV 95.5556 0.7714 0.7000 + cobaltGreen = HSV 121.8182 0.5789 0.5700 + emeraldGreen = HSV 145.8228 1.0000 0.7900 + forestGreen = HSV 120.0000 0.7555 0.5451 + green = HSV 120.0000 1.0000 1.0000 + greenDark = HSV 120.0000 1.0000 0.3922 + greenPale = HSV 120.0000 0.3944 0.9843 + greenYellow = HSV 83.6558 0.8157 1.0000 + lawnGreen = HSV 90.4736 1.0000 0.9882 + limeGreen = HSV 120.0000 0.7561 0.8039 + mint = HSV 132.0000 0.2525 0.9900 + olive = HSV 102.0000 0.5405 0.3700 + oliveDrab = HSV 79.6330 0.7535 0.5569 + oliveGreenDark = HSV 82.0060 0.5608 0.4196 + permanentGreen = HSV 130.4000 0.9494 0.7900 + sapGreen = HSV 104.2857 0.8400 0.5000 + seaGreen = HSV 146.4546 0.6691 0.5451 + seaGreenDark = HSV 120.0000 0.2394 0.7373 + seaGreenMedium = HSV 146.7152 0.6648 0.7020 + seaGreenLight = HSV 176.7196 0.8202 0.6980 + springGreen = HSV 149.8800 1.0000 1.0000 + springGreenMedium = HSV 156.9584 1.0000 0.9804 + terreVerte = HSV 89.0323 0.8378 0.3700 + viridianLight = HSV 121.0526 0.5700 1.0000 + yellowGreen = HSV 79.7433 0.7561 0.8039 + + -- Cyans + aquamarine = HSV 159.8486 0.5020 1.0000 + aquamarineMedium = HSV 159.6187 0.5024 0.8039 + cyan = HSV 180.0000 1.0000 1.0000 + cyanWhite = HSV 180.0000 0.1216 1.0000 + turquoise = HSV 174.0038 0.7143 0.8784 + turquoiseDark = HSV 180.8638 1.0000 0.8196 + turquoiseMedium = HSV 177.8109 0.6554 0.8196 + turquoisePale = HSV 180.0000 0.2647 0.9333 + + -- Blues + aliceBlue = HSV 208.0612 0.0588 1.0000 + blue = HSV 240.0000 1.0000 1.0000 + blueLight = HSV 194.7317 0.2479 0.9020 + blueMedium = HSV 240.0000 1.0000 0.8039 + cadet = HSV 181.8588 0.4064 0.6275 + cobalt = HSV 224.6512 0.6418 0.6700 + cornflower = HSV 218.5443 0.5780 0.9294 + cerulean = HSV 186.1538 0.9750 0.8000 + dodgerBlue = HSV 209.5988 0.8824 1.0000 + indigo = HSV 210.0000 0.9091 0.3300 + manganeseBlue = HSV 176.3077 0.9848 0.6600 + midnightBlue = HSV 240.0000 0.7769 0.4392 + navy = HSV 240.0000 1.0000 0.5020 + peacock = HSV 196.2712 0.7468 0.7900 + powderBlue = HSV 186.6856 0.2348 0.9020 + royalBlue = HSV 224.9976 0.7111 0.8824 + slateBlue = HSV 248.3548 0.5610 0.8039 + slateBlueDark = HSV 248.4733 0.5612 0.5451 + slateBlueLight = HSV 248.3880 0.5608 1.0000 + slateBlueMedium = HSV 248.5176 0.5631 0.9333 + skyBlue = HSV 197.4095 0.4256 0.9216 + skyBlueDeep = HSV 195.0600 1.0000 1.0000 + skyBlueLight = HSV 202.9623 0.4600 0.9804 + steelBlue = HSV 207.2740 0.6111 0.7059 + steelBlueLight = HSV 213.9246 0.2072 0.8706 + turquoiseBlue = HSV 162.3077 1.0000 0.7800 + ultramarine = HSV 243.4616 0.9286 0.5600 + + -- Magentas + blueViolet = HSV 271.1495 0.8098 0.8863 + cobaltVioletDeep = HSV 293.8776 0.7903 0.6200 + magenta = HSV 300.0000 1.0000 1.0000 + orchid = HSV 302.2660 0.4863 0.8549 + orchidDark = HSV 280.1292 0.7549 0.8000 + orchidMedium = HSV 288.0898 0.5972 0.8275 + permanentViolet = HSV 349.8592 0.8256 0.8600 + plum = HSV 300.0000 0.2760 0.8667 + purple = HSV 276.9253 0.8667 0.9412 + purpleMedium = HSV 259.6330 0.4886 0.8588 + ultramarineViolet = HSV 285.5172 0.6744 0.4300 + violet = HSV 289.5652 0.3833 0.6000 + violetDark = HSV 282.0834 1.0000 0.8275 + violetRed = HSV 321.8198 0.8461 0.8157 + violetRedMedium = HSV 322.2464 0.8944 0.7804 + violetRedPale = HSV 340.3670 0.4886 0.8588 + diff --git a/Data/Array/Accelerate/Data/Colour/Internal/Pack.hs b/Data/Array/Accelerate/Data/Colour/Internal/Pack.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Colour/Internal/Pack.hs @@ -0,0 +1,57 @@ +-- | +-- Module : Data.Array.Accelerate.Data.Colour.Internal.Pack +-- Copyright : [2016] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- + +module Data.Array.Accelerate.Data.Colour.Internal.Pack + where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Data.Bits as A + + +-- | Pack the given four bytes into a single 4-byte word. The first argument +-- will appear at the lowest address on a little-endian architecture with +-- one-byte addressing: +-- +-- >>> pack8 0x0d 0x0c 0x0b 0x0a = 0x0a0b0c0d +-- +-- This function is equivalent to: +-- +-- >>> alloca $ \(p :: Ptr Word32) -> +-- >>> pokeByteOff p 0 (0x0d :: Word8) +-- >>> pokeByteOff p 1 (0x0c :: Word8) +-- >>> pokeByteOff p 2 (0x0b :: Word8) +-- >>> pokeByteOff p 3 (0x0a :: Word8) +-- +-- Where 'p' would then point to the value '0x0a0b0c0d' +-- +pack8 :: Exp Word8 -> Exp Word8 -> Exp Word8 -> Exp Word8 -> Exp Word32 +pack8 x y z w = + A.fromIntegral w `A.shiftL` 24 + .|. A.fromIntegral z `A.shiftL` 16 + .|. A.fromIntegral y `A.shiftL` 8 + .|. A.fromIntegral x + +-- | Inverse of 'pack'. On a little-endian architecture: +-- +-- >>> unpack8 0x0a0b0c0d = (0x0d, 0x0c, 0x0b, 0x0a) +-- +unpack8 :: Exp Word32 -> Exp (Word8, Word8, Word8, Word8) +unpack8 xyzw = + let w = A.fromIntegral (xyzw `A.shiftR` 24) + z = A.fromIntegral (xyzw `A.shiftR` 16) + y = A.fromIntegral (xyzw `A.shiftR` 8) + x = A.fromIntegral xyzw + in + lift (x,y,z,w) + + +word8OfFloat :: Exp Float -> Exp Word8 +word8OfFloat x = A.truncate (x * 255) + diff --git a/Data/Array/Accelerate/Data/Colour/Names.hs b/Data/Array/Accelerate/Data/Colour/Names.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Colour/Names.hs @@ -0,0 +1,637 @@ +{-# LANGUAGE NoImplicitPrelude #-} +-- | +-- Module : Data.Array.Accelerate.Data.Colour.Names +-- Copyright : [2016] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +-- Names for "familiar" colours, taken from +-- +-- + +module Data.Array.Accelerate.Data.Colour.Names + where + +import Data.Array.Accelerate ( Elt, Exp, constant ) + + +class NamedColour c where + -- Whites + -- | <> + antiqueWhite :: c + -- | <> + azure :: c + -- | <> + bisque :: c + -- | <> + blanchedAlmond :: c + -- | <> + cornsilk :: c + -- | <> + eggshell :: c + -- | <> + floralWhite :: c + -- | <> + gainsboro :: c + -- | <> + ghostWhite :: c + -- | <> + honeydew :: c + -- | <> + ivory :: c + -- | <> + lavender :: c + -- | <> + lavenderBlush :: c + -- | <> + lemonChiffon :: c + -- | <> + linen :: c + -- | <> + mintCream :: c + -- | <> + mistyRose :: c + -- | <> + moccasin :: c + -- | <> + navajoWhite :: c + -- | <> + oldLace :: c + -- | <> + papayaWhip :: c + -- | <> + peachPuff :: c + -- | <> + seashell :: c + -- | <> + snow :: c + -- | <> + thistle :: c + -- | <> + titaniumWhite :: c + -- | <> + wheat :: c + -- | <> + white :: c + -- | <> + whiteSmoke :: c + -- | <> + zincWhite :: c + + -- Greys + -- | <> + coldGrey :: c + -- | <> + dimGrey :: c + -- | <> + grey :: c + -- | <> + lightGrey :: c + -- | <> + slateGrey :: c + -- | <> + slateGreyDark :: c + -- | <> + slateGreyLight :: c + -- | <> + warmGrey :: c + + -- Blacks + -- | <> + black :: c + -- | <> + ivoryBlack :: c + -- | <> + lampBlack :: c + + -- Reds + -- | <> + alizarinCrimson :: c + -- | <> + brick :: c + -- | <> + cadmiumRedDeep :: c + -- | <> + coral :: c + -- | <> + coralLight :: c + -- | <> + deepPink :: c + -- | <> + englishRed :: c + -- | <> + firebrick :: c + -- | <> + geraniumLake :: c + -- | <> + hotPink :: c + -- | <> + indianRed :: c + -- | <> + lightSalmon :: c + -- | <> + madderLakeDeep :: c + -- | <> + maroon :: c + -- | <> + pink :: c + -- | <> + pinkLight :: c + -- | <> + raspberry :: c + -- | <> + red :: c + -- | <> + roseMadder :: c + -- | <> + salmon :: c + -- | <> + tomato :: c + -- | <> + venetianRed :: c + + -- Browns + -- | <> + beige :: c + -- | <> + brown :: c + -- | <> + brownMadder :: c + -- | <> + brownOchre :: c + -- | <> + burlywood :: c + -- | <> + burntSienna :: c + -- | <> + burntUmber :: c + -- | <> + chocolate :: c + -- | <> + deepOchre :: c + -- | <> + flesh :: c + -- | <> + fleshOchre :: c + -- | <> + goldOchre :: c + -- | <> + greenishUmber :: c + -- | <> + khaki :: c + -- | <> + khakiDark :: c + -- | <> + lightBeige :: c + -- | <> + peru :: c + -- | <> + rosyBrown :: c + -- | <> + rawSienna :: c + -- | <> + rawUmber :: c + -- | <> + sepia :: c + -- | <> + sienna :: c + -- | <> + saddleBrown :: c + -- | <> + sandyBrown :: c + -- | <> + tan :: c + -- | <> + vanDykeBrown :: c + + -- Oranges + -- | <> + cadmiumOrange :: c + -- | <> + cadmiumRedLight :: c + -- | <> + carrot :: c + -- | <> + darkOrange :: c + -- | <> + marsOrange :: c + -- | <> + marsYellow :: c + -- | <> + orange :: c + -- | <> + orangeRed :: c + -- | <> + yellowOchre :: c + + -- Yellows + -- | <> + aureolineYellow :: c + -- | <> + banana :: c + -- | <> + cadmiumLemon :: c + -- | <> + cadmiumYellow :: c + -- | <> + gold :: c + -- | <> + goldenrod :: c + -- | <> + goldenrodDark :: c + -- | <> + goldenrodLight :: c + -- | <> + goldenrodPale :: c + -- | <> + lightGoldenrod :: c + -- | <> + melon :: c + -- | <> + naplesYellowDeep :: c + -- | <> + yellow :: c + -- | <> + yellowLight :: c + + -- Greens + -- | <> + chartreuse :: c + -- | <> + chromeoxideGreen :: c + -- | <> + cinnabarGreen :: c + -- | <> + cobaltGreen :: c + -- | <> + emeraldGreen :: c + -- | <> + forestGreen :: c + -- | <> + green :: c + -- | <> + greenDark :: c + -- | <> + greenPale :: c + -- | <> + greenYellow :: c + -- | <> + lawnGreen :: c + -- | <> + limeGreen :: c + -- | <> + mint :: c + -- | <> + olive :: c + -- | <> + oliveDrab :: c + -- | <> + oliveGreenDark :: c + -- | <> + permanentGreen :: c + -- | <> + sapGreen :: c + -- | <> + seaGreen :: c + -- | <> + seaGreenDark :: c + -- | <> + seaGreenMedium :: c + -- | <> + seaGreenLight :: c + -- | <> + springGreen :: c + -- | <> + springGreenMedium :: c + -- | <> + terreVerte :: c + -- | <> + viridianLight :: c + -- | <> + yellowGreen :: c + + -- Cyans + -- | <> + aquamarine :: c + -- | <> + aquamarineMedium :: c + -- | <> + cyan :: c + -- | <> + cyanWhite :: c + -- | <> + turquoise :: c + -- | <> + turquoiseDark :: c + -- | <> + turquoiseMedium :: c + -- | <> + turquoisePale :: c + + -- Blues + -- | <> + aliceBlue :: c + -- | <> + blue :: c + -- | <> + blueLight :: c + -- | <> + blueMedium :: c + -- | <> + cadet :: c + -- | <> + cobalt :: c + -- | <> + cornflower :: c + -- | <> + cerulean :: c + -- | <> + dodgerBlue :: c + -- | <> + indigo :: c + -- | <> + manganeseBlue :: c + -- | <> + midnightBlue :: c + -- | <> + navy :: c + -- | <> + peacock :: c + -- | <> + powderBlue :: c + -- | <> + royalBlue :: c + -- | <> + slateBlue :: c + -- | <> + slateBlueDark :: c + -- | <> + slateBlueLight :: c + -- | <> + slateBlueMedium :: c + -- | <> + skyBlue :: c + -- | <> + skyBlueDeep :: c + -- | <> + skyBlueLight :: c + -- | <> + steelBlue :: c + -- | <> + steelBlueLight :: c + -- | <> + turquoiseBlue :: c + -- | <> + ultramarine :: c + + -- Magentas + -- | <> + blueViolet :: c + -- | <> + cobaltVioletDeep :: c + -- | <> + magenta :: c + -- | <> + orchid :: c + -- | <> + orchidDark :: c + -- | <> + orchidMedium :: c + -- | <> + permanentViolet :: c + -- | <> + plum :: c + -- | <> + purple :: c + -- | <> + purpleMedium :: c + -- | <> + ultramarineViolet :: c + -- | <> + violet :: c + -- | <> + violetDark :: c + -- | <> + violetRed :: c + -- | <> + violetRedMedium :: c + -- | <> + violetRedPale :: c + + +instance (Elt c, NamedColour c) => NamedColour (Exp c) where + -- Whites + antiqueWhite = constant antiqueWhite + azure = constant azure + bisque = constant bisque + blanchedAlmond = constant blanchedAlmond + cornsilk = constant cornsilk + eggshell = constant eggshell + floralWhite = constant floralWhite + gainsboro = constant gainsboro + ghostWhite = constant ghostWhite + honeydew = constant honeydew + ivory = constant ivory + lavender = constant lavender + lavenderBlush = constant lavenderBlush + lemonChiffon = constant lemonChiffon + linen = constant linen + mintCream = constant mintCream + mistyRose = constant mistyRose + moccasin = constant moccasin + navajoWhite = constant navajoWhite + oldLace = constant oldLace + papayaWhip = constant papayaWhip + peachPuff = constant peachPuff + seashell = constant seashell + snow = constant snow + thistle = constant thistle + titaniumWhite = constant titaniumWhite + wheat = constant wheat + white = constant white + whiteSmoke = constant whiteSmoke + zincWhite = constant zincWhite + + -- Greys + coldGrey = constant coldGrey + dimGrey = constant dimGrey + grey = constant grey + lightGrey = constant lightGrey + slateGrey = constant slateGrey + slateGreyDark = constant slateGreyDark + slateGreyLight = constant slateGreyLight + warmGrey = constant warmGrey + + -- Blacks + black = constant black + ivoryBlack = constant ivoryBlack + lampBlack = constant lampBlack + + -- Reds + alizarinCrimson = constant alizarinCrimson + brick = constant brick + cadmiumRedDeep = constant cadmiumRedDeep + coral = constant coral + coralLight = constant coralLight + deepPink = constant deepPink + englishRed = constant englishRed + firebrick = constant firebrick + geraniumLake = constant geraniumLake + hotPink = constant hotPink + indianRed = constant indianRed + lightSalmon = constant lightSalmon + madderLakeDeep = constant madderLakeDeep + maroon = constant maroon + pink = constant pink + pinkLight = constant pinkLight + raspberry = constant raspberry + red = constant red + roseMadder = constant roseMadder + salmon = constant salmon + tomato = constant tomato + venetianRed = constant venetianRed + + -- Browns + beige = constant beige + brown = constant brown + brownMadder = constant brownMadder + brownOchre = constant brownOchre + burlywood = constant burlywood + burntSienna = constant burntSienna + burntUmber = constant burntUmber + chocolate = constant chocolate + deepOchre = constant deepOchre + flesh = constant flesh + fleshOchre = constant fleshOchre + goldOchre = constant goldOchre + greenishUmber = constant greenishUmber + khaki = constant khaki + khakiDark = constant khakiDark + lightBeige = constant lightBeige + peru = constant peru + rosyBrown = constant rosyBrown + rawSienna = constant rawSienna + rawUmber = constant rawUmber + sepia = constant sepia + sienna = constant sienna + saddleBrown = constant saddleBrown + sandyBrown = constant sandyBrown + tan = constant tan + vanDykeBrown = constant vanDykeBrown + + -- Oranges + cadmiumOrange = constant cadmiumOrange + cadmiumRedLight = constant cadmiumRedLight + carrot = constant carrot + darkOrange = constant darkOrange + marsOrange = constant marsOrange + marsYellow = constant marsYellow + orange = constant orange + orangeRed = constant orangeRed + yellowOchre = constant yellowOchre + + -- Yellows + aureolineYellow = constant aureolineYellow + banana = constant banana + cadmiumLemon = constant cadmiumLemon + cadmiumYellow = constant cadmiumYellow + gold = constant gold + goldenrod = constant goldenrod + goldenrodDark = constant goldenrodDark + goldenrodLight = constant goldenrodLight + goldenrodPale = constant goldenrodPale + lightGoldenrod = constant lightGoldenrod + melon = constant melon + naplesYellowDeep = constant naplesYellowDeep + yellow = constant yellow + yellowLight = constant yellowLight + + -- Greens + chartreuse = constant chartreuse + chromeoxideGreen = constant chromeoxideGreen + cinnabarGreen = constant cinnabarGreen + cobaltGreen = constant cobaltGreen + emeraldGreen = constant emeraldGreen + forestGreen = constant forestGreen + green = constant green + greenDark = constant greenDark + greenPale = constant greenPale + greenYellow = constant greenYellow + lawnGreen = constant lawnGreen + limeGreen = constant limeGreen + mint = constant mint + olive = constant olive + oliveDrab = constant oliveDrab + oliveGreenDark = constant oliveGreenDark + permanentGreen = constant permanentGreen + sapGreen = constant sapGreen + seaGreen = constant seaGreen + seaGreenDark = constant seaGreenDark + seaGreenMedium = constant seaGreenMedium + seaGreenLight = constant seaGreenLight + springGreen = constant springGreen + springGreenMedium = constant springGreenMedium + terreVerte = constant terreVerte + viridianLight = constant viridianLight + yellowGreen = constant yellowGreen + + -- Cyans + aquamarine = constant aquamarine + aquamarineMedium = constant aquamarineMedium + cyan = constant cyan + cyanWhite = constant cyanWhite + turquoise = constant turquoise + turquoiseDark = constant turquoiseDark + turquoiseMedium = constant turquoiseMedium + turquoisePale = constant turquoisePale + + -- Blues + aliceBlue = constant aliceBlue + blue = constant blue + blueLight = constant blueLight + blueMedium = constant blueMedium + cadet = constant cadet + cobalt = constant cobalt + cornflower = constant cornflower + cerulean = constant cerulean + dodgerBlue = constant dodgerBlue + indigo = constant indigo + manganeseBlue = constant manganeseBlue + midnightBlue = constant midnightBlue + navy = constant navy + peacock = constant peacock + powderBlue = constant powderBlue + royalBlue = constant royalBlue + slateBlue = constant slateBlue + slateBlueDark = constant slateBlueDark + slateBlueLight = constant slateBlueLight + slateBlueMedium = constant slateBlueMedium + skyBlue = constant skyBlue + skyBlueDeep = constant skyBlueDeep + skyBlueLight = constant skyBlueLight + steelBlue = constant steelBlue + steelBlueLight = constant steelBlueLight + turquoiseBlue = constant turquoiseBlue + ultramarine = constant ultramarine + + -- Magentas + blueViolet = constant blueViolet + cobaltVioletDeep = constant cobaltVioletDeep + magenta = constant magenta + orchid = constant orchid + orchidDark = constant orchidDark + orchidMedium = constant orchidMedium + permanentViolet = constant permanentViolet + plum = constant plum + purple = constant purple + purpleMedium = constant purpleMedium + ultramarineViolet = constant ultramarineViolet + violet = constant violet + violetDark = constant violetDark + violetRed = constant violetRed + violetRedMedium = constant violetRedMedium + violetRedPale = constant violetRedPale + diff --git a/Data/Array/Accelerate/Data/Colour/RGB.hs b/Data/Array/Accelerate/Data/Colour/RGB.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Colour/RGB.hs @@ -0,0 +1,690 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} +#if __GLASGOW_HASKELL__ <= 708 +{-# LANGUAGE OverlappingInstances #-} +{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-} +#endif +-- | +-- Module : Data.Array.Accelerate.Data.Colour.RGB +-- Copyright : [2016] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +-- RGB triples for an unspecified colour space +-- + +module Data.Array.Accelerate.Data.Colour.RGB ( + + Colour, + RGB(..), + + rgb, rgb8, + clamp, + blend, + luminance, + + packRGB, packBGR, unpackRGB, unpackBGR, + packRGB8, packBGR8, unpackRGB8, unpackBGR8, + +) where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Smart +import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) ) +import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, Tuple(..) ) + +import Data.Array.Accelerate.Data.Colour.Names +import Data.Array.Accelerate.Data.Colour.Internal.Pack + +import Data.Typeable +import Prelude as P + + +-- | An RGB colour value +-- +type Colour = RGB Float + +-- | Construct an RGB colour from individual channel components. The components +-- will be clamped to the range [0..1]. +-- +rgb :: Exp Float -- ^ red component + -> Exp Float -- ^ green component + -> Exp Float -- ^ blue component + -> Exp Colour +rgb r g b + = clamp + $ lift (RGB r g b) + + +-- | Construct a colour from 8-bit-per-channel colour components. +-- +rgb8 :: Exp Word8 -- ^ red component + -> Exp Word8 -- ^ green component + -> Exp Word8 -- ^ blue component + -> Exp Colour +rgb8 r g b + = lift + $ RGB (A.fromIntegral r / 255) + (A.fromIntegral g / 255) + (A.fromIntegral b / 255) + + +-- | Clamp each component of a colour to the range [0..1]. +-- +clamp :: Exp Colour -> Exp Colour +clamp = lift1 (fmap c :: RGB (Exp Float) -> RGB (Exp Float)) + where + c x = 0 `A.max` x `A.min` 1 + + +-- | Blend two colours in the given proportions. +-- +-- Note that this uses an approximation of gamma=2 (i.e. sum-of-squares method). +-- It is recommended to instead convert to the sRGB colour space if you want +-- more accurate colour blending, or if you intend to use the gamma-corrected +-- values more than once (e.g. in a stencil). +-- +-- > blend c1 c2 ~= SRGB.toRGB ( (SRGB.fromRGB c1 + SRGB.fromRGB c2) / 2 ) +-- +-- See the Blur program in the examples for a comparison of mixing colours in +-- the RGB and sRGB colour spaces. +-- +blend :: Exp Float -- ^ Proportion of first colour + -> Exp Float -- ^ Proportion of second colour + -> Exp Colour -- ^ First colour + -> Exp Colour -- ^ Second colour + -> Exp Colour -- ^ Resulting colour +blend m1 m2 c1 c2 = + let + RGB r1 g1 b1 = unlift c1 + RGB r2 g2 b2 = unlift c2 + + -- Normalise mixing proportions to ratios. + m12 = m1 + m2 + m1' = m1 / m12 + m2' = m2 / m12 + + -- Colours components should be added via sum of squares, otherwise the + -- result will be too dark. + r1s = r1 * r1; r2s = r2 * r2 + g1s = g1 * g1; g2s = g2 * g2 + b1s = b1 * b1; b2s = b2 * b2 + in + rgb (sqrt (m1' * r1s + m2' * r2s)) + (sqrt (m1' * g1s + m2' * g2s)) + (sqrt (m1' * b1s + m2' * b2s)) + + +-- | Luminance of an RGB colour (Y component of a YUV colour). +-- +luminance :: Exp Colour -> Exp Float +luminance (unlift -> RGB r g b) = 0.299*r + 0.587*g + 0.114*b + + +-- Packed representation +-- --------------------- + +-- | Convert a Colour into a packed-word RGBA representation +-- +packRGB :: Exp Colour -> Exp Word32 +packRGB (unlift -> RGB r g b) = pack8 (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) 0xFF + +-- | Convert a colour into a packed-word ABGR representation +-- +packBGR :: Exp Colour -> Exp Word32 +packBGR (unlift -> RGB r g b) = pack8 0xFF (word8OfFloat b) (word8OfFloat g) (word8OfFloat r) + +packRGB8 :: Exp (RGB Word8) -> Exp Word32 +packRGB8 (unlift -> RGB r g b) = pack8 r g b 0xFF + +packBGR8 :: Exp (RGB Word8) -> Exp Word32 +packBGR8 (unlift -> RGB r g b) = pack8 0xff b g r + + +-- | Convert a colour from a packed-word RGBA representation +-- +unpackRGB :: Exp Word32 -> Exp Colour +unpackRGB w = + let (r,g,b::Exp Word8,_::Exp Word8) = unlift (unpack8 w) + in rgb8 r g b + +-- | Convert a colour from a packed-word ABGR representation +-- +unpackBGR :: Exp Word32 -> Exp Colour +unpackBGR w = + let (_::Exp Word8,b::Exp Word8,g,r) = unlift (unpack8 w) + in rgb8 r g b + +unpackRGB8 :: Exp Word32 -> Exp (RGB Word8) +unpackRGB8 w = + let (r,g,b::Exp Word8,_::Exp Word8) = unlift (unpack8 w) + in lift $ RGB r g b + +unpackBGR8 :: Exp Word32 -> Exp (RGB Word8) +unpackBGR8 w = + let (_::Exp Word8,b::Exp Word8,g,r) = unlift (unpack8 w) + in lift $ RGB r g b + + +-- Accelerate bits +-- --------------- + +-- RGB colour space +-- +data RGB a = RGB a a a + deriving (Show, P.Eq, Functor, Typeable) + +-- Represent colours in Accelerate as a 3-tuple +-- +type instance EltRepr (RGB a) = EltRepr (a, a, a) + +instance Elt a => Elt (RGB a) where + eltType (_ :: RGB a) = eltType (undefined :: (a,a,a)) + toElt c = let (r,g,b) = toElt c in RGB r g b + fromElt (RGB r g b) = fromElt (r,g,b) + +instance Elt a => IsProduct Elt (RGB a) where + type ProdRepr (RGB a) = ((((),a), a), a) + fromProd _ (RGB r g b) = ((((), r), g), b) + toProd _ ((((),r),g),b) = RGB r g b + prod cst _ = prod cst (undefined :: (a,a,a)) + +instance (Lift Exp a, Elt (Plain a)) => Lift Exp (RGB a) where + type Plain (RGB a) = RGB (Plain a) + lift (RGB r g b) = Exp . Tuple $ NilTup `SnocTup` lift r `SnocTup` lift g `SnocTup` lift b + +instance Elt a => Unlift Exp (RGB (Exp a)) where + unlift c = let r = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c + g = Exp $ SuccTupIdx ZeroTupIdx `Prj` c + b = Exp $ ZeroTupIdx `Prj` c + in RGB r g b + +instance P.Num a => P.Num (RGB a) where + (+) (RGB r1 g1 b1 ) (RGB r2 g2 b2) + = RGB (r1 + r2) (g1 + g2) (b1 + b2) + + (-) (RGB r1 g1 b1) (RGB r2 g2 b2) + = RGB (r1 - r2) (g1 - g2) (b1 - b2) + + (*) (RGB r1 g1 b1) (RGB r2 g2 b2) + = RGB (r1 * r2) (g1 * g2) (b1 * b2) + + abs (RGB r1 g1 b1) + = RGB (abs r1) (abs g1) (abs b1) + + signum (RGB r1 g1 b1) + = RGB (signum r1) (signum g1) (signum b1) + + fromInteger i + = let f = fromInteger i + in RGB f f f + +instance (P.Num a, P.Fractional a) => P.Fractional (RGB a) where + (/) (RGB r1 g1 b1) (RGB r2 g2 b2) + = RGB (r1/r2) (g1/g2) (b1/b2) + + recip (RGB r1 g1 b1) + = RGB (recip r1) (recip g1) (recip b1) + + fromRational r + = let f = fromRational r + in RGB f f f + + +instance {-# OVERLAPS #-} A.Num a => P.Num (Exp (RGB a)) where + (+) = lift2 ((+) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) + (-) = lift2 ((-) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) + (*) = lift2 ((*) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) + abs = lift1 (abs :: RGB (Exp a) -> RGB (Exp a)) + signum = lift1 (signum :: RGB (Exp a) -> RGB (Exp a)) + fromInteger i = let f = fromInteger i :: Exp a + in lift $ RGB f f f + +instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (RGB a)) where + (/) = lift2 ((/) :: RGB (Exp a) -> RGB (Exp a) -> RGB (Exp a)) + recip = lift1 (recip :: RGB (Exp a) -> RGB (Exp a)) + fromRational r = let f = fromRational r :: Exp a + in lift $ RGB f f f + + +-- Named colours +-- ------------- + +instance NamedColour (RGB Word8) where + -- Whites + antiqueWhite = RGB 250 235 215 + azure = RGB 240 255 255 + bisque = RGB 255 228 196 + blanchedAlmond = RGB 255 235 205 + cornsilk = RGB 255 248 220 + eggshell = RGB 252 230 201 + floralWhite = RGB 255 250 240 + gainsboro = RGB 220 220 220 + ghostWhite = RGB 248 248 255 + honeydew = RGB 240 255 240 + ivory = RGB 255 255 240 + lavender = RGB 230 230 250 + lavenderBlush = RGB 255 240 245 + lemonChiffon = RGB 255 250 205 + linen = RGB 250 240 230 + mintCream = RGB 245 255 250 + mistyRose = RGB 255 228 225 + moccasin = RGB 255 228 181 + navajoWhite = RGB 255 222 173 + oldLace = RGB 253 245 230 + papayaWhip = RGB 255 239 213 + peachPuff = RGB 255 218 185 + seashell = RGB 255 245 238 + snow = RGB 255 250 250 + thistle = RGB 216 191 216 + titaniumWhite = RGB 252 255 240 + wheat = RGB 245 222 179 + white = RGB 255 255 255 + whiteSmoke = RGB 245 245 245 + zincWhite = RGB 253 248 255 + + -- Greys + coldGrey = RGB 128 138 135 + dimGrey = RGB 105 105 105 + grey = RGB 192 192 192 + lightGrey = RGB 211 211 211 + slateGrey = RGB 112 128 144 + slateGreyDark = RGB 47 79 79 + slateGreyLight = RGB 119 136 153 + warmGrey = RGB 128 128 105 + + -- Blacks + black = RGB 0 0 0 + ivoryBlack = RGB 41 36 33 + lampBlack = RGB 46 71 59 + + -- Reds + alizarinCrimson = RGB 227 38 54 + brick = RGB 156 102 31 + cadmiumRedDeep = RGB 227 23 13 + coral = RGB 255 127 80 + coralLight = RGB 240 128 128 + deepPink = RGB 255 20 147 + englishRed = RGB 212 61 26 + firebrick = RGB 178 34 34 + geraniumLake = RGB 227 18 48 + hotPink = RGB 255 105 180 + indianRed = RGB 176 23 31 + lightSalmon = RGB 255 160 122 + madderLakeDeep = RGB 227 46 48 + maroon = RGB 176 48 96 + pink = RGB 255 192 203 + pinkLight = RGB 255 182 193 + raspberry = RGB 135 38 87 + red = RGB 255 0 0 + roseMadder = RGB 227 54 56 + salmon = RGB 250 128 114 + tomato = RGB 255 99 71 + venetianRed = RGB 212 26 31 + + -- Browns + beige = RGB 163 148 128 + brown = RGB 128 42 42 + brownMadder = RGB 219 41 41 + brownOchre = RGB 135 66 31 + burlywood = RGB 222 184 135 + burntSienna = RGB 138 54 15 + burntUmber = RGB 138 51 36 + chocolate = RGB 210 105 30 + deepOchre = RGB 115 61 26 + flesh = RGB 255 125 64 + fleshOchre = RGB 255 87 33 + goldOchre = RGB 199 120 38 + greenishUmber = RGB 255 61 13 + khaki = RGB 240 230 140 + khakiDark = RGB 189 183 107 + lightBeige = RGB 245 245 220 + peru = RGB 205 133 63 + rosyBrown = RGB 188 143 143 + rawSienna = RGB 199 97 20 + rawUmber = RGB 115 74 18 + sepia = RGB 94 38 18 + sienna = RGB 160 82 45 + saddleBrown = RGB 139 69 19 + sandyBrown = RGB 244 164 96 + tan = RGB 210 180 140 + vanDykeBrown = RGB 94 38 5 + + -- Oranges + cadmiumOrange = RGB 255 97 3 + cadmiumRedLight = RGB 255 3 13 + carrot = RGB 237 145 33 + darkOrange = RGB 255 140 0 + marsOrange = RGB 150 69 20 + marsYellow = RGB 227 112 26 + orange = RGB 255 128 0 + orangeRed = RGB 255 69 0 + yellowOchre = RGB 227 130 23 + + -- Yellows + aureolineYellow = RGB 255 168 36 + banana = RGB 227 207 87 + cadmiumLemon = RGB 255 227 3 + cadmiumYellow = RGB 255 153 18 + gold = RGB 255 215 0 + goldenrod = RGB 218 165 32 + goldenrodDark = RGB 184 134 11 + goldenrodLight = RGB 250 250 210 + goldenrodPale = RGB 238 232 170 + lightGoldenrod = RGB 238 221 130 + melon = RGB 227 168 105 + naplesYellowDeep = RGB 255 168 18 + yellow = RGB 255 255 0 + yellowLight = RGB 255 255 224 + + -- Greens + chartreuse = RGB 127 255 0 + chromeoxideGreen = RGB 102 128 20 + cinnabarGreen = RGB 97 179 41 + cobaltGreen = RGB 61 145 64 + emeraldGreen = RGB 0 201 87 + forestGreen = RGB 34 139 34 + green = RGB 0 255 0 + greenDark = RGB 0 100 0 + greenPale = RGB 152 251 152 + greenYellow = RGB 173 255 47 + lawnGreen = RGB 124 252 0 + limeGreen = RGB 50 205 50 + mint = RGB 189 252 201 + olive = RGB 59 94 43 + oliveDrab = RGB 107 142 35 + oliveGreenDark = RGB 85 107 47 + permanentGreen = RGB 10 201 43 + sapGreen = RGB 48 128 20 + seaGreen = RGB 46 139 87 + seaGreenDark = RGB 143 188 143 + seaGreenMedium = RGB 60 179 113 + seaGreenLight = RGB 32 178 170 + springGreen = RGB 0 255 127 + springGreenMedium = RGB 0 250 154 + terreVerte = RGB 56 94 15 + viridianLight = RGB 110 255 112 + yellowGreen = RGB 154 205 50 + + -- Cyans + aquamarine = RGB 127 255 212 + aquamarineMedium = RGB 102 205 170 + cyan = RGB 0 255 255 + cyanWhite = RGB 224 255 255 + turquoise = RGB 64 224 208 + turquoiseDark = RGB 0 206 209 + turquoiseMedium = RGB 72 209 204 + turquoisePale = RGB 175 238 238 + + -- Blues + aliceBlue = RGB 240 248 255 + blue = RGB 0 0 255 + blueLight = RGB 173 216 230 + blueMedium = RGB 0 0 205 + cadet = RGB 95 158 160 + cobalt = RGB 61 89 171 + cornflower = RGB 100 149 237 + cerulean = RGB 5 184 204 + dodgerBlue = RGB 30 144 255 + indigo = RGB 8 46 84 + manganeseBlue = RGB 3 168 158 + midnightBlue = RGB 25 25 112 + navy = RGB 0 0 128 + peacock = RGB 51 161 201 + powderBlue = RGB 176 224 230 + royalBlue = RGB 65 105 225 + slateBlue = RGB 106 90 205 + slateBlueDark = RGB 72 61 139 + slateBlueLight = RGB 132 112 255 + slateBlueMedium = RGB 123 104 238 + skyBlue = RGB 135 206 235 + skyBlueDeep = RGB 0 191 255 + skyBlueLight = RGB 135 206 250 + steelBlue = RGB 70 130 180 + steelBlueLight = RGB 176 196 222 + turquoiseBlue = RGB 0 199 140 + ultramarine = RGB 18 10 143 + + -- Magentas + blueViolet = RGB 138 43 226 + cobaltVioletDeep = RGB 145 33 158 + magenta = RGB 255 0 255 + orchid = RGB 218 112 214 + orchidDark = RGB 153 50 204 + orchidMedium = RGB 186 85 211 + permanentViolet = RGB 219 38 69 + plum = RGB 221 160 221 + purple = RGB 160 32 240 + purpleMedium = RGB 147 112 219 + ultramarineViolet = RGB 92 36 110 + violet = RGB 143 94 153 + violetDark = RGB 148 0 211 + violetRed = RGB 208 32 144 + violetRedMedium = RGB 199 21 133 + violetRedPale = RGB 219 112 147 + +instance NamedColour (RGB Float) where + -- Whites + antiqueWhite = RGB 0.9804 0.9216 0.8431 + azure = RGB 0.9412 1.0000 1.0000 + bisque = RGB 1.0000 0.8941 0.7686 + blanchedAlmond = RGB 1.0000 0.9216 0.8039 + cornsilk = RGB 1.0000 0.9725 0.8627 + eggshell = RGB 0.9900 0.9000 0.7900 + floralWhite = RGB 1.0000 0.9804 0.9412 + gainsboro = RGB 0.8627 0.8627 0.8627 + ghostWhite = RGB 0.9725 0.9725 1.0000 + honeydew = RGB 0.9412 1.0000 0.9412 + ivory = RGB 1.0000 1.0000 0.9412 + lavender = RGB 0.9020 0.9020 0.9804 + lavenderBlush = RGB 1.0000 0.9412 0.9608 + lemonChiffon = RGB 1.0000 0.9804 0.8039 + linen = RGB 0.9804 0.9412 0.9020 + mintCream = RGB 0.9608 1.0000 0.9804 + mistyRose = RGB 1.0000 0.8941 0.8824 + moccasin = RGB 1.0000 0.8941 0.7098 + navajoWhite = RGB 1.0000 0.8706 0.6784 + oldLace = RGB 0.9922 0.9608 0.9020 + papayaWhip = RGB 1.0000 0.9373 0.8353 + peachPuff = RGB 1.0000 0.8549 0.7255 + seashell = RGB 1.0000 0.9608 0.9333 + snow = RGB 1.0000 0.9804 0.9804 + thistle = RGB 0.8471 0.7490 0.8471 + titaniumWhite = RGB 0.9900 1.0000 0.9400 + wheat = RGB 0.9608 0.8706 0.7020 + white = RGB 1.0000 1.0000 1.0000 + whiteSmoke = RGB 0.9608 0.9608 0.9608 + zincWhite = RGB 0.9900 0.9700 1.0000 + + -- Greys + coldGrey = RGB 0.5000 0.5400 0.5300 + dimGrey = RGB 0.4118 0.4118 0.4118 + grey = RGB 0.7529 0.7529 0.7529 + lightGrey = RGB 0.8275 0.8275 0.8275 + slateGrey = RGB 0.4392 0.5020 0.5647 + slateGreyDark = RGB 0.1843 0.3098 0.3098 + slateGreyLight = RGB 0.4667 0.5333 0.6000 + warmGrey = RGB 0.5000 0.5000 0.4100 + + -- Blacks + black = RGB 0.0000 0.0000 0.0000 + ivoryBlack = RGB 0.1600 0.1400 0.1300 + lampBlack = RGB 0.1800 0.2800 0.2300 + + -- Reds + alizarinCrimson = RGB 0.8900 0.1500 0.2100 + brick = RGB 0.6100 0.4000 0.1200 + cadmiumRedDeep = RGB 0.8900 0.0900 0.0500 + coral = RGB 1.0000 0.4980 0.3137 + coralLight = RGB 0.9412 0.5020 0.5020 + deepPink = RGB 1.0000 0.0784 0.5765 + englishRed = RGB 0.8300 0.2400 0.1000 + firebrick = RGB 0.6980 0.1333 0.1333 + geraniumLake = RGB 0.8900 0.0700 0.1900 + hotPink = RGB 1.0000 0.4118 0.7059 + indianRed = RGB 0.6900 0.0900 0.1200 + lightSalmon = RGB 1.0000 0.6275 0.4784 + madderLakeDeep = RGB 0.8900 0.1800 0.1900 + maroon = RGB 0.6902 0.1882 0.3765 + pink = RGB 1.0000 0.7529 0.7961 + pinkLight = RGB 1.0000 0.7137 0.7569 + raspberry = RGB 0.5300 0.1500 0.3400 + red = RGB 1.0000 0.0000 0.0000 + roseMadder = RGB 0.8900 0.2100 0.2200 + salmon = RGB 0.9804 0.5020 0.4471 + tomato = RGB 1.0000 0.3882 0.2784 + venetianRed = RGB 0.8300 0.1000 0.1200 + + -- Browns + beige = RGB 0.6400 0.5800 0.5000 + brown = RGB 0.5000 0.1647 0.1647 + brownMadder = RGB 0.8600 0.1600 0.1600 + brownOchre = RGB 0.5300 0.2600 0.1200 + burlywood = RGB 0.8706 0.7216 0.5294 + burntSienna = RGB 0.5400 0.2100 0.0600 + burntUmber = RGB 0.5400 0.2000 0.1400 + chocolate = RGB 0.8235 0.4118 0.1176 + deepOchre = RGB 0.4500 0.2400 0.1000 + flesh = RGB 1.0000 0.4900 0.2500 + fleshOchre = RGB 1.0000 0.3400 0.1300 + goldOchre = RGB 0.7800 0.4700 0.1500 + greenishUmber = RGB 1.0000 0.2400 0.0500 + khaki = RGB 0.9412 0.9020 0.5490 + khakiDark = RGB 0.7412 0.7176 0.4196 + lightBeige = RGB 0.9608 0.9608 0.8627 + peru = RGB 0.8039 0.5216 0.2471 + rosyBrown = RGB 0.7373 0.5608 0.5608 + rawSienna = RGB 0.7800 0.3800 0.0800 + rawUmber = RGB 0.4500 0.2900 0.0700 + sepia = RGB 0.3700 0.1500 0.0700 + sienna = RGB 0.6275 0.3216 0.1765 + saddleBrown = RGB 0.5451 0.2706 0.0745 + sandyBrown = RGB 0.9569 0.6431 0.3765 + tan = RGB 0.8235 0.7059 0.5490 + vanDykeBrown = RGB 0.3700 0.1500 0.0200 + + -- Oranges + cadmiumOrange = RGB 1.0000 0.3800 0.0100 + cadmiumRedLight = RGB 1.0000 0.0100 0.0500 + carrot = RGB 0.9300 0.5700 0.1300 + darkOrange = RGB 1.0000 0.5490 0.0000 + marsOrange = RGB 0.5900 0.2700 0.0800 + marsYellow = RGB 0.8900 0.4400 0.1000 + orange = RGB 1.0000 0.5000 0.0000 + orangeRed = RGB 1.0000 0.2706 0.0000 + yellowOchre = RGB 0.8900 0.5100 0.0900 + + -- Yellows + aureolineYellow = RGB 1.0000 0.6600 0.1400 + banana = RGB 0.8900 0.8100 0.3400 + cadmiumLemon = RGB 1.0000 0.8900 0.0100 + cadmiumYellow = RGB 1.0000 0.6000 0.0700 + gold = RGB 1.0000 0.8431 0.0000 + goldenrod = RGB 0.8549 0.6471 0.1255 + goldenrodDark = RGB 0.7216 0.5255 0.0431 + goldenrodLight = RGB 0.9804 0.9804 0.8235 + goldenrodPale = RGB 0.9333 0.9098 0.6667 + lightGoldenrod = RGB 0.9333 0.8667 0.5098 + melon = RGB 0.8900 0.6600 0.4100 + naplesYellowDeep = RGB 1.0000 0.6600 0.0700 + yellow = RGB 1.0000 1.0000 0.0000 + yellowLight = RGB 1.0000 1.0000 0.8784 + + -- Greens + chartreuse = RGB 0.4980 1.0000 0.0000 + chromeoxideGreen = RGB 0.4000 0.5000 0.0800 + cinnabarGreen = RGB 0.3800 0.7000 0.1600 + cobaltGreen = RGB 0.2400 0.5700 0.2500 + emeraldGreen = RGB 0.0000 0.7900 0.3400 + forestGreen = RGB 0.1333 0.5451 0.1333 + green = RGB 0.0000 1.0000 0.0000 + greenDark = RGB 0.0000 0.3922 0.0000 + greenPale = RGB 0.5961 0.9843 0.5961 + greenYellow = RGB 0.6784 1.0000 0.1843 + lawnGreen = RGB 0.4863 0.9882 0.0000 + limeGreen = RGB 0.1961 0.8039 0.1961 + mint = RGB 0.7400 0.9900 0.7900 + olive = RGB 0.2300 0.3700 0.1700 + oliveDrab = RGB 0.4196 0.5569 0.1373 + oliveGreenDark = RGB 0.3333 0.4196 0.1843 + permanentGreen = RGB 0.0400 0.7900 0.1700 + sapGreen = RGB 0.1900 0.5000 0.0800 + seaGreen = RGB 0.1804 0.5451 0.3412 + seaGreenDark = RGB 0.5608 0.7373 0.5608 + seaGreenMedium = RGB 0.2353 0.7020 0.4431 + seaGreenLight = RGB 0.1255 0.6980 0.6667 + springGreen = RGB 0.0000 1.0000 0.4980 + springGreenMedium = RGB 0.0000 0.9804 0.6039 + terreVerte = RGB 0.2200 0.3700 0.0600 + viridianLight = RGB 0.4300 1.0000 0.4400 + yellowGreen = RGB 0.6039 0.8039 0.1961 + + -- Cyans + aquamarine = RGB 0.4980 1.0000 0.8314 + aquamarineMedium = RGB 0.4000 0.8039 0.6667 + cyan = RGB 0.0000 1.0000 1.0000 + cyanWhite = RGB 0.8784 1.0000 1.0000 + turquoise = RGB 0.2510 0.8784 0.8157 + turquoiseDark = RGB 0.0000 0.8078 0.8196 + turquoiseMedium = RGB 0.2824 0.8196 0.8000 + turquoisePale = RGB 0.6863 0.9333 0.9333 + + -- Blues + aliceBlue = RGB 0.9412 0.9725 1.0000 + blue = RGB 0.0000 0.0000 1.0000 + blueLight = RGB 0.6784 0.8471 0.9020 + blueMedium = RGB 0.0000 0.0000 0.8039 + cadet = RGB 0.3725 0.6196 0.6275 + cobalt = RGB 0.2400 0.3500 0.6700 + cornflower = RGB 0.3922 0.5843 0.9294 + cerulean = RGB 0.0200 0.7200 0.8000 + dodgerBlue = RGB 0.1176 0.5647 1.0000 + indigo = RGB 0.0300 0.1800 0.3300 + manganeseBlue = RGB 0.0100 0.6600 0.6200 + midnightBlue = RGB 0.0980 0.0980 0.4392 + navy = RGB 0.0000 0.0000 0.5020 + peacock = RGB 0.2000 0.6300 0.7900 + powderBlue = RGB 0.6902 0.8784 0.9020 + royalBlue = RGB 0.2549 0.4118 0.8824 + slateBlue = RGB 0.4157 0.3529 0.8039 + slateBlueDark = RGB 0.2824 0.2392 0.5451 + slateBlueLight = RGB 0.5176 0.4392 1.0000 + slateBlueMedium = RGB 0.4824 0.4078 0.9333 + skyBlue = RGB 0.5294 0.8078 0.9216 + skyBlueDeep = RGB 0.0000 0.7490 1.0000 + skyBlueLight = RGB 0.5294 0.8078 0.9804 + steelBlue = RGB 0.2745 0.5098 0.7059 + steelBlueLight = RGB 0.6902 0.7686 0.8706 + turquoiseBlue = RGB 0.0000 0.7800 0.5500 + ultramarine = RGB 0.0700 0.0400 0.5600 + + -- Magentas + blueViolet = RGB 0.5412 0.1686 0.8863 + cobaltVioletDeep = RGB 0.5700 0.1300 0.6200 + magenta = RGB 1.0000 0.0000 1.0000 + orchid = RGB 0.8549 0.4392 0.8392 + orchidDark = RGB 0.6000 0.1961 0.8000 + orchidMedium = RGB 0.7294 0.3333 0.8275 + permanentViolet = RGB 0.8600 0.1500 0.2700 + plum = RGB 0.8667 0.6275 0.8667 + purple = RGB 0.6275 0.1255 0.9412 + purpleMedium = RGB 0.5765 0.4392 0.8588 + ultramarineViolet = RGB 0.3600 0.1400 0.4300 + violet = RGB 0.5600 0.3700 0.6000 + violetDark = RGB 0.5804 0.0000 0.8275 + violetRed = RGB 0.8157 0.1255 0.5647 + violetRedMedium = RGB 0.7804 0.0824 0.5216 + violetRedPale = RGB 0.8588 0.4392 0.5765 + diff --git a/Data/Array/Accelerate/Data/Colour/RGBA.hs b/Data/Array/Accelerate/Data/Colour/RGBA.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Colour/RGBA.hs @@ -0,0 +1,723 @@ +{-# LANGUAGE CPP #-} +{-# LANGUAGE ConstraintKinds #-} +{-# LANGUAGE DeriveDataTypeable #-} +{-# LANGUAGE DeriveFunctor #-} +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE MultiParamTypeClasses #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TypeFamilies #-} +{-# LANGUAGE UndecidableInstances #-} +{-# LANGUAGE ViewPatterns #-} +#if __GLASGOW_HASKELL__ <= 708 +{-# LANGUAGE OverlappingInstances #-} +{-# OPTIONS_GHC -fno-warn-unrecognised-pragmas #-} +#endif +-- | +-- Module : Data.Array.Accelerate.Data.Colour.RGBA +-- Copyright : [2016] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +-- RGBA quadruples for an unspecified colour space +-- + +module Data.Array.Accelerate.Data.Colour.RGBA ( + + Colour, + RGBA(..), + + rgba, rgba8, + clamp, + blend, + luminance, + opacity, opaque, transparent, + + packRGBA, packABGR, unpackRGBA, unpackABGR, + packRGBA8, packABGR8, unpackRGBA8, unpackABGR8, + +) where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Smart +import Data.Array.Accelerate.Product ( TupleIdx(..), IsProduct(..) ) +import Data.Array.Accelerate.Array.Sugar ( Elt(..), EltRepr, Tuple(..) ) + +import Data.Array.Accelerate.Data.Colour.Names +import Data.Array.Accelerate.Data.Colour.Internal.Pack + +import Data.Typeable +import Prelude as P + + +-- | An RGBA colour value. +-- +type Colour = RGBA Float + + +-- | Construct an RGBA colour from individual channel components. The components +-- will be clamped to the range [0..1]. +-- +rgba :: Exp Float -- ^ red component + -> Exp Float -- ^ green component + -> Exp Float -- ^ blue component + -> Exp Float -- ^ alpha component + -> Exp Colour +rgba r g b a + = clamp + $ lift (RGBA r g b a) + + +-- | Construct a colour from 8-bits-per-channel colour components. +-- +rgba8 + :: Exp Word8 -- ^ red component + -> Exp Word8 -- ^ green component + -> Exp Word8 -- ^ blue component + -> Exp Word8 -- ^ alpha component + -> Exp Colour +rgba8 r g b a + = lift + $ RGBA (A.fromIntegral r / 255) + (A.fromIntegral g / 255) + (A.fromIntegral b / 255) + (A.fromIntegral a / 255) + + +-- | Clamp each component to the range [0..1] +-- +clamp :: Exp Colour -> Exp Colour +clamp = lift1 (fmap c :: RGBA (Exp Float) -> RGBA (Exp Float)) + where + c x = 0 `A.max` x `A.min` 1 + + +-- | Blend two colours in the given proportions. +-- +-- Note that this uses an approximation of gamma=2 (i.e. sum-of-squares method). +-- It is recommended to instead convert to the sRGB colour space if you want +-- more accurate colour blending, or if you intend to use the gamma-corrected +-- values more than once (e.g. in a stencil). +-- +-- > blend c1 c2 ~= SRGB.toRGB ( (SRGB.fromRGB c1 + SRGB.fromRGB c2) / 2 ) +-- +-- See the Blur program in the examples for a comparison of mixing colours in +-- the RGB and sRGB colour spaces. +-- +blend :: Exp Float -- ^ Proportion of first colour + -> Exp Float -- ^ Proportion of second colour + -> Exp Colour -- ^ First colour + -> Exp Colour -- ^ Second colour + -> Exp Colour -- ^ Resulting colour +blend m1 m2 c1 c2 = + let + RGBA r1 g1 b1 a1 = unlift c1 + RGBA r2 g2 b2 a2 = unlift c2 + + -- Normalise mixing proportions to ratios. + m12 = m1 + m2 + m1' = m1 / m12 + m2' = m2 / m12 + + -- Colour components should be added via sum of squares, otherwise the + -- result will be too dark. + r1s = r1 * r1; r2s = r2 * r2 + g1s = g1 * g1; g2s = g2 * g2 + b1s = b1 * b1; b2s = b2 * b2 + in + rgba (sqrt (m1' * r1s + m2' * r2s)) + (sqrt (m1' * g1s + m2' * g2s)) + (sqrt (m1' * b1s + m2' * b2s)) + ((m1 * a1 + m2 * a2) / m12) + + +-- | Luminance of an RGB colour (Y component of a YUV colour). +-- +luminance :: Exp Colour -> Exp Float +luminance (unlift -> RGBA r g b _) = 0.299*r + 0.587*g + 0.114*b + + +-- | Set the opacity of the given colour. The opacity is clamped to the range +-- [0..1]. +-- +opacity :: Exp Float -> Exp Colour -> Exp Colour +opacity a (unlift -> RGBA r g b _) = lift $ RGBA r g b (0 `A.max` a `A.min` 1) + +-- | Make colour transparent +-- +transparent :: Exp Colour -> Exp Colour +transparent = opacity 0 + +-- | A completely opaque colour +-- +opaque :: Exp Colour -> Exp Colour +opaque = opacity 1 + + +-- Packed representation +-- --------------------- + +-- | Convert a Colour into a packed-word RGBA representation +-- +packRGBA :: Exp Colour -> Exp Word32 +packRGBA (unlift -> RGBA r g b a) = + pack8 (word8OfFloat r) (word8OfFloat g) (word8OfFloat b) (word8OfFloat a) + +-- | Convert a colour into a packed-word ABGR representation +-- +packABGR :: Exp Colour -> Exp Word32 +packABGR (unlift -> RGBA r g b a) = + pack8 (word8OfFloat a) (word8OfFloat b) (word8OfFloat g) (word8OfFloat r) + +packRGBA8 :: Exp (RGBA Word8) -> Exp Word32 +packRGBA8 (unlift -> RGBA r g b a) = pack8 r g b a + +packABGR8 :: Exp (RGBA Word8) -> Exp Word32 +packABGR8 (unlift -> RGBA r g b a) = pack8 a b g r + + +-- | Convert a colour from a packed-word RGBA representation +-- +unpackRGBA :: Exp Word32 -> Exp Colour +unpackRGBA w = + let (r,g,b,a::Exp Word8) = unlift (unpack8 w) + in rgba8 r g b a + +-- | Convert a colour from a packed-word ABGR representation +-- +unpackABGR :: Exp Word32 -> Exp Colour +unpackABGR w = + let (a,b,g,r::Exp Word8) = unlift (unpack8 w) + in rgba8 r g b a + +unpackRGBA8 :: Exp Word32 -> Exp (RGBA Word8) +unpackRGBA8 w = + let (r,g,b,a::Exp Word8) = unlift (unpack8 w) + in lift $ RGBA r g b a + +unpackABGR8 :: Exp Word32 -> Exp (RGBA Word8) +unpackABGR8 w = + let (a,b,g,r::Exp Word8) = unlift (unpack8 w) + in lift $ RGBA r g b a + + +-- Accelerate bits +-- --------------- + +-- | An RGBA colour value to hold the colour components. All components lie in +-- the range [0..1). +-- +-- We need to parameterise by a type so that we can have both Exp (RGBA a) and +-- RGBA (Exp a). +-- +data RGBA a = RGBA a a a a + deriving (Show, P.Eq, Functor, Typeable) + +-- Represent colours in Accelerate as a 4-tuple +-- +type instance EltRepr (RGBA a) = EltRepr (a, a, a, a) + +instance Elt a => Elt (RGBA a) where + eltType (_ :: RGBA a) = eltType (undefined :: (a,a,a,a)) + toElt c = let (r,g,b,a) = toElt c in RGBA r g b a + fromElt (RGBA r g b a) = fromElt (r,g,b,a) + +instance Elt a => IsProduct Elt (RGBA a) where + type ProdRepr (RGBA a) = (((((),a), a), a), a) + fromProd _ (RGBA r g b a) = (((((), r), g), b), a) + toProd _ (((((),r),g),b),a) = RGBA r g b a + prod cst _ = prod cst (undefined :: (a,a,a,a)) + +instance (Lift Exp a, Elt (Plain a)) => Lift Exp (RGBA a) where + type Plain (RGBA a) = RGBA (Plain a) + lift (RGBA r g b a) = Exp . Tuple $ NilTup `SnocTup` lift r `SnocTup` lift g + `SnocTup` lift b `SnocTup` lift a + +instance Elt a => Unlift Exp (RGBA (Exp a)) where + unlift c = let r = Exp $ SuccTupIdx (SuccTupIdx (SuccTupIdx ZeroTupIdx)) `Prj` c + g = Exp $ SuccTupIdx (SuccTupIdx ZeroTupIdx) `Prj` c + b = Exp $ SuccTupIdx ZeroTupIdx `Prj` c + a = Exp $ ZeroTupIdx `Prj` c + in RGBA r g b a + +instance P.Num a => P.Num (RGBA a) where + (+) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _) + = RGBA (r1 + r2) (g1 + g2) (b1 + b2) 1 + + (-) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _) + = RGBA (r1 - r2) (g1 - g2) (b1 - b2) 1 + + (*) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _) + = RGBA (r1 * r2) (g1 * g2) (b1 * b2) 1 + + abs (RGBA r1 g1 b1 _) + = RGBA (abs r1) (abs g1) (abs b1) 1 + + signum (RGBA r1 g1 b1 _) + = RGBA (signum r1) (signum g1) (signum b1) 1 + + fromInteger i + = let f = fromInteger i + in RGBA f f f 1 + +instance (P.Num a, P.Fractional a) => P.Fractional (RGBA a) where + (/) (RGBA r1 g1 b1 _) (RGBA r2 g2 b2 _) + = RGBA (r1/r2) (g1/g2) (b1/b2) 1 + + recip (RGBA r1 g1 b1 _) + = RGBA (recip r1) (recip g1) (recip b1) 1 + + fromRational r + = let f = fromRational r + in RGBA f f f 1 + +instance {-# OVERLAPS #-} A.Num a => P.Num (Exp (RGBA a)) where + (+) = lift2 ((+) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) + (-) = lift2 ((-) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) + (*) = lift2 ((*) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) + abs = lift1 (abs :: RGBA (Exp a) -> RGBA (Exp a)) + signum = lift1 (signum :: RGBA (Exp a) -> RGBA (Exp a)) + fromInteger i = let f = fromInteger i + a = fromInteger 1 :: Exp a + in lift $ RGBA f f f a + +instance {-# OVERLAPS #-} A.Fractional a => P.Fractional (Exp (RGBA a)) where + (/) = lift2 ((/) :: RGBA (Exp a) -> RGBA (Exp a) -> RGBA (Exp a)) + recip = lift1 (recip :: RGBA (Exp a) -> RGBA (Exp a)) + fromRational r = let f = fromRational r + a = fromRational 1 :: Exp a + in lift $ RGBA f f f a + + +-- Named colours +-- ------------- + +instance NamedColour (RGBA Word8) where + -- Whites + antiqueWhite = RGBA 250 235 215 255 + azure = RGBA 240 255 255 255 + bisque = RGBA 255 228 196 255 + blanchedAlmond = RGBA 255 235 205 255 + cornsilk = RGBA 255 248 220 255 + eggshell = RGBA 252 230 201 255 + floralWhite = RGBA 255 250 240 255 + gainsboro = RGBA 220 220 220 255 + ghostWhite = RGBA 248 248 255 255 + honeydew = RGBA 240 255 240 255 + ivory = RGBA 255 255 240 255 + lavender = RGBA 230 230 250 255 + lavenderBlush = RGBA 255 240 245 255 + lemonChiffon = RGBA 255 250 205 255 + linen = RGBA 250 240 230 255 + mintCream = RGBA 245 255 250 255 + mistyRose = RGBA 255 228 225 255 + moccasin = RGBA 255 228 181 255 + navajoWhite = RGBA 255 222 173 255 + oldLace = RGBA 253 245 230 255 + papayaWhip = RGBA 255 239 213 255 + peachPuff = RGBA 255 218 185 255 + seashell = RGBA 255 245 238 255 + snow = RGBA 255 250 250 255 + thistle = RGBA 216 191 216 255 + titaniumWhite = RGBA 252 255 240 255 + wheat = RGBA 245 222 179 255 + white = RGBA 255 255 255 255 + whiteSmoke = RGBA 245 245 245 255 + zincWhite = RGBA 253 248 255 255 + + -- Greys + coldGrey = RGBA 128 138 135 255 + dimGrey = RGBA 105 105 105 255 + grey = RGBA 192 192 192 255 + lightGrey = RGBA 211 211 211 255 + slateGrey = RGBA 112 128 144 255 + slateGreyDark = RGBA 47 79 79 255 + slateGreyLight = RGBA 119 136 153 255 + warmGrey = RGBA 128 128 105 255 + + -- Blacks + black = RGBA 0 0 0 255 + ivoryBlack = RGBA 41 36 33 255 + lampBlack = RGBA 46 71 59 255 + + -- Reds + alizarinCrimson = RGBA 227 38 54 255 + brick = RGBA 156 102 31 255 + cadmiumRedDeep = RGBA 227 23 13 255 + coral = RGBA 255 127 80 255 + coralLight = RGBA 240 128 128 255 + deepPink = RGBA 255 20 147 255 + englishRed = RGBA 212 61 26 255 + firebrick = RGBA 178 34 34 255 + geraniumLake = RGBA 227 18 48 255 + hotPink = RGBA 255 105 180 255 + indianRed = RGBA 176 23 31 255 + lightSalmon = RGBA 255 160 122 255 + madderLakeDeep = RGBA 227 46 48 255 + maroon = RGBA 176 48 96 255 + pink = RGBA 255 192 203 255 + pinkLight = RGBA 255 182 193 255 + raspberry = RGBA 135 38 87 255 + red = RGBA 255 0 0 255 + roseMadder = RGBA 227 54 56 255 + salmon = RGBA 250 128 114 255 + tomato = RGBA 255 99 71 255 + venetianRed = RGBA 212 26 31 255 + + -- Browns + beige = RGBA 163 148 128 255 + brown = RGBA 128 42 42 255 + brownMadder = RGBA 219 41 41 255 + brownOchre = RGBA 135 66 31 255 + burlywood = RGBA 222 184 135 255 + burntSienna = RGBA 138 54 15 255 + burntUmber = RGBA 138 51 36 255 + chocolate = RGBA 210 105 30 255 + deepOchre = RGBA 115 61 26 255 + flesh = RGBA 255 125 64 255 + fleshOchre = RGBA 255 87 33 255 + goldOchre = RGBA 199 120 38 255 + greenishUmber = RGBA 255 61 13 255 + khaki = RGBA 240 230 140 255 + khakiDark = RGBA 189 183 107 255 + lightBeige = RGBA 245 245 220 255 + peru = RGBA 205 133 63 255 + rosyBrown = RGBA 188 143 143 255 + rawSienna = RGBA 199 97 20 255 + rawUmber = RGBA 115 74 18 255 + sepia = RGBA 94 38 18 255 + sienna = RGBA 160 82 45 255 + saddleBrown = RGBA 139 69 19 255 + sandyBrown = RGBA 244 164 96 255 + tan = RGBA 210 180 140 255 + vanDykeBrown = RGBA 94 38 5 255 + + -- Oranges + cadmiumOrange = RGBA 255 97 3 255 + cadmiumRedLight = RGBA 255 3 13 255 + carrot = RGBA 237 145 33 255 + darkOrange = RGBA 255 140 0 255 + marsOrange = RGBA 150 69 20 255 + marsYellow = RGBA 227 112 26 255 + orange = RGBA 255 128 0 255 + orangeRed = RGBA 255 69 0 255 + yellowOchre = RGBA 227 130 23 255 + + -- Yellows + aureolineYellow = RGBA 255 168 36 255 + banana = RGBA 227 207 87 255 + cadmiumLemon = RGBA 255 227 3 255 + cadmiumYellow = RGBA 255 153 18 255 + gold = RGBA 255 215 0 255 + goldenrod = RGBA 218 165 32 255 + goldenrodDark = RGBA 184 134 11 255 + goldenrodLight = RGBA 250 250 210 255 + goldenrodPale = RGBA 238 232 170 255 + lightGoldenrod = RGBA 238 221 130 255 + melon = RGBA 227 168 105 255 + naplesYellowDeep = RGBA 255 168 18 255 + yellow = RGBA 255 255 0 255 + yellowLight = RGBA 255 255 224 255 + + -- Greens + chartreuse = RGBA 127 255 0 255 + chromeoxideGreen = RGBA 102 128 20 255 + cinnabarGreen = RGBA 97 179 41 255 + cobaltGreen = RGBA 61 145 64 255 + emeraldGreen = RGBA 0 201 87 255 + forestGreen = RGBA 34 139 34 255 + green = RGBA 0 255 0 255 + greenDark = RGBA 0 100 0 255 + greenPale = RGBA 152 251 152 255 + greenYellow = RGBA 173 255 47 255 + lawnGreen = RGBA 124 252 0 255 + limeGreen = RGBA 50 205 50 255 + mint = RGBA 189 252 201 255 + olive = RGBA 59 94 43 255 + oliveDrab = RGBA 107 142 35 255 + oliveGreenDark = RGBA 85 107 47 255 + permanentGreen = RGBA 10 201 43 255 + sapGreen = RGBA 48 128 20 255 + seaGreen = RGBA 46 139 87 255 + seaGreenDark = RGBA 143 188 143 255 + seaGreenMedium = RGBA 60 179 113 255 + seaGreenLight = RGBA 32 178 170 255 + springGreen = RGBA 0 255 127 255 + springGreenMedium = RGBA 0 250 154 255 + terreVerte = RGBA 56 94 15 255 + viridianLight = RGBA 110 255 112 255 + yellowGreen = RGBA 154 205 50 255 + + -- Cyans + aquamarine = RGBA 127 255 212 255 + aquamarineMedium = RGBA 102 205 170 255 + cyan = RGBA 0 255 255 255 + cyanWhite = RGBA 224 255 255 255 + turquoise = RGBA 64 224 208 255 + turquoiseDark = RGBA 0 206 209 255 + turquoiseMedium = RGBA 72 209 204 255 + turquoisePale = RGBA 175 238 238 255 + + -- Blues + aliceBlue = RGBA 240 248 255 255 + blue = RGBA 0 0 255 255 + blueLight = RGBA 173 216 230 255 + blueMedium = RGBA 0 0 205 255 + cadet = RGBA 95 158 160 255 + cobalt = RGBA 61 89 171 255 + cornflower = RGBA 100 149 237 255 + cerulean = RGBA 5 184 204 255 + dodgerBlue = RGBA 30 144 255 255 + indigo = RGBA 8 46 84 255 + manganeseBlue = RGBA 3 168 158 255 + midnightBlue = RGBA 25 25 112 255 + navy = RGBA 0 0 128 255 + peacock = RGBA 51 161 201 255 + powderBlue = RGBA 176 224 230 255 + royalBlue = RGBA 65 105 225 255 + slateBlue = RGBA 106 90 205 255 + slateBlueDark = RGBA 72 61 139 255 + slateBlueLight = RGBA 132 112 255 255 + slateBlueMedium = RGBA 123 104 238 255 + skyBlue = RGBA 135 206 235 255 + skyBlueDeep = RGBA 0 191 255 255 + skyBlueLight = RGBA 135 206 250 255 + steelBlue = RGBA 70 130 180 255 + steelBlueLight = RGBA 176 196 222 255 + turquoiseBlue = RGBA 0 199 140 255 + ultramarine = RGBA 18 10 143 255 + + -- Magentas + blueViolet = RGBA 138 43 226 255 + cobaltVioletDeep = RGBA 145 33 158 255 + magenta = RGBA 255 0 255 255 + orchid = RGBA 218 112 214 255 + orchidDark = RGBA 153 50 204 255 + orchidMedium = RGBA 186 85 211 255 + permanentViolet = RGBA 219 38 69 255 + plum = RGBA 221 160 221 255 + purple = RGBA 160 32 240 255 + purpleMedium = RGBA 147 112 219 255 + ultramarineViolet = RGBA 92 36 110 255 + violet = RGBA 143 94 153 255 + violetDark = RGBA 148 0 211 255 + violetRed = RGBA 208 32 144 255 + violetRedMedium = RGBA 199 21 133 255 + violetRedPale = RGBA 219 112 147 255 + +instance NamedColour (RGBA Float) where + -- Whites + antiqueWhite = RGBA 0.9804 0.9216 0.8431 1.0000 + azure = RGBA 0.9412 1.0000 1.0000 1.0000 + bisque = RGBA 1.0000 0.8941 0.7686 1.0000 + blanchedAlmond = RGBA 1.0000 0.9216 0.8039 1.0000 + cornsilk = RGBA 1.0000 0.9725 0.8627 1.0000 + eggshell = RGBA 0.9900 0.9000 0.7900 1.0000 + floralWhite = RGBA 1.0000 0.9804 0.9412 1.0000 + gainsboro = RGBA 0.8627 0.8627 0.8627 1.0000 + ghostWhite = RGBA 0.9725 0.9725 1.0000 1.0000 + honeydew = RGBA 0.9412 1.0000 0.9412 1.0000 + ivory = RGBA 1.0000 1.0000 0.9412 1.0000 + lavender = RGBA 0.9020 0.9020 0.9804 1.0000 + lavenderBlush = RGBA 1.0000 0.9412 0.9608 1.0000 + lemonChiffon = RGBA 1.0000 0.9804 0.8039 1.0000 + linen = RGBA 0.9804 0.9412 0.9020 1.0000 + mintCream = RGBA 0.9608 1.0000 0.9804 1.0000 + mistyRose = RGBA 1.0000 0.8941 0.8824 1.0000 + moccasin = RGBA 1.0000 0.8941 0.7098 1.0000 + navajoWhite = RGBA 1.0000 0.8706 0.6784 1.0000 + oldLace = RGBA 0.9922 0.9608 0.9020 1.0000 + papayaWhip = RGBA 1.0000 0.9373 0.8353 1.0000 + peachPuff = RGBA 1.0000 0.8549 0.7255 1.0000 + seashell = RGBA 1.0000 0.9608 0.9333 1.0000 + snow = RGBA 1.0000 0.9804 0.9804 1.0000 + thistle = RGBA 0.8471 0.7490 0.8471 1.0000 + titaniumWhite = RGBA 0.9900 1.0000 0.9400 1.0000 + wheat = RGBA 0.9608 0.8706 0.7020 1.0000 + white = RGBA 1.0000 1.0000 1.0000 1.0000 + whiteSmoke = RGBA 0.9608 0.9608 0.9608 1.0000 + zincWhite = RGBA 0.9900 0.9700 1.0000 1.0000 + + -- Greys + coldGrey = RGBA 0.5000 0.5400 0.5300 1.0000 + dimGrey = RGBA 0.4118 0.4118 0.4118 1.0000 + grey = RGBA 0.7529 0.7529 0.7529 1.0000 + lightGrey = RGBA 0.8275 0.8275 0.8275 1.0000 + slateGrey = RGBA 0.4392 0.5020 0.5647 1.0000 + slateGreyDark = RGBA 0.1843 0.3098 0.3098 1.0000 + slateGreyLight = RGBA 0.4667 0.5333 0.6000 1.0000 + warmGrey = RGBA 0.5000 0.5000 0.4100 1.0000 + + -- Blacks + black = RGBA 0.0000 0.0000 0.0000 1.0000 + ivoryBlack = RGBA 0.1600 0.1400 0.1300 1.0000 + lampBlack = RGBA 0.1800 0.2800 0.2300 1.0000 + + -- Reds + alizarinCrimson = RGBA 0.8900 0.1500 0.2100 1.0000 + brick = RGBA 0.6100 0.4000 0.1200 1.0000 + cadmiumRedDeep = RGBA 0.8900 0.0900 0.0500 1.0000 + coral = RGBA 1.0000 0.4980 0.3137 1.0000 + coralLight = RGBA 0.9412 0.5020 0.5020 1.0000 + deepPink = RGBA 1.0000 0.0784 0.5765 1.0000 + englishRed = RGBA 0.8300 0.2400 0.1000 1.0000 + firebrick = RGBA 0.6980 0.1333 0.1333 1.0000 + geraniumLake = RGBA 0.8900 0.0700 0.1900 1.0000 + hotPink = RGBA 1.0000 0.4118 0.7059 1.0000 + indianRed = RGBA 0.6900 0.0900 0.1200 1.0000 + lightSalmon = RGBA 1.0000 0.6275 0.4784 1.0000 + madderLakeDeep = RGBA 0.8900 0.1800 0.1900 1.0000 + maroon = RGBA 0.6902 0.1882 0.3765 1.0000 + pink = RGBA 1.0000 0.7529 0.7961 1.0000 + pinkLight = RGBA 1.0000 0.7137 0.7569 1.0000 + raspberry = RGBA 0.5300 0.1500 0.3400 1.0000 + red = RGBA 1.0000 0.0000 0.0000 1.0000 + roseMadder = RGBA 0.8900 0.2100 0.2200 1.0000 + salmon = RGBA 0.9804 0.5020 0.4471 1.0000 + tomato = RGBA 1.0000 0.3882 0.2784 1.0000 + venetianRed = RGBA 0.8300 0.1000 0.1200 1.0000 + + -- Browns + beige = RGBA 0.6400 0.5800 0.5000 1.0000 + brown = RGBA 0.5000 0.1647 0.1647 1.0000 + brownMadder = RGBA 0.8600 0.1600 0.1600 1.0000 + brownOchre = RGBA 0.5300 0.2600 0.1200 1.0000 + burlywood = RGBA 0.8706 0.7216 0.5294 1.0000 + burntSienna = RGBA 0.5400 0.2100 0.0600 1.0000 + burntUmber = RGBA 0.5400 0.2000 0.1400 1.0000 + chocolate = RGBA 0.8235 0.4118 0.1176 1.0000 + deepOchre = RGBA 0.4500 0.2400 0.1000 1.0000 + flesh = RGBA 1.0000 0.4900 0.2500 1.0000 + fleshOchre = RGBA 1.0000 0.3400 0.1300 1.0000 + goldOchre = RGBA 0.7800 0.4700 0.1500 1.0000 + greenishUmber = RGBA 1.0000 0.2400 0.0500 1.0000 + khaki = RGBA 0.9412 0.9020 0.5490 1.0000 + khakiDark = RGBA 0.7412 0.7176 0.4196 1.0000 + lightBeige = RGBA 0.9608 0.9608 0.8627 1.0000 + peru = RGBA 0.8039 0.5216 0.2471 1.0000 + rosyBrown = RGBA 0.7373 0.5608 0.5608 1.0000 + rawSienna = RGBA 0.7800 0.3800 0.0800 1.0000 + rawUmber = RGBA 0.4500 0.2900 0.0700 1.0000 + sepia = RGBA 0.3700 0.1500 0.0700 1.0000 + sienna = RGBA 0.6275 0.3216 0.1765 1.0000 + saddleBrown = RGBA 0.5451 0.2706 0.0745 1.0000 + sandyBrown = RGBA 0.9569 0.6431 0.3765 1.0000 + tan = RGBA 0.8235 0.7059 0.5490 1.0000 + vanDykeBrown = RGBA 0.3700 0.1500 0.0200 1.0000 + + -- Oranges + cadmiumOrange = RGBA 1.0000 0.3800 0.0100 1.0000 + cadmiumRedLight = RGBA 1.0000 0.0100 0.0500 1.0000 + carrot = RGBA 0.9300 0.5700 0.1300 1.0000 + darkOrange = RGBA 1.0000 0.5490 0.0000 1.0000 + marsOrange = RGBA 0.5900 0.2700 0.0800 1.0000 + marsYellow = RGBA 0.8900 0.4400 0.1000 1.0000 + orange = RGBA 1.0000 0.5000 0.0000 1.0000 + orangeRed = RGBA 1.0000 0.2706 0.0000 1.0000 + yellowOchre = RGBA 0.8900 0.5100 0.0900 1.0000 + + -- Yellows + aureolineYellow = RGBA 1.0000 0.6600 0.1400 1.0000 + banana = RGBA 0.8900 0.8100 0.3400 1.0000 + cadmiumLemon = RGBA 1.0000 0.8900 0.0100 1.0000 + cadmiumYellow = RGBA 1.0000 0.6000 0.0700 1.0000 + gold = RGBA 1.0000 0.8431 0.0000 1.0000 + goldenrod = RGBA 0.8549 0.6471 0.1255 1.0000 + goldenrodDark = RGBA 0.7216 0.5255 0.0431 1.0000 + goldenrodLight = RGBA 0.9804 0.9804 0.8235 1.0000 + goldenrodPale = RGBA 0.9333 0.9098 0.6667 1.0000 + lightGoldenrod = RGBA 0.9333 0.8667 0.5098 1.0000 + melon = RGBA 0.8900 0.6600 0.4100 1.0000 + naplesYellowDeep = RGBA 1.0000 0.6600 0.0700 1.0000 + yellow = RGBA 1.0000 1.0000 0.0000 1.0000 + yellowLight = RGBA 1.0000 1.0000 0.8784 1.0000 + + -- Greens + chartreuse = RGBA 0.4980 1.0000 0.0000 1.0000 + chromeoxideGreen = RGBA 0.4000 0.5000 0.0800 1.0000 + cinnabarGreen = RGBA 0.3800 0.7000 0.1600 1.0000 + cobaltGreen = RGBA 0.2400 0.5700 0.2500 1.0000 + emeraldGreen = RGBA 0.0000 0.7900 0.3400 1.0000 + forestGreen = RGBA 0.1333 0.5451 0.1333 1.0000 + green = RGBA 0.0000 1.0000 0.0000 1.0000 + greenDark = RGBA 0.0000 0.3922 0.0000 1.0000 + greenPale = RGBA 0.5961 0.9843 0.5961 1.0000 + greenYellow = RGBA 0.6784 1.0000 0.1843 1.0000 + lawnGreen = RGBA 0.4863 0.9882 0.0000 1.0000 + limeGreen = RGBA 0.1961 0.8039 0.1961 1.0000 + mint = RGBA 0.7400 0.9900 0.7900 1.0000 + olive = RGBA 0.2300 0.3700 0.1700 1.0000 + oliveDrab = RGBA 0.4196 0.5569 0.1373 1.0000 + oliveGreenDark = RGBA 0.3333 0.4196 0.1843 1.0000 + permanentGreen = RGBA 0.0400 0.7900 0.1700 1.0000 + sapGreen = RGBA 0.1900 0.5000 0.0800 1.0000 + seaGreen = RGBA 0.1804 0.5451 0.3412 1.0000 + seaGreenDark = RGBA 0.5608 0.7373 0.5608 1.0000 + seaGreenMedium = RGBA 0.2353 0.7020 0.4431 1.0000 + seaGreenLight = RGBA 0.1255 0.6980 0.6667 1.0000 + springGreen = RGBA 0.0000 1.0000 0.4980 1.0000 + springGreenMedium = RGBA 0.0000 0.9804 0.6039 1.0000 + terreVerte = RGBA 0.2200 0.3700 0.0600 1.0000 + viridianLight = RGBA 0.4300 1.0000 0.4400 1.0000 + yellowGreen = RGBA 0.6039 0.8039 0.1961 1.0000 + + -- Cyans + aquamarine = RGBA 0.4980 1.0000 0.8314 1.0000 + aquamarineMedium = RGBA 0.4000 0.8039 0.6667 1.0000 + cyan = RGBA 0.0000 1.0000 1.0000 1.0000 + cyanWhite = RGBA 0.8784 1.0000 1.0000 1.0000 + turquoise = RGBA 0.2510 0.8784 0.8157 1.0000 + turquoiseDark = RGBA 0.0000 0.8078 0.8196 1.0000 + turquoiseMedium = RGBA 0.2824 0.8196 0.8000 1.0000 + turquoisePale = RGBA 0.6863 0.9333 0.9333 1.0000 + + -- Blues + aliceBlue = RGBA 0.9412 0.9725 1.0000 1.0000 + blue = RGBA 0.0000 0.0000 1.0000 1.0000 + blueLight = RGBA 0.6784 0.8471 0.9020 1.0000 + blueMedium = RGBA 0.0000 0.0000 0.8039 1.0000 + cadet = RGBA 0.3725 0.6196 0.6275 1.0000 + cobalt = RGBA 0.2400 0.3500 0.6700 1.0000 + cornflower = RGBA 0.3922 0.5843 0.9294 1.0000 + cerulean = RGBA 0.0200 0.7200 0.8000 1.0000 + dodgerBlue = RGBA 0.1176 0.5647 1.0000 1.0000 + indigo = RGBA 0.0300 0.1800 0.3300 1.0000 + manganeseBlue = RGBA 0.0100 0.6600 0.6200 1.0000 + midnightBlue = RGBA 0.0980 0.0980 0.4392 1.0000 + navy = RGBA 0.0000 0.0000 0.5020 1.0000 + peacock = RGBA 0.2000 0.6300 0.7900 1.0000 + powderBlue = RGBA 0.6902 0.8784 0.9020 1.0000 + royalBlue = RGBA 0.2549 0.4118 0.8824 1.0000 + slateBlue = RGBA 0.4157 0.3529 0.8039 1.0000 + slateBlueDark = RGBA 0.2824 0.2392 0.5451 1.0000 + slateBlueLight = RGBA 0.5176 0.4392 1.0000 1.0000 + slateBlueMedium = RGBA 0.4824 0.4078 0.9333 1.0000 + skyBlue = RGBA 0.5294 0.8078 0.9216 1.0000 + skyBlueDeep = RGBA 0.0000 0.7490 1.0000 1.0000 + skyBlueLight = RGBA 0.5294 0.8078 0.9804 1.0000 + steelBlue = RGBA 0.2745 0.5098 0.7059 1.0000 + steelBlueLight = RGBA 0.6902 0.7686 0.8706 1.0000 + turquoiseBlue = RGBA 0.0000 0.7800 0.5500 1.0000 + ultramarine = RGBA 0.0700 0.0400 0.5600 1.0000 + + -- Magentas + blueViolet = RGBA 0.5412 0.1686 0.8863 1.0000 + cobaltVioletDeep = RGBA 0.5700 0.1300 0.6200 1.0000 + magenta = RGBA 1.0000 0.0000 1.0000 1.0000 + orchid = RGBA 0.8549 0.4392 0.8392 1.0000 + orchidDark = RGBA 0.6000 0.1961 0.8000 1.0000 + orchidMedium = RGBA 0.7294 0.3333 0.8275 1.0000 + permanentViolet = RGBA 0.8600 0.1500 0.2700 1.0000 + plum = RGBA 0.8667 0.6275 0.8667 1.0000 + purple = RGBA 0.6275 0.1255 0.9412 1.0000 + purpleMedium = RGBA 0.5765 0.4392 0.8588 1.0000 + ultramarineViolet = RGBA 0.3600 0.1400 0.4300 1.0000 + violet = RGBA 0.5600 0.3700 0.6000 1.0000 + violetDark = RGBA 0.5804 0.0000 0.8275 1.0000 + violetRed = RGBA 0.8157 0.1255 0.5647 1.0000 + violetRedMedium = RGBA 0.7804 0.0824 0.5216 1.0000 + violetRedPale = RGBA 0.8588 0.4392 0.5765 1.0000 + diff --git a/Data/Array/Accelerate/Data/Colour/SRGB.hs b/Data/Array/Accelerate/Data/Colour/SRGB.hs new file mode 100644 --- /dev/null +++ b/Data/Array/Accelerate/Data/Colour/SRGB.hs @@ -0,0 +1,109 @@ +{-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-- | +-- Module : Data.Array.Accelerate.Data.Colour.SRGB +-- Copyright : [2016] Trevor L. McDonell +-- License : BSD3 +-- +-- Maintainer : Trevor L. McDonell +-- Stability : experimental +-- Portability : non-portable (GHC extensions) +-- +-- Colours in the sRGB standard. +-- + +module Data.Array.Accelerate.Data.Colour.SRGB ( + + Colour, + SRGB, + srgb, srgb8, + toRGB, fromRGB, + +) where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Data.Colour.RGB ( RGB(..) ) + +import Data.Functor ( fmap ) + + +-- | An sRGB colour value +-- +type Colour = SRGB Float + +-- | Synonym for an RGB colour that is in the sRGB colour space. +-- +type SRGB a = RGB a + +-- | Construct an sRGB colour from individual channel components. The components +-- will be clamped to the range [0..1]. +-- +srgb :: Exp Float -- ^ red component + -> Exp Float -- ^ green component + -> Exp Float -- ^ blue component + -> Exp Colour +srgb r g b + = clamp + $ lift (RGB r g b) + + +-- | Construct an sRGB colour from 8-bit-per-channel colour components. +-- +srgb8 :: Exp Word8 -- ^ red component + -> Exp Word8 -- ^ green component + -> Exp Word8 -- ^ blue component + -> Exp Colour +srgb8 r g b + = lift + $ RGB (fromIntegral r / 255) + (fromIntegral g / 255) + (fromIntegral b / 255) + + +-- | Clamp each component of a colour to the range [0..1]. +-- +clamp :: Exp Colour -> Exp Colour +clamp = lift1 (fmap c :: SRGB (Exp Float) -> SRGB (Exp Float)) + where + c x = 0 `max` x `min` 1 + + +-- | Convert a colour in the non-linear RGB colour space into the linear sRGB +-- colour space. +-- +fromRGB :: Exp (RGB Float) -> Exp (SRGB Float) +fromRGB (unlift -> RGB r g b) + = lift + $ RGB (invTransferFunction r) + (invTransferFunction g) + (invTransferFunction b) + +-- | Convert a colour in the linear sRGB colour space into the non-linear RGB +-- colour space. +-- +toRGB :: Exp (SRGB Float) -> Exp (RGB Float) +toRGB (unlift -> RGB r g b) + = lift + $ RGB (transferFunction r) + (transferFunction g) + (transferFunction b) + + +-- The non-linear sRGB transfer function approximates a gamma of about 2.2. +-- +transferFunction :: Exp Float -> Exp Float +transferFunction lin + = lin == 1 ? ( 1 + , lin <= 0.0031308 ? ( 12.92 * lin + , {- otherwise -} let a = 0.055 + in (1 + a)*lin**(1/2.4) - a )) + +invTransferFunction :: Exp Float -> Exp Float +invTransferFunction nonlin + = nonlin == 1 ? ( 1 + , nonlin <= 0.04045 ? ( nonlin/12.92 + , {- otherwise -} let a = 0.055 + in ((nonlin + a)/(1 + a))**2.4 )) + diff --git a/LICENSE b/LICENSE new file mode 100644 --- /dev/null +++ b/LICENSE @@ -0,0 +1,30 @@ +Copyright (c) 2016, Trevor L. McDonell + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Trevor L. McDonell nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff --git a/README.md b/README.md new file mode 100644 --- /dev/null +++ b/README.md @@ -0,0 +1,37 @@ +colour-accelerate +================= + +[![Build Status](https://travis-ci.org/tmcdonell/colour-accelerate.svg?branch=master)](https://travis-ci.org/tmcdonell/colour-accelerate) + +This package provides data types and operations for dealing with colours in +Accelerate. For details on Accelerate, refer to the [main +repository](https://github.com/AccelerateHS/accelerate). + + +Example: Blur +------------- + +| Test image | sRGB | RGB | +|:----------:|:----:|:---:| +| ![Test image][blocks] | ![sRGB linear][blur_srgb] | ![RGB non-linear][blur_rgb] | + +The test image on the left is composed of blocks and bars of the primary and +secondary colours, arranged so that each colour is juxtaposed next to all +others, plus black and white. + +The image in the centre is created by blurring the original with a 9x9 Gaussian +filter in the linear gamma sRGB space. + +The image on the right is created by blurring with the same 9x9 Gaussian filter +in the standard non-linear RGB colour space. Note the dark regions separating +red from green and cyan, and blue from red and green; purple lines separate cyan +from red and magenta; green separates yellow from cyan. These regions are +artefacts produced by mixing colours in the RGB colour space. + +The files to generate the test image and run the demonstration are in the +examples directory. + + +[blocks]: https://github.com/tmcdonell/colour-accelerate/raw/master/samples/blocks.bmp +[blur_srgb]: https://github.com/tmcdonell/colour-accelerate/raw/master/samples/blur_srgb.bmp +[blur_rgb]: https://github.com/tmcdonell/colour-accelerate/raw/master/samples/blur_rgb.bmp diff --git a/Setup.hs b/Setup.hs new file mode 100644 --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/colour-accelerate.cabal b/colour-accelerate.cabal new file mode 100644 --- /dev/null +++ b/colour-accelerate.cabal @@ -0,0 +1,59 @@ +name: colour-accelerate +version: 0.1.0.0 +synopsis: Working with colours in Accelerate +description: + This package provides data types for colours and transparency for use with + Accelerate. For further information refer to the main /Accelerate/ package: + . + +license: BSD3 +license-file: LICENSE +author: Trevor L. McDonell +maintainer: Trevor L. McDonell +copyright: Copyright (c) [2016]. Trevor L. McDonell +category: Data, Graphics +build-type: Simple +cabal-version: >=1.10 + +homepage: https://github.com/tmcdonell/colour-accelerate +bug-reports: https://github.com/tmcdonell/colour-accelerate/issues + +extra-source-files: + README.md + examples/*.hs + +extra-doc-files: + samples/*.bmp + samples/swatch/*.bmp + +library + default-language: Haskell2010 + build-depends: + base >= 4.7 && < 4.10 + , accelerate >= 0.16 + + ghc-options: -Wall + + exposed-modules: + Data.Array.Accelerate.Data.Colour.HSL + Data.Array.Accelerate.Data.Colour.HSV + Data.Array.Accelerate.Data.Colour.RGB + Data.Array.Accelerate.Data.Colour.RGBA + Data.Array.Accelerate.Data.Colour.SRGB + -- + Data.Array.Accelerate.Data.Colour.Names + + other-modules: + Data.Array.Accelerate.Data.Colour.Internal.Pack + +source-repository head + type: git + location: https://github.com/tmcdonell/colour-accelerate + +source-repository this + type: git + tag: 0.1.0.0 + location: https://github.com/tmcdonell/colour-accelerate + +-- vim: nospell + diff --git a/examples/Blur.hs b/examples/Blur.hs new file mode 100644 --- /dev/null +++ b/examples/Blur.hs @@ -0,0 +1,106 @@ +{-# LANGUAGE FlexibleContexts #-} +-- +-- Example demonstrating artefacts caused by combining colour values in the +-- non-linear RGB colour space. +-- +-- Test image (and more information) available at: +-- +-- +-- +-- Note in the given test image (blocks.bmp, generated by TestImage.hs) the +-- boundaries between the different colours: +-- +-- * In the linear-gamma sRGB colour space colours blend smoothly. +-- +-- * In the non-linear gamma RGB image, there are dark regions separating red +-- from green and cyan, and blue from red and green; purple lines separate +-- cyan from red and magenta; green separates yellow from cyan. These dark +-- lines are artefacts produces from mixing colours in the non-linear RGB +-- colour space. +-- + +module Main where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Interpreter as A +import Data.Array.Accelerate.IO as A -- package: accelerate-io +import Data.Array.Accelerate.Data.Colour.RGB as RGB +import Data.Array.Accelerate.Data.Colour.SRGB as SRGB + +import Control.Monad +import System.FilePath +import System.Directory +import System.Environment +import Prelude as P + + +type Image a = Array DIM2 a + +type Stencil5x1 a = (Stencil3 a, Stencil5 a, Stencil3 a) +type Stencil1x5 a = (Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a) + +type Stencil9x1 a = (Stencil3 a, Stencil9 a, Stencil3 a) +type Stencil1x9 a = (Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a, Stencil3 a) + + +convolve5x1 :: A.Num a => [Exp a] -> Stencil5x1 a -> Exp a +convolve5x1 kernel (_, (a,b,c,d,e), _) + = P.sum $ P.zipWith (*) kernel [a,b,c,d,e] + +convolve1x5 :: A.Num a => [Exp a] -> Stencil1x5 a -> Exp a +convolve1x5 kernel ((_,a,_), (_,b,_), (_,c,_), (_,d,_), (_,e,_)) + = P.sum $ P.zipWith (*) kernel [a,b,c,d,e] + +convolve9x1 :: A.Num a => [Exp a] -> Stencil9x1 a -> Exp a +convolve9x1 kernel (_, (a,b,c,d,e,f,g,h,i), _) + = P.sum $ P.zipWith (*) kernel [a,b,c,d,e,f,g,h,i] + +convolve1x9 :: A.Num a => [Exp a] -> Stencil1x9 a -> Exp a +convolve1x9 kernel ((_,a,_), (_,b,_), (_,c,_), (_,d,_), (_,e,_), (_,f,_), (_,g,_), (_,h,_), (_,i,_)) + = P.sum $ P.zipWith (*) kernel [a,b,c,d,e,f,g,h,i] + + +-- Separable Gaussian blur in the x- and y-directions +-- +gaussianX :: Acc (Image (RGB Float)) -> Acc (Image (RGB Float)) +gaussianX = stencil (convolve9x1 gaussian9) Clamp + +gaussianY :: Acc (Image (RGB Float)) -> Acc (Image (RGB Float)) +gaussianY = stencil (convolve1x9 gaussian9) Clamp + +-- +-- +gaussian5, gaussian9 :: [Exp (RGB Float)] +gaussian5 = [0.06136,0.24477,0.38774,0.24477,0.06136] +gaussian9 = [0.028532,0.067234,0.124009,0.179044,0.20236,0.179044,0.124009,0.067234,0.028532] + + + +main :: IO () +main = do + argv <- getArgs + let inputFile = case argv of + [] -> "blocks.bmp" + f:_ -> f + + exists <- doesFileExist inputFile + unless exists $ + error $ unlines [ "usage: blur " + , "" + , "If no input image is specified, the default 'blocks.bmp'" + , "in the current directory will be used (if available)." + ] + + input <- either (error . show) id `fmap` readImageFromBMP inputFile + + let name f = "blur_" P.++ f <.> "bmp" + + img = A.map unpackRGB (use input) + blur = gaussianY . gaussianX + + rgb_blur = blur img + srgb_blur = A.map toRGB . blur . A.map fromRGB $ img + + writeImageToBMP (name "rgb") $ run $ A.map packRGB rgb_blur + writeImageToBMP (name "srgb") $ run $ A.map packRGB srgb_blur + diff --git a/examples/Picker.hs b/examples/Picker.hs new file mode 100644 --- /dev/null +++ b/examples/Picker.hs @@ -0,0 +1,58 @@ +{-# LANGUAGE ViewPatterns #-} +-- +-- Example for generating a HSV colour map +-- +-- 0 hue 360 +-- +-----------------------------------------------------------------> +-- 0 | black | +-- | | +-- | | +-- sat=1 val | | +-- | | +-- | red green blue red | +-- 1 v | +-- 0 | yellow cyan magenta | +-- | | +-- | | +-- val=1 sat | | +-- | | +-- | white | +-- 1 v-----------------------------------------------------------------+ + +module Main where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.IO as A -- package: accelerate-io +import Data.Array.Accelerate.Interpreter as A + +import Data.Array.Accelerate.Data.Colour.HSV as HSV +import Data.Array.Accelerate.Data.Colour.RGB ( packRGB ) + +import Prelude as P + + +zoom, width, height :: Int +zoom = 4 +width = 360 * zoom +height = 100 * 2 * zoom + + +picker :: Acc (Array DIM2 Colour) +picker = A.generate (constant (Z :. height :. width)) palette + where + palette :: Exp DIM2 -> Exp Colour + palette (unlift -> Z :. y :. x) = + let + c = A.fromIntegral y / P.fromIntegral height + h = A.fromIntegral x / P.fromIntegral width * 360 + sv = c A.>* 0.5 ? ( lift (constant 1, (1-c)*2) + , lift (c*2, constant 1) ) + in + lift $ HSV h (A.fst sv) (A.snd sv) + + +main :: IO () +main + = writeImageToBMP "hsv.bmp" + $ run $ A.map (packRGB . toRGB) picker + diff --git a/examples/Ramp.hs b/examples/Ramp.hs new file mode 100644 --- /dev/null +++ b/examples/Ramp.hs @@ -0,0 +1,60 @@ +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-- +-- Example for generating a hot-to-cold colour ramp +-- +-- +-- +-- (max+2*min)/4 (3*max+min)/4 +-- min (max+min)/2 max +-- +------------------+------------------+------------------+------------------+ +-- | | +-- | | +-- +------------------+------------------+------------------+------------------+ +-- blue cyan green yellow red +-- + +module Main where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.IO as A -- package: accelerate-io +import Data.Array.Accelerate.Interpreter as A + +import Data.Array.Accelerate.Data.Colour.RGB as RGB + +import Prelude as P + +zoom, width, height :: Int +zoom = 10 +width = 100 * zoom +height = 10 * zoom + + +-- The "standard" hot-to-cold colour map. Given a scalar v in the range +-- [vmin..vmax], each colour component ranges from 0 (no contribution) to +-- 1 (fully saturated). +-- +ramp :: Exp Float -- minimum value + -> Exp Float -- maximum value + -> Exp Float -- point in the range + -> Exp Colour +ramp vmin vmax (A.min vmax . A.max vmin -> v) + = v A.<* vmin + 0.25 * dv ? ( lift (RGB 0 (4 * (v - vmin) / dv) 1) + , v A.<* vmin + 0.50 * dv ? ( lift (RGB 0 1 (1 + 4 * (vmin + 0.25 * dv - v) / dv )) + , v A.<* vmin + 0.75 * dv ? ( lift (RGB (4 * (v - vmin - 0.5 * dv) / dv) 1 0) + , {- otherwise -} lift (RGB 1 (1 + 4 * (vmin + 0.75 * dv - v) / dv) 0) ))) + where + dv = vmax - vmin + +picker :: Acc (Array DIM2 Colour) +picker = A.generate (constant (Z :. height :. width)) palette + where + palette :: Exp DIM2 -> Exp Colour + palette (unlift -> Z :. (_::Exp Int) :. x) = + ramp 0 (P.fromIntegral width) (A.fromIntegral x) + +main :: IO () +main + = writeImageToBMP "hot.bmp" + $ run $ A.map packRGB picker + diff --git a/examples/Swatch.hs b/examples/Swatch.hs new file mode 100644 --- /dev/null +++ b/examples/Swatch.hs @@ -0,0 +1,42 @@ +{-# LANGUAGE QuasiQuotes #-} +{-# LANGUAGE TemplateHaskell #-} + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.IO +import Data.Array.Accelerate.Data.Colour.RGB +import Data.Array.Accelerate.Data.Colour.Names +import Data.Array.Accelerate.Interpreter as I + +import System.FilePath +import Language.Haskell.TH as TH +import Prelude as P + + +swatch :: Colour -> Array DIM2 Word32 +swatch c + = I.run + $ A.map packRGB + $ A.fill (constant (Z:.50:.200)) (constant c) + +$(runQ $ do + let + swatches :: Q [TH.Exp] + swatches = do + ns <- names + sequence [ [| writeImageToBMP $(stringE ("samples" "swatch" nameBase n <.> "bmp")) (swatch $(varE n)) |] + | n <- ns ] + + names :: Q [TH.Name] + names = do + info <- reify ''NamedColour + case info of + ClassI (ClassD _ _ _ _ ds) _ -> return [ n | SigD n _ <- ds ] + _ -> return [] + + body <- swatches + return + [ SigD (mkName "main") (AppT (ConT (mkName "IO")) (ConT (mkName "()"))) + , FunD (mkName "main") [Clause [] (NormalB (DoE (P.map NoBindS body))) []] + ] + ) + diff --git a/examples/TestImage.hs b/examples/TestImage.hs new file mode 100644 --- /dev/null +++ b/examples/TestImage.hs @@ -0,0 +1,44 @@ + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Interpreter + +import Data.Array.Accelerate.IO +import Data.Array.Accelerate.Data.Colour.RGB +import Data.Array.Accelerate.Data.Colour.Names + + +zoom :: Int +zoom = 25 + +test :: Acc (Array DIM2 (RGB Word8)) +test = A.generate (constant (Z :. 19*zoom :. 12*zoom)) go + where + go :: Exp DIM2 -> Exp (RGB Word8) + go ix = + let Z :. y :. x = unlift ix + j = y `div` constant zoom + i = x `div` constant zoom + in + -- by row + j ==* 0 ? ( constant black + , j ==* 3 ? ( constant magenta + , j ==* 6 ? ( constant cyan + , j ==* 9 ? ( constant yellow + , j ==* 12 ? ( constant blue + , j ==* 15 ? ( constant red + , j ==* 18 ? ( constant white + -- otherwise by column + , i <=* 1 ? ( constant red + , i <=* 3 ? ( constant green + , i <=* 5 ? ( constant blue + , i <=* 7 ? ( constant yellow + , i <=* 9 ? ( constant cyan + , i <=* 11 ? ( constant magenta + , {- otherwise -} constant black ))))))))))))) + + +main :: IO () +main + = writeImageToBMP "blocks.bmp" + $ run (A.map packRGB8 test) + diff --git a/examples/Ultra.hs b/examples/Ultra.hs new file mode 100644 --- /dev/null +++ b/examples/Ultra.hs @@ -0,0 +1,158 @@ +{-# LANGUAGE RebindableSyntax #-} +{-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE ViewPatterns #-} +-- +-- +-- +-- +-- + +module Main where + +import Data.Array.Accelerate as A +import Data.Array.Accelerate.Interpreter as A +import Data.Array.Accelerate.IO as A -- package: accelerate-io +import Data.Array.Accelerate.Control.Lens as A -- package: lens-accelerate + +import Data.Array.Accelerate.Data.Colour.RGB +import Data.Array.Accelerate.Data.Colour.Names + +import Prelude ( fromInteger ) +import qualified Prelude as P + +width, height :: Int +width = 1000 +height = 100 + + +ultra :: Exp Float -> Exp Colour +ultra p + = interp p + $ if p <= p1 then lift (p0,p1,c0,c1,m0,m1) else + if p <= p2 then lift (p1,p2,c1,c2,m1,m2) else + if p <= p3 then lift (p2,p3,c2,c3,m2,m3) else + if p <= p4 then lift (p3,p4,c3,c4,m3,m4) else + lift (p4,p5,c4,c5,m4,m5) + where + p0,p1,p2,p3,p4,p5 :: Exp Float + m0,m1,m2,m3,m4,m5 :: (Float,Float,Float) + p0 = 0.0 ; c0 = rgb8 0 7 100 ; m0 = (0.7843138, 2.4509804, 2.52451) + p1 = 0.16 ; c1 = rgb8 32 107 203 ; m1 = (1.93816, 2.341629, 1.6544118) + p2 = 0.42 ; c2 = rgb8 237 255 255 ; m2 = (1.7046283, 0.0, 0.0) + p3 = 0.6425 ; c3 = rgb8 255 170 0 ; m3 = (0.0, -2.2812111, 0.0) + p4 = 0.8575 ; c4 = rgb8 0 2 0 ; m4 = (0.0, 0.0, 0.0) + p5 = 1.0 ; c5 = c0 ; m5 = m0 + + interp :: Exp Float + -> Exp (Float,Float,Colour,Colour,(Float,Float,Float),(Float,Float,Float)) + -> Exp Colour + interp x cs = + let + x0 = cs^._1 + x1 = cs^._2 + RGB r0 g0 b0 = unlift (cs^._3) :: RGB (Exp Float) + RGB r1 g1 b1 = unlift (cs^._4) :: RGB (Exp Float) + in + rgb (cubic (x0,x1) (r0,r1) (cs^._5._1,cs^._6._1) x) + (cubic (x0,x1) (g0,g1) (cs^._5._2,cs^._6._2) x) + (cubic (x0,x1) (b0,b1) (cs^._5._3,cs^._6._3) x) + + +-- cubic interpolation +cubic :: (Exp Float, Exp Float) + -> (Exp Float, Exp Float) + -> (Exp Float, Exp Float) + -> Exp Float + -> Exp Float +cubic (x0,x1) (y0,y1) (m0,m1) x = + let + -- basis functions for cubic hermite spine + h_00 = (1 + 2*t) * (1 - t) ** 2 + h_10 = t * (1 - t) ** 2 + h_01 = t ** 2 * (3 - 2 * t) + h_11 = t ** 2 * (t - 1) + -- + h = x1 - x0 + t = (x - x0) / h + in + y0 * h_00 + h * m0 * h_10 + y1 * h_01 + h * m1 * h_11 + +-- linear interpolation +linear :: (Exp Float, Exp Float) + -> (Exp Float, Exp Float) + -> (Exp Float, Exp Float) + -> Exp Float + -> Exp Float +linear (x0,x1) (y0,y1) _ x = + y0 + (x - x0) * (y1 - y0) / (x1 - x0) + + +picker :: Acc (Array DIM2 Colour) +picker = A.generate (constant (Z :. height :. width)) palette + where + palette :: Exp DIM2 -> Exp Colour + palette (unlift -> Z :. y :. x) = + let + c = ultra (A.fromIntegral x / P.fromIntegral width) + h = toFloating y / P.fromIntegral height + RGB r g b = unlift c + det = 1 / (255 * 0.75) + in + if abs (r-h) < det then red else + if abs (g-h) < det then green else + if abs (b-h) < det then blue else + c + +main :: P.IO () +main + = writeImageToBMP "ultra.bmp" + $ run $ A.map packRGB picker + + +{-- +-- Monotone cubic interpolation +-- ---------------------------- +-- +-- +-- + +ps :: [Float] +ps = [ 0.0 , 0.16 , 0.42 , 0.6425 , 0.8575, 1.0 ] + +rs, gs, bs :: [Float] +rs = P.map (\x -> P.fromIntegral x / 255) [ 0, 32, 237, 255, 0, 0 ] +gs = P.map (\x -> P.fromIntegral x / 255) [ 7, 107, 255, 170, 2, 7 ] +bs = P.map (\x -> P.fromIntegral x / 255) [ 100, 203, 255, 0, 0, 100 ] + +-- 1. Gradient of the secant lines between each point +-- +det xs ys = + P.zipWith (/) + (P.zipWith (-) (P.tail ys) ys) + (P.zipWith (-) (P.tail xs) xs) + +det_r = det ps rs -- (P.map P.fromIntegral rs) +det_g = det ps gs -- (P.map P.fromIntegral gs) +det_b = det ps bs -- (P.map P.fromIntegral bs) + +-- 2. Tangent at every data point as the point as the average of the secants +-- +m xs = + let f x y | signum x P.== signum y = (x + y) / 2 + | P.otherwise = 0 + in + P.zipWith f (P.tail xs) xs + +m_r = P.head det_r : m det_r +m_g = P.head det_g : m det_g +m_b = P.head det_b : m det_b + +alpha_r = P.zipWith (/) m_r det_r +alpha_g = P.zipWith (/) m_g det_g +alpha_b = P.zipWith (/) m_b det_b + +beta_r = P.zipWith (/) (P.tail m_r) det_r +beta_g = P.zipWith (/) (P.tail m_g) det_g +beta_b = P.zipWith (/) (P.tail m_b) det_b +--} + diff --git a/samples/blocks.bmp b/samples/blocks.bmp new file mode 100644 Binary files /dev/null and b/samples/blocks.bmp differ diff --git a/samples/blur_rgb.bmp b/samples/blur_rgb.bmp new file mode 100644 Binary files /dev/null and b/samples/blur_rgb.bmp differ diff --git a/samples/blur_srgb.bmp b/samples/blur_srgb.bmp new file mode 100644 Binary files /dev/null and b/samples/blur_srgb.bmp differ diff --git a/samples/swatch/aliceBlue.bmp b/samples/swatch/aliceBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/aliceBlue.bmp differ diff --git a/samples/swatch/alizarinCrimson.bmp b/samples/swatch/alizarinCrimson.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/alizarinCrimson.bmp differ diff --git a/samples/swatch/antiqueWhite.bmp b/samples/swatch/antiqueWhite.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/antiqueWhite.bmp differ diff --git a/samples/swatch/aquamarine.bmp b/samples/swatch/aquamarine.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/aquamarine.bmp differ diff --git a/samples/swatch/aquamarineMedium.bmp b/samples/swatch/aquamarineMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/aquamarineMedium.bmp differ diff --git a/samples/swatch/aureolineYellow.bmp b/samples/swatch/aureolineYellow.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/aureolineYellow.bmp differ diff --git a/samples/swatch/azure.bmp b/samples/swatch/azure.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/azure.bmp differ diff --git a/samples/swatch/banana.bmp b/samples/swatch/banana.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/banana.bmp differ diff --git a/samples/swatch/beige.bmp b/samples/swatch/beige.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/beige.bmp differ diff --git a/samples/swatch/bisque.bmp b/samples/swatch/bisque.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/bisque.bmp differ diff --git a/samples/swatch/black.bmp b/samples/swatch/black.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/black.bmp differ diff --git a/samples/swatch/blanchedAlmond.bmp b/samples/swatch/blanchedAlmond.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/blanchedAlmond.bmp differ diff --git a/samples/swatch/blue.bmp b/samples/swatch/blue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/blue.bmp differ diff --git a/samples/swatch/blueLight.bmp b/samples/swatch/blueLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/blueLight.bmp differ diff --git a/samples/swatch/blueMedium.bmp b/samples/swatch/blueMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/blueMedium.bmp differ diff --git a/samples/swatch/blueViolet.bmp b/samples/swatch/blueViolet.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/blueViolet.bmp differ diff --git a/samples/swatch/brick.bmp b/samples/swatch/brick.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/brick.bmp differ diff --git a/samples/swatch/brown.bmp b/samples/swatch/brown.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/brown.bmp differ diff --git a/samples/swatch/brownMadder.bmp b/samples/swatch/brownMadder.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/brownMadder.bmp differ diff --git a/samples/swatch/brownOchre.bmp b/samples/swatch/brownOchre.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/brownOchre.bmp differ diff --git a/samples/swatch/burlywood.bmp b/samples/swatch/burlywood.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/burlywood.bmp differ diff --git a/samples/swatch/burntSienna.bmp b/samples/swatch/burntSienna.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/burntSienna.bmp differ diff --git a/samples/swatch/burntUmber.bmp b/samples/swatch/burntUmber.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/burntUmber.bmp differ diff --git a/samples/swatch/cadet.bmp b/samples/swatch/cadet.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cadet.bmp differ diff --git a/samples/swatch/cadmiumLemon.bmp b/samples/swatch/cadmiumLemon.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cadmiumLemon.bmp differ diff --git a/samples/swatch/cadmiumOrange.bmp b/samples/swatch/cadmiumOrange.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cadmiumOrange.bmp differ diff --git a/samples/swatch/cadmiumRedDeep.bmp b/samples/swatch/cadmiumRedDeep.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cadmiumRedDeep.bmp differ diff --git a/samples/swatch/cadmiumRedLight.bmp b/samples/swatch/cadmiumRedLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cadmiumRedLight.bmp differ diff --git a/samples/swatch/cadmiumYellow.bmp b/samples/swatch/cadmiumYellow.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cadmiumYellow.bmp differ diff --git a/samples/swatch/carrot.bmp b/samples/swatch/carrot.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/carrot.bmp differ diff --git a/samples/swatch/cerulean.bmp b/samples/swatch/cerulean.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cerulean.bmp differ diff --git a/samples/swatch/chartreuse.bmp b/samples/swatch/chartreuse.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/chartreuse.bmp differ diff --git a/samples/swatch/chocolate.bmp b/samples/swatch/chocolate.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/chocolate.bmp differ diff --git a/samples/swatch/chromeoxideGreen.bmp b/samples/swatch/chromeoxideGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/chromeoxideGreen.bmp differ diff --git a/samples/swatch/cinnabarGreen.bmp b/samples/swatch/cinnabarGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cinnabarGreen.bmp differ diff --git a/samples/swatch/cobalt.bmp b/samples/swatch/cobalt.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cobalt.bmp differ diff --git a/samples/swatch/cobaltGreen.bmp b/samples/swatch/cobaltGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cobaltGreen.bmp differ diff --git a/samples/swatch/cobaltVioletDeep.bmp b/samples/swatch/cobaltVioletDeep.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cobaltVioletDeep.bmp differ diff --git a/samples/swatch/coldGrey.bmp b/samples/swatch/coldGrey.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/coldGrey.bmp differ diff --git a/samples/swatch/coral.bmp b/samples/swatch/coral.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/coral.bmp differ diff --git a/samples/swatch/coralLight.bmp b/samples/swatch/coralLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/coralLight.bmp differ diff --git a/samples/swatch/cornflower.bmp b/samples/swatch/cornflower.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cornflower.bmp differ diff --git a/samples/swatch/cornsilk.bmp b/samples/swatch/cornsilk.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cornsilk.bmp differ diff --git a/samples/swatch/cyan.bmp b/samples/swatch/cyan.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cyan.bmp differ diff --git a/samples/swatch/cyanWhite.bmp b/samples/swatch/cyanWhite.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/cyanWhite.bmp differ diff --git a/samples/swatch/darkOrange.bmp b/samples/swatch/darkOrange.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/darkOrange.bmp differ diff --git a/samples/swatch/deepOchre.bmp b/samples/swatch/deepOchre.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/deepOchre.bmp differ diff --git a/samples/swatch/deepPink.bmp b/samples/swatch/deepPink.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/deepPink.bmp differ diff --git a/samples/swatch/dimGrey.bmp b/samples/swatch/dimGrey.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/dimGrey.bmp differ diff --git a/samples/swatch/dodgerBlue.bmp b/samples/swatch/dodgerBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/dodgerBlue.bmp differ diff --git a/samples/swatch/eggshell.bmp b/samples/swatch/eggshell.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/eggshell.bmp differ diff --git a/samples/swatch/emeraldGreen.bmp b/samples/swatch/emeraldGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/emeraldGreen.bmp differ diff --git a/samples/swatch/englishRed.bmp b/samples/swatch/englishRed.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/englishRed.bmp differ diff --git a/samples/swatch/firebrick.bmp b/samples/swatch/firebrick.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/firebrick.bmp differ diff --git a/samples/swatch/flesh.bmp b/samples/swatch/flesh.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/flesh.bmp differ diff --git a/samples/swatch/fleshOchre.bmp b/samples/swatch/fleshOchre.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/fleshOchre.bmp differ diff --git a/samples/swatch/floralWhite.bmp b/samples/swatch/floralWhite.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/floralWhite.bmp differ diff --git a/samples/swatch/forestGreen.bmp b/samples/swatch/forestGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/forestGreen.bmp differ diff --git a/samples/swatch/gainsboro.bmp b/samples/swatch/gainsboro.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/gainsboro.bmp differ diff --git a/samples/swatch/geraniumLake.bmp b/samples/swatch/geraniumLake.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/geraniumLake.bmp differ diff --git a/samples/swatch/ghostWhite.bmp b/samples/swatch/ghostWhite.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/ghostWhite.bmp differ diff --git a/samples/swatch/gold.bmp b/samples/swatch/gold.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/gold.bmp differ diff --git a/samples/swatch/goldOchre.bmp b/samples/swatch/goldOchre.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/goldOchre.bmp differ diff --git a/samples/swatch/goldenrod.bmp b/samples/swatch/goldenrod.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/goldenrod.bmp differ diff --git a/samples/swatch/goldenrodDark.bmp b/samples/swatch/goldenrodDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/goldenrodDark.bmp differ diff --git a/samples/swatch/goldenrodLight.bmp b/samples/swatch/goldenrodLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/goldenrodLight.bmp differ diff --git a/samples/swatch/goldenrodPale.bmp b/samples/swatch/goldenrodPale.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/goldenrodPale.bmp differ diff --git a/samples/swatch/green.bmp b/samples/swatch/green.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/green.bmp differ diff --git a/samples/swatch/greenDark.bmp b/samples/swatch/greenDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/greenDark.bmp differ diff --git a/samples/swatch/greenPale.bmp b/samples/swatch/greenPale.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/greenPale.bmp differ diff --git a/samples/swatch/greenYellow.bmp b/samples/swatch/greenYellow.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/greenYellow.bmp differ diff --git a/samples/swatch/greenishUmber.bmp b/samples/swatch/greenishUmber.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/greenishUmber.bmp differ diff --git a/samples/swatch/grey.bmp b/samples/swatch/grey.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/grey.bmp differ diff --git a/samples/swatch/honeydew.bmp b/samples/swatch/honeydew.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/honeydew.bmp differ diff --git a/samples/swatch/hotPink.bmp b/samples/swatch/hotPink.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/hotPink.bmp differ diff --git a/samples/swatch/indianRed.bmp b/samples/swatch/indianRed.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/indianRed.bmp differ diff --git a/samples/swatch/indigo.bmp b/samples/swatch/indigo.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/indigo.bmp differ diff --git a/samples/swatch/ivory.bmp b/samples/swatch/ivory.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/ivory.bmp differ diff --git a/samples/swatch/ivoryBlack.bmp b/samples/swatch/ivoryBlack.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/ivoryBlack.bmp differ diff --git a/samples/swatch/khaki.bmp b/samples/swatch/khaki.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/khaki.bmp differ diff --git a/samples/swatch/khakiDark.bmp b/samples/swatch/khakiDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/khakiDark.bmp differ diff --git a/samples/swatch/lampBlack.bmp b/samples/swatch/lampBlack.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lampBlack.bmp differ diff --git a/samples/swatch/lavender.bmp b/samples/swatch/lavender.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lavender.bmp differ diff --git a/samples/swatch/lavenderBlush.bmp b/samples/swatch/lavenderBlush.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lavenderBlush.bmp differ diff --git a/samples/swatch/lawnGreen.bmp b/samples/swatch/lawnGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lawnGreen.bmp differ diff --git a/samples/swatch/lemonChiffon.bmp b/samples/swatch/lemonChiffon.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lemonChiffon.bmp differ diff --git a/samples/swatch/lightBeige.bmp b/samples/swatch/lightBeige.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lightBeige.bmp differ diff --git a/samples/swatch/lightGoldenrod.bmp b/samples/swatch/lightGoldenrod.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lightGoldenrod.bmp differ diff --git a/samples/swatch/lightGrey.bmp b/samples/swatch/lightGrey.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lightGrey.bmp differ diff --git a/samples/swatch/lightSalmon.bmp b/samples/swatch/lightSalmon.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/lightSalmon.bmp differ diff --git a/samples/swatch/limeGreen.bmp b/samples/swatch/limeGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/limeGreen.bmp differ diff --git a/samples/swatch/linen.bmp b/samples/swatch/linen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/linen.bmp differ diff --git a/samples/swatch/madderLakeDeep.bmp b/samples/swatch/madderLakeDeep.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/madderLakeDeep.bmp differ diff --git a/samples/swatch/magenta.bmp b/samples/swatch/magenta.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/magenta.bmp differ diff --git a/samples/swatch/manganeseBlue.bmp b/samples/swatch/manganeseBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/manganeseBlue.bmp differ diff --git a/samples/swatch/maroon.bmp b/samples/swatch/maroon.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/maroon.bmp differ diff --git a/samples/swatch/marsOrange.bmp b/samples/swatch/marsOrange.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/marsOrange.bmp differ diff --git a/samples/swatch/marsYellow.bmp b/samples/swatch/marsYellow.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/marsYellow.bmp differ diff --git a/samples/swatch/melon.bmp b/samples/swatch/melon.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/melon.bmp differ diff --git a/samples/swatch/midnightBlue.bmp b/samples/swatch/midnightBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/midnightBlue.bmp differ diff --git a/samples/swatch/mint.bmp b/samples/swatch/mint.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/mint.bmp differ diff --git a/samples/swatch/mintCream.bmp b/samples/swatch/mintCream.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/mintCream.bmp differ diff --git a/samples/swatch/mistyRose.bmp b/samples/swatch/mistyRose.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/mistyRose.bmp differ diff --git a/samples/swatch/moccasin.bmp b/samples/swatch/moccasin.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/moccasin.bmp differ diff --git a/samples/swatch/naplesYellowDeep.bmp b/samples/swatch/naplesYellowDeep.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/naplesYellowDeep.bmp differ diff --git a/samples/swatch/navajoWhite.bmp b/samples/swatch/navajoWhite.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/navajoWhite.bmp differ diff --git a/samples/swatch/navy.bmp b/samples/swatch/navy.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/navy.bmp differ diff --git a/samples/swatch/oldLace.bmp b/samples/swatch/oldLace.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/oldLace.bmp differ diff --git a/samples/swatch/olive.bmp b/samples/swatch/olive.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/olive.bmp differ diff --git a/samples/swatch/oliveDrab.bmp b/samples/swatch/oliveDrab.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/oliveDrab.bmp differ diff --git a/samples/swatch/oliveGreenDark.bmp b/samples/swatch/oliveGreenDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/oliveGreenDark.bmp differ diff --git a/samples/swatch/orange.bmp b/samples/swatch/orange.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/orange.bmp differ diff --git a/samples/swatch/orangeRed.bmp b/samples/swatch/orangeRed.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/orangeRed.bmp differ diff --git a/samples/swatch/orchid.bmp b/samples/swatch/orchid.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/orchid.bmp differ diff --git a/samples/swatch/orchidDark.bmp b/samples/swatch/orchidDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/orchidDark.bmp differ diff --git a/samples/swatch/orchidMedium.bmp b/samples/swatch/orchidMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/orchidMedium.bmp differ diff --git a/samples/swatch/papayaWhip.bmp b/samples/swatch/papayaWhip.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/papayaWhip.bmp differ diff --git a/samples/swatch/peachPuff.bmp b/samples/swatch/peachPuff.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/peachPuff.bmp differ diff --git a/samples/swatch/peacock.bmp b/samples/swatch/peacock.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/peacock.bmp differ diff --git a/samples/swatch/permanentGreen.bmp b/samples/swatch/permanentGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/permanentGreen.bmp differ diff --git a/samples/swatch/permanentViolet.bmp b/samples/swatch/permanentViolet.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/permanentViolet.bmp differ diff --git a/samples/swatch/peru.bmp b/samples/swatch/peru.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/peru.bmp differ diff --git a/samples/swatch/pink.bmp b/samples/swatch/pink.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/pink.bmp differ diff --git a/samples/swatch/pinkLight.bmp b/samples/swatch/pinkLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/pinkLight.bmp differ diff --git a/samples/swatch/plum.bmp b/samples/swatch/plum.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/plum.bmp differ diff --git a/samples/swatch/powderBlue.bmp b/samples/swatch/powderBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/powderBlue.bmp differ diff --git a/samples/swatch/purple.bmp b/samples/swatch/purple.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/purple.bmp differ diff --git a/samples/swatch/purpleMedium.bmp b/samples/swatch/purpleMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/purpleMedium.bmp differ diff --git a/samples/swatch/raspberry.bmp b/samples/swatch/raspberry.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/raspberry.bmp differ diff --git a/samples/swatch/rawSienna.bmp b/samples/swatch/rawSienna.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/rawSienna.bmp differ diff --git a/samples/swatch/rawUmber.bmp b/samples/swatch/rawUmber.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/rawUmber.bmp differ diff --git a/samples/swatch/red.bmp b/samples/swatch/red.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/red.bmp differ diff --git a/samples/swatch/roseMadder.bmp b/samples/swatch/roseMadder.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/roseMadder.bmp differ diff --git a/samples/swatch/rosyBrown.bmp b/samples/swatch/rosyBrown.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/rosyBrown.bmp differ diff --git a/samples/swatch/royalBlue.bmp b/samples/swatch/royalBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/royalBlue.bmp differ diff --git a/samples/swatch/saddleBrown.bmp b/samples/swatch/saddleBrown.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/saddleBrown.bmp differ diff --git a/samples/swatch/salmon.bmp b/samples/swatch/salmon.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/salmon.bmp differ diff --git a/samples/swatch/sandyBrown.bmp b/samples/swatch/sandyBrown.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/sandyBrown.bmp differ diff --git a/samples/swatch/sapGreen.bmp b/samples/swatch/sapGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/sapGreen.bmp differ diff --git a/samples/swatch/seaGreen.bmp b/samples/swatch/seaGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/seaGreen.bmp differ diff --git a/samples/swatch/seaGreenDark.bmp b/samples/swatch/seaGreenDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/seaGreenDark.bmp differ diff --git a/samples/swatch/seaGreenLight.bmp b/samples/swatch/seaGreenLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/seaGreenLight.bmp differ diff --git a/samples/swatch/seaGreenMedium.bmp b/samples/swatch/seaGreenMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/seaGreenMedium.bmp differ diff --git a/samples/swatch/seashell.bmp b/samples/swatch/seashell.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/seashell.bmp differ diff --git a/samples/swatch/sepia.bmp b/samples/swatch/sepia.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/sepia.bmp differ diff --git a/samples/swatch/sienna.bmp b/samples/swatch/sienna.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/sienna.bmp differ diff --git a/samples/swatch/skyBlue.bmp b/samples/swatch/skyBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/skyBlue.bmp differ diff --git a/samples/swatch/skyBlueDeep.bmp b/samples/swatch/skyBlueDeep.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/skyBlueDeep.bmp differ diff --git a/samples/swatch/skyBlueLight.bmp b/samples/swatch/skyBlueLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/skyBlueLight.bmp differ diff --git a/samples/swatch/slateBlue.bmp b/samples/swatch/slateBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/slateBlue.bmp differ diff --git a/samples/swatch/slateBlueDark.bmp b/samples/swatch/slateBlueDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/slateBlueDark.bmp differ diff --git a/samples/swatch/slateBlueLight.bmp b/samples/swatch/slateBlueLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/slateBlueLight.bmp differ diff --git a/samples/swatch/slateBlueMedium.bmp b/samples/swatch/slateBlueMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/slateBlueMedium.bmp differ diff --git a/samples/swatch/slateGrey.bmp b/samples/swatch/slateGrey.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/slateGrey.bmp differ diff --git a/samples/swatch/slateGreyDark.bmp b/samples/swatch/slateGreyDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/slateGreyDark.bmp differ diff --git a/samples/swatch/slateGreyLight.bmp b/samples/swatch/slateGreyLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/slateGreyLight.bmp differ diff --git a/samples/swatch/snow.bmp b/samples/swatch/snow.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/snow.bmp differ diff --git a/samples/swatch/springGreen.bmp b/samples/swatch/springGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/springGreen.bmp differ diff --git a/samples/swatch/springGreenMedium.bmp b/samples/swatch/springGreenMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/springGreenMedium.bmp differ diff --git a/samples/swatch/steelBlue.bmp b/samples/swatch/steelBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/steelBlue.bmp differ diff --git a/samples/swatch/steelBlueLight.bmp b/samples/swatch/steelBlueLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/steelBlueLight.bmp differ diff --git a/samples/swatch/tan.bmp b/samples/swatch/tan.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/tan.bmp differ diff --git a/samples/swatch/terreVerte.bmp b/samples/swatch/terreVerte.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/terreVerte.bmp differ diff --git a/samples/swatch/thistle.bmp b/samples/swatch/thistle.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/thistle.bmp differ diff --git a/samples/swatch/titaniumWhite.bmp b/samples/swatch/titaniumWhite.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/titaniumWhite.bmp differ diff --git a/samples/swatch/tomato.bmp b/samples/swatch/tomato.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/tomato.bmp differ diff --git a/samples/swatch/turquoise.bmp b/samples/swatch/turquoise.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/turquoise.bmp differ diff --git a/samples/swatch/turquoiseBlue.bmp b/samples/swatch/turquoiseBlue.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/turquoiseBlue.bmp differ diff --git a/samples/swatch/turquoiseDark.bmp b/samples/swatch/turquoiseDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/turquoiseDark.bmp differ diff --git a/samples/swatch/turquoiseMedium.bmp b/samples/swatch/turquoiseMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/turquoiseMedium.bmp differ diff --git a/samples/swatch/turquoisePale.bmp b/samples/swatch/turquoisePale.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/turquoisePale.bmp differ diff --git a/samples/swatch/ultramarine.bmp b/samples/swatch/ultramarine.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/ultramarine.bmp differ diff --git a/samples/swatch/ultramarineViolet.bmp b/samples/swatch/ultramarineViolet.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/ultramarineViolet.bmp differ diff --git a/samples/swatch/vanDykeBrown.bmp b/samples/swatch/vanDykeBrown.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/vanDykeBrown.bmp differ diff --git a/samples/swatch/venetianRed.bmp b/samples/swatch/venetianRed.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/venetianRed.bmp differ diff --git a/samples/swatch/violet.bmp b/samples/swatch/violet.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/violet.bmp differ diff --git a/samples/swatch/violetDark.bmp b/samples/swatch/violetDark.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/violetDark.bmp differ diff --git a/samples/swatch/violetRed.bmp b/samples/swatch/violetRed.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/violetRed.bmp differ diff --git a/samples/swatch/violetRedMedium.bmp b/samples/swatch/violetRedMedium.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/violetRedMedium.bmp differ diff --git a/samples/swatch/violetRedPale.bmp b/samples/swatch/violetRedPale.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/violetRedPale.bmp differ diff --git a/samples/swatch/viridianLight.bmp b/samples/swatch/viridianLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/viridianLight.bmp differ diff --git a/samples/swatch/warmGrey.bmp b/samples/swatch/warmGrey.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/warmGrey.bmp differ diff --git a/samples/swatch/wheat.bmp b/samples/swatch/wheat.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/wheat.bmp differ diff --git a/samples/swatch/white.bmp b/samples/swatch/white.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/white.bmp differ diff --git a/samples/swatch/whiteSmoke.bmp b/samples/swatch/whiteSmoke.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/whiteSmoke.bmp differ diff --git a/samples/swatch/yellow.bmp b/samples/swatch/yellow.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/yellow.bmp differ diff --git a/samples/swatch/yellowGreen.bmp b/samples/swatch/yellowGreen.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/yellowGreen.bmp differ diff --git a/samples/swatch/yellowLight.bmp b/samples/swatch/yellowLight.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/yellowLight.bmp differ diff --git a/samples/swatch/yellowOchre.bmp b/samples/swatch/yellowOchre.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/yellowOchre.bmp differ diff --git a/samples/swatch/zincWhite.bmp b/samples/swatch/zincWhite.bmp new file mode 100644 Binary files /dev/null and b/samples/swatch/zincWhite.bmp differ