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 = forall a b. (a -> a -> a -> b) -> RGB a -> b
uncurryRGB forall b. (Ord b, Floating b) => b -> b -> b -> Colour b
sRGB forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {a}. RealFrac a => (a, a, a) -> RGB a
hsv3
forall a b. (a -> b) -> a -> b
$ (forall n. RealFrac n => n -> n -> n -> n -> n
lerpWrap n
h1 n
h2 n
360 n
t, forall n. Num n => n -> n -> n -> n
lerp' n
s1 n
s2 n
t, 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)] = forall a b. (a -> b) -> [a] -> [b]
map (forall a. (Fractional a, Ord a) => RGB a -> (a, a, a)
hsvView forall b c a. (b -> c) -> (a -> b) -> a -> c
. 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) = 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 = forall n. Num n => n -> n -> n -> n
lerp' n
a n
b' n
t forall n. RealFrac n => n -> n -> n
`dmod` n
m
where
b' :: n
b' = forall (t :: * -> *) a.
Foldable t =>
(a -> a -> Ordering) -> t a -> a
minimumBy (forall a b. Ord a => (b -> a) -> b -> b -> Ordering
comparing (forall a. Num a => a -> a
abs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Num a => a -> a -> a
subtract n
a)) [n
b forall a. Num a => a -> a -> a
- n
m, n
b, n
b 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 forall a. Num a => a -> a -> a
- n
t) forall a. Num a => a -> a -> a
* n
a forall a. Num a => a -> a -> a
+ n
t 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 forall a. Num a => a -> a -> a
- n
m forall a. Num a => a -> a -> a
* forall a. Num a => Integer -> a
fromInteger (forall a b. (RealFrac a, Integral b) => a -> b
floor (n
aforall a. Fractional a => a -> a -> a
/n
m))