{-|
Module      : Monomer.Graphics.Util
Copyright   : (c) 2018 Francisco Vallarino
License     : BSD-3-Clause (see the LICENSE file)
Maintainer  : fjvallarino@gmail.com
Stability   : experimental
Portability : non-portable

Helper functions for graphics related operations.
-}
module Monomer.Graphics.Util (
  clampChannel,
  clampAlpha,
  rgb,
  rgba,
  rgbHex,
  rgbaHex,
  hsl,
  hsla,
  transparent,
  alignInRect,
  alignHInRect,
  alignVInRect
) where

import Data.Char (digitToInt)

import Monomer.Common.BasicTypes
import Monomer.Graphics.Types
import Monomer.Helper

-- | Restricts a color channel to its valid range.
clampChannel :: Int -> Int
clampChannel :: Int -> Int
clampChannel Int
channel = Int -> Int -> Int -> Int
forall a. Ord a => a -> a -> a -> a
clamp Int
0 Int
255 Int
channel

-- | Restricts an alpha channel to its valid range.
clampAlpha :: Double -> Double
clampAlpha :: Double -> Double
clampAlpha Double
alpha = Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
1 Double
alpha

{-|
Creates a Color from red, green and blue components. Valid range for each
component is [0, 255].
-}
rgb :: Int -> Int -> Int -> Color
rgb :: Int -> Int -> Int -> Color
rgb Int
r Int
g Int
b = Int -> Int -> Int -> Double -> Color
Color (Int -> Int
clampChannel Int
r) (Int -> Int
clampChannel Int
g) (Int -> Int
clampChannel Int
b) Double
1.0

{-|
Creates a Color from red, green and blue components plus alpha channel. Valid
range for each component is [0, 255], while alpha is [0, 1].
-}
rgba :: Int -> Int -> Int -> Double -> Color
rgba :: Int -> Int -> Int -> Double -> Color
rgba Int
r Int
g Int
b Double
a = Color :: Int -> Int -> Int -> Double -> Color
Color {
  _colorR :: Int
_colorR = Int -> Int
clampChannel Int
r,
  _colorG :: Int
_colorG = Int -> Int
clampChannel Int
g,
  _colorB :: Int
_colorB = Int -> Int
clampChannel Int
b,
  _colorA :: Double
_colorA = Double -> Double
clampAlpha Double
a
}

-- | Creates a Color from a hex string. It may include a # prefix or not.
rgbHex :: String -> Color
rgbHex :: String -> Color
rgbHex String
hex
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
7 = String -> Color
rgbHex (String -> String
forall a. [a] -> [a]
tail String
hex)
  | String -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
6 = Int -> Int -> Int -> Color
rgb Int
r Int
g Int
b
  | Bool
otherwise = Int -> Int -> Int -> Color
rgb Int
0 Int
0 Int
0
  where
    [Char
r1, Char
r2, Char
g1, Char
g2, Char
b1, Char
b2] = String
hex
    r :: Int
r = Char -> Int
digitToInt Char
r1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
r2
    g :: Int
g = Char -> Int
digitToInt Char
g1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
g2
    b :: Int
b = Char -> Int
digitToInt Char
b1 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
b2

{-|
Creates a Color from a hex string plus an alpha component. It may include a #
prefix or not.
-}
rgbaHex :: String -> Double -> Color
rgbaHex :: String -> Double -> Color
rgbaHex String
hex Double
alpha = (String -> Color
rgbHex String
hex) {
    _colorA :: Double
_colorA = Double -> Double
clampAlpha Double
alpha
  }

{-|
Creates a Color instance from HSL components. The valid ranges are:

- Hue: [0, 360]
- Saturation: [0, 100]
- Lightness: [0, 100]

Alpha is set to 1.0.
-}
hsl :: Int -> Int -> Int -> Color
hsl :: Int -> Int -> Int -> Color
hsl Int
h Int
s Int
l = Int -> Int -> Int -> Double -> Color
Color Int
r Int
g Int
b Double
1.0 where
  vh :: Double
vh = Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
360 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
  vs :: Double
vs = Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
100 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)
  vl :: Double
vl = Double -> Double -> Double -> Double
forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
100 (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
100)
  a :: Double
a = Double
vs Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Ord a => a -> a -> a
min Double
vl (Double
1 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
vl)
  f :: Double -> Double
f Double
n = Double
vl Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
a Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double -> Double
forall a. Ord a => a -> a -> a
max Double
mink (-Double
1) where
    k :: Double
k = Integer -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Double) -> Integer -> Double
forall a b. (a -> b) -> a -> b
$ Double -> Integer
forall a b. (RealFrac a, Integral b) => a -> b
round (Double
n Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
vh Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
30) Integer -> Integer -> Integer
forall a. Integral a => a -> a -> a
`mod` Integer
12
    mink :: Double
mink = [Double] -> Double
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double
k Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
3, Double
9 Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
k, Double
1]
  i :: Double -> Int
i Double
n = Int -> Int
clampChannel (Int -> Int) -> (Double -> Int) -> Double -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Int
forall a b. (RealFrac a, Integral b) => a -> b
round (Double -> Int) -> Double -> Int
forall a b. (a -> b) -> a -> b
$ Double
255 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double -> Double
f Double
n
  (Int
r, Int
g, Int
b) = (Double -> Int
i Double
0, Double -> Int
i Double
8, Double -> Int
i Double
4)

{-|
Creates a Color instance from HSL components. The valid ranges are:

- Hue: [0, 360]
- Saturation: [0, 100]
- Lightness: [0, 100]
- Alpha: [0, 1]
-}
hsla :: Int -> Int -> Int -> Double -> Color
hsla :: Int -> Int -> Int -> Double -> Color
hsla Int
h Int
s Int
l Double
a = (Int -> Int -> Int -> Color
hsl Int
h Int
s Int
l) {
    _colorA :: Double
_colorA = Double -> Double
clampAlpha Double
a
  }

-- | Creates a non visible color.
transparent :: Color
transparent :: Color
transparent = Int -> Int -> Int -> Double -> Color
rgba Int
0 Int
0 Int
0 Double
0

{-|
Aligns the child rect inside the parent given the alignment constraints.

Note: The child rect can overflow the parent.
-}
alignInRect :: Rect -> Rect -> AlignH -> AlignV -> Rect
alignInRect :: Rect -> Rect -> AlignH -> AlignV -> Rect
alignInRect Rect
parent Rect
child AlignH
ah AlignV
av = Rect
newRect where
  tempRect :: Rect
tempRect = Rect -> Rect -> AlignV -> Rect
alignVInRect Rect
parent Rect
child AlignV
av
  newRect :: Rect
newRect = Rect -> Rect -> AlignH -> Rect
alignHInRect Rect
parent Rect
tempRect AlignH
ah

-- | Aligns the child rect horizontally inside the parent.
alignHInRect :: Rect -> Rect -> AlignH -> Rect
alignHInRect :: Rect -> Rect -> AlignH -> Rect
alignHInRect Rect
parent Rect
child AlignH
ah = Rect
newRect where
  Rect Double
px Double
_ Double
pw Double
_ = Rect
parent
  Rect Double
_ Double
cy Double
cw Double
ch = Rect
child
  newX :: Double
newX = case AlignH
ah of
    AlignH
ALeft -> Double
px
    AlignH
ACenter -> Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
pw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    AlignH
ARight -> Double
px Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
pw Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
cw
  newRect :: Rect
newRect = Double -> Double -> Double -> Double -> Rect
Rect Double
newX Double
cy Double
cw Double
ch

-- | Aligns the child rect vertically inside the parent.
alignVInRect :: Rect -> Rect -> AlignV -> Rect
alignVInRect :: Rect -> Rect -> AlignV -> Rect
alignVInRect Rect
parent Rect
child AlignV
av = Rect
newRect where
  Rect Double
_ Double
py Double
_ Double
ph = Rect
parent
  Rect Double
cx Double
_ Double
cw Double
ch = Rect
child
  newY :: Double
newY = case AlignV
av of
    AlignV
ATop -> Double
py
    AlignV
AMiddle -> Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ (Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ch) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
2
    AlignV
ABottom -> Double
py Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
ph Double -> Double -> Double
forall a. Num a => a -> a -> a
- Double
ch
  newRect :: Rect
newRect = Double -> Double -> Double -> Double -> Rect
Rect Double
cx Double
newY Double
cw Double
ch