(original) (raw)

module Data.Colour.Palette.Harmony (

       [Kolor](Data.Colour.Palette.Types.html#Kolor)
     

     , [tint](Data.Colour.Palette.Harmony.html#tint), [tone](Data.Colour.Palette.Harmony.html#tone), [shade](Data.Colour.Palette.Harmony.html#shade), [sliders](Data.Colour.Palette.Harmony.html#sliders), [rotateColor](Data.Colour.Palette.Harmony.html#rotateColor)
     

     , [monochrome](Data.Colour.Palette.Harmony.html#monochrome)
     , [complement](Data.Colour.Palette.Harmony.html#complement)
     , [triad](Data.Colour.Palette.Harmony.html#triad)
     , [tetrad](Data.Colour.Palette.Harmony.html#tetrad)
     , [analogic](Data.Colour.Palette.Harmony.html#analogic)
     , [accentAnalogic](Data.Colour.Palette.Harmony.html#accentAnalogic)
     , [bwg](Data.Colour.Palette.Harmony.html#bwg)
     , [colorRamp](Data.Colour.Palette.Harmony.html#colorRamp)

   ) where

import Data.Colour import Data.Colour.Names import Data.Colour.Palette.Types import Data.Colour.RGBSpace.HSV import Data.Colour.SRGB (RGB (..), sRGB, toSRGB)

hsvToRyb :: Double -> Double hsvToRyb x | x < 35 = 1.71 * x | x < 60 = 60 + 2.40 * (x - 35) | x < 135 = 120 + 0.80 * (x - 60) | x < 225 = 180 + 0.67 * (x - 135) | x < 275 = 240 + 1.20 * (x - 225) | otherwise = 300 + 0.71 * (x - 275)

rybToHsv :: Double -> Double rybToHsv x | x < 60 = 0.58 * x | x < 120 = 35 + 0.42 * (x - 60) | x < 180 = 60 + 1.25 * (x - 120) | x < 240 = 135 + 1.50 * (x - 180) | x < 300 = 225 + 0.83 * (x - 240) | otherwise = 275 + 1.42 * (x - 300)

rotateHue :: Double -> Double -> Double rotateHue h degrees = rybToHsv (fromIntegral k) where k = (round $ hsvToRyb h + degrees :: Int) mod 360

sliders :: Kolor -> Double -> (Double -> Double) -> (Double -> Double) -> Kolor sliders c rot fs fv = sRGB r g b where (h, s, v) = hsvView (toSRGB c) h' = rotateHue h rot s' = max 0 (min 1 (fs s)) v' = max 0 (min 1 (fv v)) RGB r g b = hsv h' s' v'

rotateColor :: Double -> Kolor -> Kolor rotateColor degrees c = sRGB r g b where (h, s, v) = hsvView (toSRGB c) RGB r g b = hsv (rotateHue h degrees) s v

tint :: Double -> Kolor -> Kolor tint t = blend t white

tone :: Double -> Kolor -> Kolor tone t = blend t gray

shade :: Double -> Kolor -> Kolor shade t = blend t black

monochrome :: Kolor -> [Kolor] monochrome c = [c, tint 0.25 c, tone 0.5 c, shade 0.5 c, shade 0.75 c]

complement :: Kolor -> [Kolor] complement c = [c, shade 0.5 d, tint 0.25 c, shade 0.75 c, d] where d = rotateColor 180 c

triad :: Kolor -> [Kolor] triad c = [ c, rotateColor 240 c, shade 0.5 $ rotateColor 210 c , shade 0.35 $ rotateColor 120 c, shade 0.67 c]

tetrad :: Kolor -> [Kolor] tetrad c = [ c, rotateColor 180 c, tone 0.25 $ rotateColor 30 c , shade 0.5 $ rotateColor 210 c, tone 0.5 $ rotateColor 180 c]

analogic :: Kolor -> [Kolor] analogic c = [ c, shade 0.3 $ rotateColor 330 c, tone 0.25 $ rotateColor 30 c , rotateColor 330 c, tone 0.5 c]

accentAnalogic :: Kolor -> [Kolor] accentAnalogic c = [ c, tint 0.5 $ rotateColor 180 c , tone 0.25 $ rotateColor 30 c, rotateColor 330 c , rotateColor 180 c]

bwg :: Kolor -> [Kolor] bwg c = [c, tint 0.8 c, tone 0.8 c, shade 0.9 c]

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 _ _ = []