module Diagrams.Color.HSV
( hsvBlend
) where
import Data.Colour (Colour)
import Data.Colour.RGBSpace (uncurryRGB)
import Data.Colour.RGBSpace.HSV (hsv, hsvView)
import Data.Colour.SRGB (sRGB, toSRGB)
import Data.List (minimumBy)
import Data.Ord (comparing)
hsvBlend :: RealFloat n => n -> Colour n -> Colour n -> Colour n
hsvBlend :: forall n. RealFloat n => n -> Colour n -> Colour n -> Colour n
hsvBlend n
t Colour n
c1 Colour n
c2 = (n -> n -> n -> Colour n) -> RGB n -> Colour n
forall a b. (a -> a -> a -> b) -> RGB a -> b
uncurryRGB n -> n -> n -> Colour n
forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB (RGB n -> Colour n)
-> ((n, n, n) -> RGB n) -> (n, n, n) -> Colour n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (n, n, n) -> RGB n
forall {a}. RealFrac a => (a, a, a) -> RGB a
hsv3
((n, n, n) -> Colour n) -> (n, n, n) -> Colour n
forall a b. (a -> b) -> a -> b
$ (n -> n -> n -> n -> n
forall n. RealFrac n => n -> n -> n -> n -> n
lerpWrap n
h1 n
h2 n
360 n
t, n -> n -> n -> n
forall n. Num n => n -> n -> n -> n
lerp' n
s1 n
s2 n
t, n -> n -> n -> n
forall n. Num n => n -> n -> n -> n
lerp' n
v1 n
v2 n
t)
where
[(n
h1,n
s1,n
v1), (n
h2,n
s2,n
v2)] = (Colour n -> (n, n, n)) -> [Colour n] -> [(n, n, n)]
forall a b. (a -> b) -> [a] -> [b]
map (RGB n -> (n, n, n)
forall a. (Fractional a, Ord a) => RGB a -> (a, a, a)
hsvView (RGB n -> (n, n, n))
-> (Colour n -> RGB n) -> Colour n -> (n, n, n)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Colour n -> RGB n
forall b. (Ord b, Floating b) => Colour b -> RGB b
toSRGB) [Colour n
c1,Colour n
c2]
hsv3 :: (a, a, a) -> RGB a
hsv3 (a
h,a
s,a
v) = a -> a -> a -> RGB a
forall a. (RealFrac a, Ord a) => a -> a -> a -> RGB a
hsv a
h a
s a
v
lerpWrap :: (RealFrac n) => n -> n -> n -> n -> n
lerpWrap :: forall n. RealFrac n => n -> n -> n -> n -> n
lerpWrap n
a n
b n
m n
t = n -> n -> n -> n
forall n. Num n => n -> n -> n -> n
lerp' n
a n
b' n
t n -> n -> n
forall n. RealFrac n => n -> n -> n
`dmod` n
m
where
b' :: n
b' = (n -> n -> Ordering) -> [n] -> n
forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy ((n -> n) -> n -> n -> Ordering
forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (n -> n
forall a. Num a => a -> a
abs (n -> n) -> (n -> n) -> n -> n
forall b c a. (b -> c) -> (a -> b) -> a -> c
. n -> n -> n
forall a. Num a => a -> a -> a
subtract n
a)) [n
b n -> n -> n
forall a. Num a => a -> a -> a
- n
m, n
b, n
b n -> n -> n
forall a. Num a => a -> a -> a
+ n
m]
lerp' :: Num n => n -> n -> n -> n
lerp' :: forall n. Num n => n -> n -> n -> n
lerp' n
a n
b n
t = (n
1 n -> n -> n
forall a. Num a => a -> a -> a
- n
t) n -> n -> n
forall a. Num a => a -> a -> a
* n
a n -> n -> n
forall a. Num a => a -> a -> a
+ n
t n -> n -> n
forall a. Num a => a -> a -> a
* n
b
dmod :: RealFrac n => n -> n -> n
dmod :: forall n. RealFrac n => n -> n -> n
dmod n
a n
m = n
a n -> n -> n
forall a. Num a => a -> a -> a
- n
m n -> n -> n
forall a. Num a => a -> a -> a
* Integer -> n
forall a. Num a => Integer -> a
fromInteger (n -> Integer
forall b. Integral b => n -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (n
an -> n -> n
forall a. Fractional a => a -> a -> a
/n
m))