diff --git a/CHANGES.markdown b/CHANGES.markdown --- a/CHANGES.markdown +++ b/CHANGES.markdown @@ -1,3 +1,8 @@ +0.1.0.5-r1 (23 Sep 2017) +------------------------ + +- allow base-4.10 for GHC-8.2 + 0.1.0.5 (22 August 2017) ------------------------ diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_blue.svg b/diagrams/src_Data_Colour_Palette_RandomColor_blue.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_blue.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_cielab.svg b/diagrams/src_Data_Colour_Palette_RandomColor_cielab.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_cielab.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_dark.svg b/diagrams/src_Data_Colour_Palette_RandomColor_dark.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_dark.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_green.svg b/diagrams/src_Data_Colour_Palette_RandomColor_green.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_green.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_labpalette.svg b/diagrams/src_Data_Colour_Palette_RandomColor_labpalette.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_labpalette.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_light.svg b/diagrams/src_Data_Colour_Palette_RandomColor_light.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_light.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_monochrome.svg b/diagrams/src_Data_Colour_Palette_RandomColor_monochrome.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_monochrome.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_orange.svg b/diagrams/src_Data_Colour_Palette_RandomColor_orange.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_orange.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_palette.svg b/diagrams/src_Data_Colour_Palette_RandomColor_palette.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_palette.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_pink.svg b/diagrams/src_Data_Colour_Palette_RandomColor_pink.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_pink.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_purple.svg b/diagrams/src_Data_Colour_Palette_RandomColor_purple.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_purple.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_random.svg b/diagrams/src_Data_Colour_Palette_RandomColor_random.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_random.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_red.svg b/diagrams/src_Data_Colour_Palette_RandomColor_red.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_red.svg @@ -0,0 +1,3 @@ + + diff --git a/diagrams/src_Data_Colour_Palette_RandomColor_yellow.svg b/diagrams/src_Data_Colour_Palette_RandomColor_yellow.svg new file mode 100644 --- /dev/null +++ b/diagrams/src_Data_Colour_Palette_RandomColor_yellow.svg @@ -0,0 +1,3 @@ + + diff --git a/palette.cabal b/palette.cabal --- a/palette.cabal +++ b/palette.cabal @@ -1,8 +1,8 @@ Name: palette -Version: 0.1.0.5 +Version: 0.3 Synopsis: Utilities for choosing and creating color schemes. Description: Sets of predefined colors and tools for choosing and - creating color schemes. + creating color schemes. Random colors. Homepage: http://projects.haskell.org/diagrams License: BSD3 @@ -15,7 +15,7 @@ Cabal-version: >=1.18 Extra-source-files: README.markdown, CHANGES.markdown, diagrams/*.svg Extra-doc-files: diagrams/*.svg -Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1 +Tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.2, GHC == 8.0.1, GHC == 8.2.1 Source-repository head type: git location: http://github.com/diagrams/palette.git @@ -26,10 +26,11 @@ Data.Colour.Palette.Harmony Data.Colour.Palette.BrewerSet Data.Colour.Palette.Types + Data.Colour.Palette.RandomColor - Build-depends: base >= 4.2 && < 4.10, + Build-depends: base >= 4.2 && < 4.11, array >= 0.4 && < 0.6, colour >= 2.3 && <3.0, - containers >= 0.5 && < 0.6.0.0 - + containers >= 0.5 && < 0.6, + MonadRandom >= 0.5 && < 0.6 hs-source-dirs: src diff --git a/src/Data/Colour/Palette/Harmony.hs b/src/Data/Colour/Palette/Harmony.hs --- a/src/Data/Colour/Palette/Harmony.hs +++ b/src/Data/Colour/Palette/Harmony.hs @@ -29,14 +29,15 @@ , analogic , accentAnalogic , bwg + , colorRamp ) where import Data.Colour -import Data.Colour.SRGB (RGB(..), toSRGB, sRGB) -import Data.Colour.RGBSpace.HSV import Data.Colour.Names import Data.Colour.Palette.Types +import Data.Colour.RGBSpace.HSV +import Data.Colour.SRGB (RGB (..), sRGB, toSRGB) -- > import Data.Colour.Palette.Harmony -- > import Data.Colour.SRGB (sRGB24read) @@ -48,7 +49,7 @@ -- > a = 1 / (fromIntegral n) :: Turn -- > w = wedge 1 (0 :: Turn) a # lw 0 -- > r = 1/4 - 1/(2*(fromIntegral n)) --- > base = sRGB24read "#bd4932" +-- > base = sRGB24read "#95a78d" -- > mono = wheel $ monochrome base -- > comp = wheel $ complement base -- > tria = wheel $ triad base @@ -107,17 +108,17 @@ -- | Tints a color by adding blending t * white + (1 - t) color. -- t should be between 0 and 1. tint :: Double -> Kolor -> Kolor -tint t c = blend t white c +tint t = blend t white -- | Alter the tone of a color by adding blending t * gray + (1 - t) color. -- t should be between 0 and 1. tone :: Double -> Kolor -> Kolor -tone t c = blend t gray c +tone t = blend t gray -- | Shades a color by adding blending s * black + (1 - t) color. -- t should be between 0 and 1. shade :: Double -> Kolor -> Kolor -shade t c = blend t black c +shade t = blend t black -- | Create a monochromatic set of 5 colors based in the input color. -- <> @@ -160,3 +161,15 @@ -- <> bwg :: Kolor -> [Kolor] bwg c = [c, tint 0.8 c, tone 0.8 c, shade 0.9 c] + +-- | Interpolate n colors from a list of colors using linear piecewise +-- interpolation to add additional colors to a palette. +colorRamp :: Int -> [Kolor] -> [Kolor] +colorRamp n xs0 = if n <= length xs0 then take n xs0 else take n (go 0 xs0) + where + di = fromIntegral (length xs0 - 1) / fromIntegral (n - 1) + go _ [x] = [x] + go i xs'@(x1 : xs@(x2 : _)) + | i > 1 = go (i - 1) xs + | otherwise = blend i x2 x1 : go (i + di) xs' + go _ _ = [] diff --git a/src/Data/Colour/Palette/RandomColor.hs b/src/Data/Colour/Palette/RandomColor.hs new file mode 100644 --- /dev/null +++ b/src/Data/Colour/Palette/RandomColor.hs @@ -0,0 +1,246 @@ +{-# LANGUAGE LambdaCase #-} +----------------------------------------------------------------------------- +-- | +-- Module : Palette.RandomColor +-- Copyright : (c) 2018 Jeffrey Rosenbluth +-- License : BSD-style (see LICENSE) +-- Maintainer : jeffrey.rosenbluth@gmail.com +-- +-- Functions to create random colors. +-- Includes a port of [David Merfield's](https://github.com/davidmerfield/randomColor) +-- randomColor. +----------------------------------------------------------------------------- + +module Data.Colour.Palette.RandomColor + ( -- * A Library for generating random colors. + + -- ** Choose a random color from CIELAB colorspace. + randomCIELab + , randomCIELabPalette + + -- ** Choose a random color using David Merfield's algorithm + , randomColor + , randomPalette + , randomHarmony + + -- ** Choose a random HSV component + + , randomHue + , randomSaturation + , randomBrightness + + ) where + +import Control.Monad.Random +import Data.Colour +import Data.Colour.CIE +import Data.Colour.CIE.Illuminant +import Data.Colour.Palette.Harmony +import Data.Colour.Palette.Types +import Data.Colour.RGBSpace.HSV +import Data.Colour.SRGB (RGB (..), sRGB) +import Data.List (find) +import Data.Maybe (fromMaybe) + +getColorDefinition :: Hue -> ColorDefinition +getColorDefinition = \case + HueMonochrome -> ColorDefinition Nothing [(0,0),(100, 0)] + HueRed -> ColorDefinition (Just (-26,18)) + [ (20,100), (30,92), (40,89), (50,85), (60,78), (70,70) + , (80,60), (90,55), (100,50) + ] + HueOrange -> ColorDefinition (Just (19,46)) + [ (20,100), (30,93), (40,88), (50,86), (60,85), (70,70) + , (100,70) + ] + HueYellow -> ColorDefinition (Just (47,62)) + [ (25,100), (40,94), (50,89), (60,86), (70,84), (80,82) + , (90,80), (100,75) + ] + HueGreen -> ColorDefinition (Just (63,178)) + [ (30,100), (40,90), (50,85), (60,81), (70,74), (80,64) + , (90,50), (100,40) + ] + HueBlue -> ColorDefinition (Just (179,257)) + [ (20,100), (30,86), (40,80), (50,74), (60,60), (70,52) + , (80,44), (90,39), (100,35) + ] + HuePurple -> ColorDefinition (Just (258,282)) + [ (20,100), (30,87), (40,79), (50,70), (60,65), (70,59) + , (80,52), (90,45), (100,42) + ] + HuePink -> ColorDefinition (Just (283,334)) + [ (20,100), (30,90), (40,86), (60,84), (80,80), (90,75) + , (100,73) + ] + HueRandom -> ColorDefinition (Just (0, 359)) [] + +getHue :: Int -> Hue +getHue n + | n' == 0 = HueMonochrome + | n' >= 283 = HuePink + | n' >= 258 = HuePurple + | n' >= 179 = HueBlue + | n' >= 63 = HueGreen + | n' >= 47 = HueYellow + | n' >= 19 = HueOrange + | n' >= -26 = HueRed + where + n' = if n >= 334 && n <= 360 then n - 360 else n + +-- | return a random hue in the range [lo, hi] as a 'Double'. +-- lo should be >= 0 and hi < 360. +-- Instead of storing red as two seperate ranges we create a single +-- contiguous range using negative numbers. +randomHue :: MonadRandom m => Hue -> m Int +randomHue h = do + hue <- getRandomR (lo, hi) + return $ if hue < 0 then hue + 360 else hue + where + hr = hueRange . getColorDefinition $ h + (lo, hi) = fromMaybe (0, 0) hr + +saturationRange :: Hue -> (Int, Int) +saturationRange hue = result + where + lbs = lowerBounds $ getColorDefinition hue + result = case lbs of + [] -> error "Can\'t obtain saturationRange from an empty lowerBounds" + xs -> (fst . head $ lbs, fst . last $ lbs) + +randomSaturation :: MonadRandom m => Hue -> Luminosity -> m Int +randomSaturation HueMonochrome _ = return 0 +randomSaturation _ LumRandom = getRandomR (0, 100) +randomSaturation hue lum = case lum of + LumBright -> getRandomR (55, hi) + LumDark -> getRandomR (hi - 10, hi) + LumLight -> getRandomR (lo, 55) + where + (lo, hi) = saturationRange hue + +minBrightness :: Hue -> Int -> Int +minBrightness hue saturationValue = round $ fromMaybe 0 result + where + lbs = lowerBounds $ getColorDefinition hue + tup a = zip (0:a) a + inRange j (k, n) = j >= k && j <= n + result = do + (s1, s2) <- find (inRange saturationValue) (tup $ fst <$> lbs) + v1 <- lookup s1 lbs + v2 <- lookup s2 lbs + let m = fromIntegral (v2 - v1) / fromIntegral (s2 -s1) + b = fromIntegral v1 - m * fromIntegral s1 + return $ m * fromIntegral saturationValue + b + +-- | Pick a random brightness value given a 'Hue', 'Luminosity' and saturation. +randomBrightness :: MonadRandom m => Hue -> Luminosity -> Int -> m Int +randomBrightness hue lum saturationValue = getRandomR (bMin, bMax) + where + b = minBrightness hue saturationValue + (bMin, bMax) = case lum of + LumBright -> (b, 100) + LumDark -> (b, b + 20) + LumLight -> ((b + 100) `div` 2, 100) + LumRandom -> (0, 100) + +-- | Generate a random opaque color. +-- +-- <> +-- +-- > randomColor HueRed LumBright +-- +-- <> +-- +-- > randomColor HueOrange LumBright +-- +-- <> +-- +-- > randomColor HueYellow LumBright +-- +-- <> +-- +-- > randomColor HueGreen LumBright +-- +-- <> +-- +-- > randomColor HueBlue LumBright +-- +-- <> +-- +-- > randomColor HuePurple LumBright +-- +-- <> +-- +-- > randomColor HuePink LumBright +-- +-- <> +-- +-- > randomColor HueMonochrome LumRandom +-- +-- <> +-- +-- > randomColor HueRandom LumLight +-- +-- <> +-- +-- > randomColor HueRandom LumDark +-- +-- <> +-- +-- > randomColor HueRandom LumRandom +-- /Better to use 'randomCIELab' for truly random colors/. +randomColor :: MonadRandom m => Hue -> Luminosity -> m Kolor +randomColor hue lum = do + hueValue <- randomHue hue + let hue' = getHue hueValue + satValue <- randomSaturation hue' lum + briValue <- randomBrightness hue' lum satValue + let (RGB r g b) = hsv (fromIntegral hueValue) + (fromIntegral satValue / 100) + (fromIntegral briValue / 100) + return $ sRGB r g b + +-- | Return a random harmony based on a seed color. +randomHarmony :: MonadRandom m => Kolor -> m [Kolor] +randomHarmony c = do + harmony <- uniform + [ monochrome + , complement + , triad + , tetrad + , analogic + , accentAnalogic + ] + return $ harmony c + +-- | Generate a random color palette. First choose a random color then choose a +-- random harmony and apply it. +-- +-- <> +-- +-- > randomPalette +randomPalette :: MonadRandom m => Hue -> Luminosity ->m [Kolor] +randomPalette hue lum = randomColor hue lum >>= randomHarmony + +-- | Generate a random color from CIELAB (a perceptually uniform color space) +-- with a White point of 'd65'. Probably the best choice if you want a totally +-- random color. +-- +-- <> +-- +-- > randomCIELab +randomCIELab :: MonadRandom m => m Kolor +randomCIELab = do + l <- getRandomR (0, 100) + a <- getRandomR (-100, 100) + b <- getRandomR (-100, 100) + return $ cieLAB d65 l a b + +-- | Generate a random color palette using 'randomCIELab'. First choose a +-- random color then choose a random harmony and apply it. +-- +-- <> +-- +-- > randomCIELabPalette +randomCIELabPalette :: MonadRandom m => m [Kolor] +randomCIELabPalette = randomCIELab >>= randomHarmony diff --git a/src/Data/Colour/Palette/Types.hs b/src/Data/Colour/Palette/Types.hs --- a/src/Data/Colour/Palette/Types.hs +++ b/src/Data/Colour/Palette/Types.hs @@ -12,8 +12,39 @@ module Data.Colour.Palette.Types ( Kolor + , Hue(..) + , Luminosity(..) + , ColorDefinition(..) + ) where -import Data.Colour +import Data.Colour +-- | A convenient alias. type Kolor = Colour Double + +-- | Used to select the hue range in 'randomColor'. +data Hue + = HueMonochrome + | HueRed + | HueOrange + | HueYellow + | HueGreen + | HueBlue + | HuePurple + | HuePink + | HueRandom + deriving (Show, Eq) + +-- | Used to select the luminosity range in 'randomColor'. +data Luminosity + = LumBright + | LumLight + | LumDark + | LumRandom + deriving (Show, Eq) + +data ColorDefinition = ColorDefinition + { hueRange :: Maybe (Int, Int) + , lowerBounds :: [(Int, Int)] + }