module Data.Colour.Palette.Harmony
(
Kolor
, tint, tone, shade, sliders, rotateColor
, monochrome
, complement
, triad
, tetrad
, analogic
, accentAnalogic
, bwg
, 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 :: Double -> Double
hsvToRyb Double
x
| Double
x forall a. Ord a => a -> a -> Bool
< Double
35 = Double
1.71 forall a. Num a => a -> a -> a
* Double
x
| Double
x forall a. Ord a => a -> a -> Bool
< Double
60 = Double
60 forall a. Num a => a -> a -> a
+ Double
2.40 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
35)
| Double
x forall a. Ord a => a -> a -> Bool
< Double
135 = Double
120 forall a. Num a => a -> a -> a
+ Double
0.80 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
60)
| Double
x forall a. Ord a => a -> a -> Bool
< Double
225 = Double
180 forall a. Num a => a -> a -> a
+ Double
0.67 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
135)
| Double
x forall a. Ord a => a -> a -> Bool
< Double
275 = Double
240 forall a. Num a => a -> a -> a
+ Double
1.20 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
225)
| Bool
otherwise = Double
300 forall a. Num a => a -> a -> a
+ Double
0.71 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
275)
rybToHsv :: Double -> Double
rybToHsv :: Double -> Double
rybToHsv Double
x
| Double
x forall a. Ord a => a -> a -> Bool
< Double
60 = Double
0.58 forall a. Num a => a -> a -> a
* Double
x
| Double
x forall a. Ord a => a -> a -> Bool
< Double
120 = Double
35 forall a. Num a => a -> a -> a
+ Double
0.42 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
60)
| Double
x forall a. Ord a => a -> a -> Bool
< Double
180 = Double
60 forall a. Num a => a -> a -> a
+ Double
1.25 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
120)
| Double
x forall a. Ord a => a -> a -> Bool
< Double
240 = Double
135 forall a. Num a => a -> a -> a
+ Double
1.50 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
180)
| Double
x forall a. Ord a => a -> a -> Bool
< Double
300 = Double
225 forall a. Num a => a -> a -> a
+ Double
0.83 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
240)
| Bool
otherwise = Double
275 forall a. Num a => a -> a -> a
+ Double
1.42 forall a. Num a => a -> a -> a
* (Double
x forall a. Num a => a -> a -> a
- Double
300)
rotateHue :: Double -> Double -> Double
rotateHue :: Double -> Double -> Double
rotateHue Double
h Double
degrees = Double -> Double
rybToHsv (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k)
where
k :: Int
k = (forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double -> Double
hsvToRyb Double
h forall a. Num a => a -> a -> a
+ Double
degrees :: Int) forall a. Integral a => a -> a -> a
`mod` Int
360
sliders :: Kolor -> Double -> (Double -> Double)
-> (Double -> Double) -> Kolor
sliders :: Kolor
-> Double -> (Double -> Double) -> (Double -> Double) -> Kolor
sliders Kolor
c Double
rot Double -> Double
fs Double -> Double
fv = forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Double
r Double
g Double
b
where
(Double
h, Double
s, Double
v) = forall a. (Fractional a, Ord a) => RGB a -> (a, a, a)
hsvView (forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB Kolor
c)
h' :: Double
h' = Double -> Double -> Double
rotateHue Double
h Double
rot
s' :: Double
s' = forall a. Ord a => a -> a -> a
max Double
0 (forall a. Ord a => a -> a -> a
min Double
1 (Double -> Double
fs Double
s))
v' :: Double
v' = forall a. Ord a => a -> a -> a
max Double
0 (forall a. Ord a => a -> a -> a
min Double
1 (Double -> Double
fv Double
v))
RGB Double
r Double
g Double
b = forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsv Double
h' Double
s' Double
v'
rotateColor :: Double -> Kolor -> Kolor
rotateColor :: Double -> Kolor -> Kolor
rotateColor Double
degrees Kolor
c = forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB Double
r Double
g Double
b
where
(Double
h, Double
s, Double
v) = forall a. (Fractional a, Ord a) => RGB a -> (a, a, a)
hsvView (forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB Kolor
c)
RGB Double
r Double
g Double
b = forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsv (Double -> Double -> Double
rotateHue Double
h Double
degrees) Double
s Double
v
tint :: Double -> Kolor -> Kolor
tint :: Double -> Kolor -> Kolor
tint Double
t = forall a (f :: * -> *).
(Num a, AffineSpace f) =>
a -> f a -> f a -> f a
blend Double
t forall a. (Ord a, Floating a) => Colour a
white
tone :: Double -> Kolor -> Kolor
tone :: Double -> Kolor -> Kolor
tone Double
t = forall a (f :: * -> *).
(Num a, AffineSpace f) =>
a -> f a -> f a -> f a
blend Double
t forall a. (Ord a, Floating a) => Colour a
gray
shade :: Double -> Kolor -> Kolor
shade :: Double -> Kolor -> Kolor
shade Double
t = forall a (f :: * -> *).
(Num a, AffineSpace f) =>
a -> f a -> f a -> f a
blend Double
t forall a. Num a => Colour a
black
monochrome :: Kolor -> [Kolor]
monochrome :: Kolor -> [Kolor]
monochrome Kolor
c = [Kolor
c, Double -> Kolor -> Kolor
tint Double
0.25 Kolor
c, Double -> Kolor -> Kolor
tone Double
0.5 Kolor
c, Double -> Kolor -> Kolor
shade Double
0.5 Kolor
c, Double -> Kolor -> Kolor
shade Double
0.75 Kolor
c]
complement :: Kolor -> [Kolor]
complement :: Kolor -> [Kolor]
complement Kolor
c = [Kolor
c, Double -> Kolor -> Kolor
shade Double
0.5 Kolor
d, Double -> Kolor -> Kolor
tint Double
0.25 Kolor
c, Double -> Kolor -> Kolor
shade Double
0.75 Kolor
c, Kolor
d]
where d :: Kolor
d = Double -> Kolor -> Kolor
rotateColor Double
180 Kolor
c
triad :: Kolor -> [Kolor]
triad :: Kolor -> [Kolor]
triad Kolor
c = [ Kolor
c, Double -> Kolor -> Kolor
rotateColor Double
240 Kolor
c, Double -> Kolor -> Kolor
shade Double
0.5 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
210 Kolor
c
, Double -> Kolor -> Kolor
shade Double
0.35 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
120 Kolor
c, Double -> Kolor -> Kolor
shade Double
0.67 Kolor
c]
tetrad :: Kolor -> [Kolor]
tetrad :: Kolor -> [Kolor]
tetrad Kolor
c = [ Kolor
c, Double -> Kolor -> Kolor
rotateColor Double
180 Kolor
c, Double -> Kolor -> Kolor
tone Double
0.25 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
30 Kolor
c
, Double -> Kolor -> Kolor
shade Double
0.5 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
210 Kolor
c, Double -> Kolor -> Kolor
tone Double
0.5 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
180 Kolor
c]
analogic :: Kolor -> [Kolor]
analogic :: Kolor -> [Kolor]
analogic Kolor
c = [ Kolor
c, Double -> Kolor -> Kolor
shade Double
0.3 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
330 Kolor
c, Double -> Kolor -> Kolor
tone Double
0.25 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
30 Kolor
c
, Double -> Kolor -> Kolor
rotateColor Double
330 Kolor
c, Double -> Kolor -> Kolor
tone Double
0.5 Kolor
c]
accentAnalogic :: Kolor -> [Kolor]
accentAnalogic :: Kolor -> [Kolor]
accentAnalogic Kolor
c = [ Kolor
c, Double -> Kolor -> Kolor
tint Double
0.5 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
180 Kolor
c
, Double -> Kolor -> Kolor
tone Double
0.25 forall a b. (a -> b) -> a -> b
$ Double -> Kolor -> Kolor
rotateColor Double
30 Kolor
c, Double -> Kolor -> Kolor
rotateColor Double
330 Kolor
c
, Double -> Kolor -> Kolor
rotateColor Double
180 Kolor
c]
bwg :: Kolor -> [Kolor]
bwg :: Kolor -> [Kolor]
bwg Kolor
c = [Kolor
c, Double -> Kolor -> Kolor
tint Double
0.8 Kolor
c, Double -> Kolor -> Kolor
tone Double
0.8 Kolor
c, Double -> Kolor -> Kolor
shade Double
0.9 Kolor
c]
colorRamp :: Int -> [Kolor] -> [Kolor]
colorRamp :: Int -> [Kolor] -> [Kolor]
colorRamp Int
n [Kolor]
xs0 = if Int
n forall a. Ord a => a -> a -> Bool
<= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kolor]
xs0 then forall a. Int -> [a] -> [a]
take Int
n [Kolor]
xs0 else forall a. Int -> [a] -> [a]
take Int
n (forall {f :: * -> *}.
AffineSpace f =>
Double -> [f Double] -> [f Double]
go Double
0 [Kolor]
xs0)
where
di :: Double
di = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Kolor]
xs0 forall a. Num a => a -> a -> a
- Int
1) forall a. Fractional a => a -> a -> a
/ forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
n forall a. Num a => a -> a -> a
- Int
1)
go :: Double -> [f Double] -> [f Double]
go Double
_ [f Double
x] = [f Double
x]
go Double
i xs' :: [f Double]
xs'@(f Double
x1 : xs :: [f Double]
xs@(f Double
x2 : [f Double]
_))
| Double
i forall a. Ord a => a -> a -> Bool
> Double
1 = Double -> [f Double] -> [f Double]
go (Double
i forall a. Num a => a -> a -> a
- Double
1) [f Double]
xs
| Bool
otherwise = forall a (f :: * -> *).
(Num a, AffineSpace f) =>
a -> f a -> f a -> f a
blend Double
i f Double
x2 f Double
x1 forall a. a -> [a] -> [a]
: Double -> [f Double] -> [f Double]
go (Double
i forall a. Num a => a -> a -> a
+ Double
di) [f Double]
xs'
go Double
_ [f Double]
_ = []