{-|
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.
-}
{-# LANGUAGE Strict #-}

module Monomer.Graphics.Util (
  clampChannel,
  clampAlpha,
  rgb,
  rgba,
  rgbHex,
  rgbaHex,
  hsl,
  hsla,
  colorToHsl,
  rgbToHsl,
  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 = 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 = 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 {
  _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
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex forall a. Eq a => a -> a -> Bool
== Int
7 = String -> Color
rgbHexSix (forall a. [a] -> [a]
tail String
hex)
  | forall (t :: * -> *) a. Foldable t => t a -> Int
length String
hex forall a. Eq a => a -> a -> Bool
== Int
6 = String -> Color
rgbHexSix String
hex
  | Bool
otherwise = Int -> Int -> Int -> Color
rgb Int
0 Int
0 Int
0

-- | Creates a color from a six characters hex string. Fails if len is invalid.
rgbHexSix :: [Char] -> Color
rgbHexSix :: String -> Color
rgbHexSix String
hex = Int -> Int -> Int -> Color
rgb Int
r Int
g Int
b where
  [Char
r1, Char
r2, Char
g1, Char
g2, Char
b1, Char
b2] = String
hex
  r :: Int
r = Char -> Int
digitToInt Char
r1 forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
r2
  g :: Int
g = Char -> Int
digitToInt Char
g1 forall a. Num a => a -> a -> a
* Int
16 forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
g2
  b :: Int
b = Char -> Int
digitToInt Char
b1 forall a. Num a => a -> a -> a
* Int
16 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 = forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
360 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h)
  vs :: Double
vs = forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
100 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
s forall a. Fractional a => a -> a -> a
/ Double
100)
  vl :: Double
vl = forall a. Ord a => a -> a -> a -> a
clamp Double
0 Double
100 (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
l forall a. Fractional a => a -> a -> a
/ Double
100)
  a :: Double
a = Double
vs forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
min Double
vl (Double
1 forall a. Num a => a -> a -> a
- Double
vl)
  f :: Double -> Double
f Double
n = Double
vl forall a. Num a => a -> a -> a
- Double
a forall a. Num a => a -> a -> a
* forall a. Ord a => a -> a -> a
max Double
mink (-Double
1) where
    k :: Double
k = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a b. (RealFrac a, Integral b) => a -> b
round (Double
n forall a. Num a => a -> a -> a
+ Double
vh forall a. Fractional a => a -> a -> a
/ Double
30) forall a. Integral a => a -> a -> a
`mod` Integer
12
    mink :: Double
mink = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double
k forall a. Num a => a -> a -> a
- Double
3, Double
9 forall a. Num a => a -> a -> a
- Double
k, Double
1]
  i :: Double -> Int
i Double
n = Int -> Int
clampChannel forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (RealFrac a, Integral b) => a -> b
round forall a b. (a -> b) -> a -> b
$ Double
255 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
  }

-- | Converts a 'Color' instance to a tuple representing HSL values
colorToHsl :: Color -> (Int, Int, Int)
colorToHsl :: Color -> (Int, Int, Int)
colorToHsl (Color Int
cr Int
cg Int
cb Double
ca) = Int -> Int -> Int -> (Int, Int, Int)
rgbToHsl Int
cr Int
cg Int
cb

-- | Converts RGB values to a tuple representing HSL values
rgbToHsl :: Int -> Int -> Int -> (Int, Int, Int)
rgbToHsl :: Int -> Int -> Int -> (Int, Int, Int)
rgbToHsl Int
cr Int
cg Int
cb = (Int
h, forall a b. (RealFrac a, Integral b) => a -> b
round (Double
s forall a. Num a => a -> a -> a
* Double
255), forall a b. (RealFrac a, Integral b) => a -> b
round (Double
l forall a. Num a => a -> a -> a
* Double
255)) where
  r :: Double
r = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cr forall a. Fractional a => a -> a -> a
/ Double
255
  g :: Double
g = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cg forall a. Fractional a => a -> a -> a
/ Double
255
  b :: Double
b = forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
cb forall a. Fractional a => a -> a -> a
/ Double
255
  minc :: Double
minc = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
minimum [Double
r, Double
g, Double
b]
  maxc :: Double
maxc = forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [Double
r, Double
g, Double
b]
  rngc :: Double
rngc = Double
maxc forall a. Num a => a -> a -> a
- Double
minc
  h :: Int
h
    | Double
maxc forall a. Eq a => a -> a -> Bool
== Double
minc = Int
0
    | Double
maxc forall a. Eq a => a -> a -> Bool
== Double
r = forall a b. (RealFrac a, Integral b) => a -> b
round (Double
60 forall a. Num a => a -> a -> a
* (Double
g forall a. Num a => a -> a -> a
- Double
b) forall a. Fractional a => a -> a -> a
/ Double
rngc forall a. Num a => a -> a -> a
+ Double
360) forall a. Integral a => a -> a -> a
`mod` Int
360
    | Double
maxc forall a. Eq a => a -> a -> Bool
== Double
g = forall a b. (RealFrac a, Integral b) => a -> b
round (Double
60 forall a. Num a => a -> a -> a
* (Double
b forall a. Num a => a -> a -> a
- Double
r) forall a. Fractional a => a -> a -> a
/ Double
rngc forall a. Num a => a -> a -> a
+ Double
120) forall a. Integral a => a -> a -> a
`mod` Int
360
    | Bool
otherwise = forall a b. (RealFrac a, Integral b) => a -> b
round (Double
60 forall a. Num a => a -> a -> a
* (Double
r forall a. Num a => a -> a -> a
- Double
g) forall a. Fractional a => a -> a -> a
/ Double
rngc forall a. Num a => a -> a -> a
+ Double
240) forall a. Integral a => a -> a -> a
`mod` Int
360
  l :: Double
l = (Double
minc forall a. Num a => a -> a -> a
+ Double
maxc) forall a. Num a => a -> a -> a
* Double
0.5
  s :: Double
s
    | Double
maxc forall a. Eq a => a -> a -> Bool
== Double
minc = Double
0
    | Double
l forall a. Ord a => a -> a -> Bool
< Double
0.5 = Double
rngc forall a. Fractional a => a -> a -> a
/ (Double
2 forall a. Num a => a -> a -> a
* Double
l)
    | Bool
otherwise = Double
rngc forall a. Fractional a => a -> a -> a
/ (Double
2 forall a. Num a => a -> a -> a
- Double
2 forall a. Num a => a -> a -> a
* Double
l)

-- | 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 forall a. Num a => a -> a -> a
+ (Double
pw forall a. Num a => a -> a -> a
- Double
cw) forall a. Fractional a => a -> a -> a
/ Double
2
    AlignH
ARight -> Double
px forall a. Num a => a -> a -> a
+ Double
pw 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 forall a. Num a => a -> a -> a
+ (Double
ph forall a. Num a => a -> a -> a
- Double
ch) forall a. Fractional a => a -> a -> a
/ Double
2
    AlignV
ABottom -> Double
py forall a. Num a => a -> a -> a
+ Double
ph 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