{-|
Module      : Graphics.WorldTurtle.Color
Description : Color functions
Copyright   : (c) Archibald Neil MacDonald, 2020
License     : BSD3
Maintainer  : FortOyer@hotmail.co.uk
Stability   : experimental
Portability : POSIX

This module is a collection of color manipulation commands!

-}
module Graphics.WorldTurtle.Color
  ( module Graphics.Gloss.Data.Color
  , shiftHue
  ) where

import Data.Matrix

import Graphics.Gloss.Data.Color

import Graphics.WorldTurtle.Internal.Coords (degToRad)

-- | Rotates a given color's hue between [0, 360) degrees.

shiftHue :: Float -- ^ Degrees to change hue.

         -> Color -- ^ Color to shift.

         -> Color -- ^ Resultant color with hue shifted.

shiftHue :: Float -> Color -> Color
shiftHue Float
d Color
c = let d' :: Float
d' = Float -> Float
degToRad Float
d -- Radians to degrees

                   hMatrix :: Matrix Float
hMatrix = Float -> Matrix Float
hueMatrix Float
d'
                   (Float
r, Float
g, Float
b, Float
a) = Color -> (Float, Float, Float, Float)
rgbaOfColor Color
c
                   cMatrix :: Matrix Float
cMatrix = Int -> Int -> [Float] -> Matrix Float
forall a. Int -> Int -> [a] -> Matrix a
fromList Int
1 Int
3 [Float
r, Float
g, Float
b]
                   cMatrix' :: Matrix Float
cMatrix' = Matrix Float
cMatrix Matrix Float -> Matrix Float -> Matrix Float
forall a. Num a => a -> a -> a
* Matrix Float
hMatrix
                   [Float
r', Float
g', Float
b'] = Matrix Float -> [Float]
forall a. Matrix a -> [a]
toList Matrix Float
cMatrix'
                   in Float -> Float -> Float -> Float -> Color
makeColor Float
r' Float
g' Float
b' Float
a

-- Haskell form of solution posted here:

-- https://stackoverflow.com/questions/8507885/shift-hue-of-an-rgb-color

hueMatrix :: Float -> Matrix Float
hueMatrix :: Float -> Matrix Float
hueMatrix Float
degrees = Int -> Int -> ((Int, Int) -> Float) -> Matrix Float
forall a. Int -> Int -> ((Int, Int) -> a) -> Matrix a
matrix Int
3 Int
3 ((Int, Int) -> Float -> Float
`calcForIndex` Float
degrees)

calcForIndex :: (Int, Int) -> Float -> Float
calcForIndex :: (Int, Int) -> Float -> Float
calcForIndex (Int
1, Int
1) = Float -> Float
diag_
calcForIndex (Int
1, Int
2) = Float -> Float
perm1_
calcForIndex (Int
1, Int
3) = Float -> Float
perm2_ 
calcForIndex (Int
2, Int
1) = Float -> Float
perm2_ 
calcForIndex (Int
2, Int
2) = Float -> Float
diag_
calcForIndex (Int
2, Int
3) = Float -> Float
perm1_
calcForIndex (Int
3, Int
1) = Float -> Float
perm1_
calcForIndex (Int
3, Int
2) = Float -> Float
perm2_ 
calcForIndex (Int
3, Int
3) = Float -> Float
diag_
calcForIndex (Int, Int)
_      = [Char] -> Float -> Float
forall a. HasCallStack => [Char] -> a
error [Char]
"We only work with 3x3 matrices!"

diag_ :: Float -> Float
diag_ :: Float -> Float
diag_ Float
d = Float -> Float
forall a. Floating a => a -> a
cos Float
d Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1.0 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
cos Float
d)

perm1_ :: Float -> Float
perm1_ :: Float -> Float
perm1_ Float
d = Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
cos Float
d) Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
sqrt (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sin Float
d

perm2_ :: Float -> Float
perm2_ :: Float -> Float
perm2_ Float
d = Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float -> Float
forall a. Floating a => a -> a
cos Float
d) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float -> Float
forall a. Floating a => a -> a
sqrt (Float
1Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/Float
3) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float
forall a. Floating a => a -> a
sin Float
d