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

Basic types used across the library.
-}
{-# LANGUAGE DeriveGeneric #-}

module Monomer.Common.BasicTypes where

import Data.Default
import Data.Sequence (Seq)
import GHC.Generics

import qualified Data.Sequence as Seq

-- | An index in the list of children of a widget.
type PathStep = Int
-- | A sequence of steps, usually from the root.
type Path = Seq PathStep
-- | Resize factor.
type Factor = Double

-- | Point in the 2D space.
data Point = Point {
  Point -> Double
_pX :: {-# UNPACK #-} !Double,
  Point -> Double
_pY :: {-# UNPACK #-} !Double
} deriving (Point -> Point -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Point -> Point -> Bool
$c/= :: Point -> Point -> Bool
== :: Point -> Point -> Bool
$c== :: Point -> Point -> Bool
Eq, PathStep -> Point -> ShowS
[Point] -> ShowS
Point -> String
forall a.
(PathStep -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Point] -> ShowS
$cshowList :: [Point] -> ShowS
show :: Point -> String
$cshow :: Point -> String
showsPrec :: PathStep -> Point -> ShowS
$cshowsPrec :: PathStep -> Point -> ShowS
Show, forall x. Rep Point x -> Point
forall x. Point -> Rep Point x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Point x -> Point
$cfrom :: forall x. Point -> Rep Point x
Generic)

instance Default Point where
  def :: Point
def = Double -> Double -> Point
Point Double
0 Double
0

-- | Width and height, used for size requirements.
data Size = Size {
  Size -> Double
_sW :: {-# UNPACK #-} !Double,
  Size -> Double
_sH :: {-# UNPACK #-} !Double
} deriving (Size -> Size -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c== :: Size -> Size -> Bool
Eq, PathStep -> Size -> ShowS
[Size] -> ShowS
Size -> String
forall a.
(PathStep -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Size] -> ShowS
$cshowList :: [Size] -> ShowS
show :: Size -> String
$cshow :: Size -> String
showsPrec :: PathStep -> Size -> ShowS
$cshowsPrec :: PathStep -> Size -> ShowS
Show, forall x. Rep Size x -> Size
forall x. Size -> Rep Size x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Size x -> Size
$cfrom :: forall x. Size -> Rep Size x
Generic)

instance Default Size where
  def :: Size
def = Double -> Double -> Size
Size Double
0 Double
0

-- | Rectangle, usually representing an area of the screen.
data Rect = Rect {
  Rect -> Double
_rX :: {-# UNPACK #-} !Double,
  Rect -> Double
_rY :: {-# UNPACK #-} !Double,
  Rect -> Double
_rW :: {-# UNPACK #-} !Double,
  Rect -> Double
_rH :: {-# UNPACK #-} !Double
} deriving (Rect -> Rect -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c== :: Rect -> Rect -> Bool
Eq, PathStep -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
forall a.
(PathStep -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rect] -> ShowS
$cshowList :: [Rect] -> ShowS
show :: Rect -> String
$cshow :: Rect -> String
showsPrec :: PathStep -> Rect -> ShowS
$cshowsPrec :: PathStep -> Rect -> ShowS
Show, forall x. Rep Rect x -> Rect
forall x. Rect -> Rep Rect x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Rect x -> Rect
$cfrom :: forall x. Rect -> Rep Rect x
Generic)

instance Default Rect where
  def :: Rect
def = Double -> Double -> Double -> Double -> Rect
Rect Double
0 Double
0 Double
0 Double
0

-- | An empty path.
emptyPath :: Path
emptyPath :: Path
emptyPath = forall a. Seq a
Seq.empty

-- | The path of the root element.
rootPath :: Path
rootPath :: Path
rootPath = forall a. a -> Seq a
Seq.singleton PathStep
0

-- | Checks if a point is inside the given rect.
pointInRect :: Point -> Rect -> Bool
pointInRect :: Point -> Rect -> Bool
pointInRect (Point Double
px Double
py) Rect
rect = Double -> Rect -> Bool
coordInRectH Double
px Rect
rect Bool -> Bool -> Bool
&& Double -> Rect -> Bool
coordInRectY Double
py Rect
rect

-- | Checks if a point is inside the given ellipse.
pointInEllipse :: Point -> Rect -> Bool
pointInEllipse :: Point -> Rect -> Bool
pointInEllipse (Point Double
px Double
py) Rect
rect = Double
ellipseTest forall a. Ord a => a -> a -> Bool
<= Double
1 where
  Rect Double
rx Double
ry Double
rw Double
rh = Rect
rect
  ew :: Double
ew = Double
rw forall a. Fractional a => a -> a -> a
/ Double
2
  eh :: Double
eh = Double
rh forall a. Fractional a => a -> a -> a
/ Double
2
  cx :: Double
cx = Double
rx forall a. Num a => a -> a -> a
+ Double
ew
  cy :: Double
cy = Double
ry forall a. Num a => a -> a -> a
+ Double
eh
  ellipseTest :: Double
ellipseTest = ((Double
px forall a. Num a => a -> a -> a
- Double
cx) forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2) forall a. Fractional a => a -> a -> a
/ Double
ew forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2  forall a. Num a => a -> a -> a
+ ((Double
py forall a. Num a => a -> a -> a
- Double
cy) forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2) forall a. Fractional a => a -> a -> a
/ Double
eh forall a b. (Num a, Integral b) => a -> b -> a
^ Integer
2

-- | Adds two points.
addPoint :: Point -> Point -> Point
addPoint :: Point -> Point -> Point
addPoint (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) = Double -> Double -> Point
Point (Double
x1 forall a. Num a => a -> a -> a
+ Double
x2) (Double
y1 forall a. Num a => a -> a -> a
+ Double
y2)

-- | Subtracts one point from another.
subPoint :: Point -> Point -> Point
subPoint :: Point -> Point -> Point
subPoint (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) = Double -> Double -> Point
Point (Double
x1 forall a. Num a => a -> a -> a
- Double
x2) (Double
y1 forall a. Num a => a -> a -> a
- Double
y2)

-- | Multiplies the coordinates of a point by the given factor.
mulPoint :: Double -> Point -> Point
mulPoint :: Double -> Point -> Point
mulPoint Double
factor (Point Double
x Double
y) = Double -> Double -> Point
Point (Double
factor forall a. Num a => a -> a -> a
* Double
x) (Double
factor forall a. Num a => a -> a -> a
* Double
y)

-- | Returns the middle between two points.
midPoint :: Point -> Point -> Point
midPoint :: Point -> Point -> Point
midPoint Point
p1 Point
p2 = Point -> Point -> Double -> Point
interpolatePoints Point
p1 Point
p2 Double
0.5

-- | Returns the point between a and b, f units away from a.
interpolatePoints :: Point -> Point -> Double -> Point
interpolatePoints :: Point -> Point -> Double -> Point
interpolatePoints (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) Double
f = Point
newPoint where
  newPoint :: Point
newPoint = Double -> Double -> Point
Point (Double
f forall a. Num a => a -> a -> a
* Double
x1 forall a. Num a => a -> a -> a
+ (Double
1 forall a. Num a => a -> a -> a
- Double
f) forall a. Num a => a -> a -> a
* Double
x2) (Double
f forall a. Num a => a -> a -> a
* Double
y1 forall a. Num a => a -> a -> a
+ (Double
1 forall a. Num a => a -> a -> a
- Double
f) forall a. Num a => a -> a -> a
* Double
y2)

-- | Negates the coordinates of a point.
negPoint :: Point -> Point
negPoint :: Point -> Point
negPoint (Point Double
x Double
y) = Double -> Double -> Point
Point (-Double
x) (-Double
y)

{-|
Returns the minimum distance from the point given as first argument to the line
formed by the points given as second and third arguments.
-}
pointToLineDistance :: Point -> Point -> Point -> Double
pointToLineDistance :: Point -> Point -> Point -> Double
pointToLineDistance Point
p0 Point
p1 Point
p2 = Double
distNum forall a. Fractional a => a -> a -> a
/ Double
distDen where
  Point Double
px0 Double
py0 = Point
p0
  Point Double
px1 Double
py1 = Point
p1
  Point Double
px2 Double
py2 = Point
p2
  distNum :: Double
distNum = forall a. Num a => a -> a
abs ((Double
px2 forall a. Num a => a -> a -> a
- Double
px1) forall a. Num a => a -> a -> a
* (Double
py1 forall a. Num a => a -> a -> a
- Double
py0) forall a. Num a => a -> a -> a
- (Double
px1 forall a. Num a => a -> a -> a
- Double
px0) forall a. Num a => a -> a -> a
* (Double
py2 forall a. Num a => a -> a -> a
- Double
py1))
  distDen :: Double
distDen = forall a. Floating a => a -> a
sqrt ((Double
px2 forall a. Num a => a -> a -> a
- Double
px1) forall a. Floating a => a -> a -> a
** Double
2 forall a. Num a => a -> a -> a
+ (Double
py2 forall a. Num a => a -> a -> a
- Double
py1) forall a. Floating a => a -> a -> a
** Double
2)

-- | Checks if a coordinate is inside the horizontal range of a rect.
coordInRectH :: Double -> Rect -> Bool
coordInRectH :: Double -> Rect -> Bool
coordInRectH Double
px (Rect Double
x Double
y Double
w Double
h) = Double
px forall a. Ord a => a -> a -> Bool
>= Double
x Bool -> Bool -> Bool
&& Double
px forall a. Ord a => a -> a -> Bool
< Double
x forall a. Num a => a -> a -> a
+ Double
w

-- | Checks if a coordinate is inside the vertical range of a rect.
coordInRectY :: Double -> Rect -> Bool
coordInRectY :: Double -> Rect -> Bool
coordInRectY Double
py (Rect Double
x Double
y Double
w Double
h) = Double
py forall a. Ord a => a -> a -> Bool
>= Double
y Bool -> Bool -> Bool
&& Double
py forall a. Ord a => a -> a -> Bool
< Double
y forall a. Num a => a -> a -> a
+ Double
h

-- | Adds width and height to a Size.
addToSize :: Size -> Double -> Double -> Maybe Size
addToSize :: Size -> Double -> Double -> Maybe Size
addToSize (Size Double
w Double
h) Double
w2 Double
h2 = Maybe Size
newSize where
  nw :: Double
nw = Double
w forall a. Num a => a -> a -> a
+ Double
w2
  nh :: Double
nh = Double
h forall a. Num a => a -> a -> a
+ Double
h2
  newSize :: Maybe Size
newSize
    | Double
nw forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
nh forall a. Ord a => a -> a -> Bool
>= Double
0 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Double -> Size
Size Double
nw Double
nh
    | Bool
otherwise = forall a. Maybe a
Nothing

-- | Subtracts width and height from a Size.
subtractFromSize :: Size -> Double -> Double -> Maybe Size
subtractFromSize :: Size -> Double -> Double -> Maybe Size
subtractFromSize (Size Double
w Double
h) Double
w2 Double
h2 = Maybe Size
newSize where
  nw :: Double
nw = Double
w forall a. Num a => a -> a -> a
- Double
w2
  nh :: Double
nh = Double
h forall a. Num a => a -> a -> a
- Double
h2
  newSize :: Maybe Size
newSize
    | Double
nw forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
nh forall a. Ord a => a -> a -> Bool
>= Double
0 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Double -> Size
Size Double
nw Double
nh
    | Bool
otherwise = forall a. Maybe a
Nothing

-- | Moves a rect by the provided offset.
moveRect :: Point -> Rect -> Rect
moveRect :: Point -> Rect -> Rect
moveRect (Point Double
x Double
y) (Rect Double
rx Double
ry Double
rw Double
rh) = Double -> Double -> Double -> Double -> Rect
Rect (Double
rx forall a. Num a => a -> a -> a
+ Double
x) (Double
ry forall a. Num a => a -> a -> a
+ Double
y) Double
rw Double
rh

-- | Scales a rect by the provided factor.
mulRect :: Double -> Rect -> Rect
mulRect :: Double -> Rect -> Rect
mulRect Double
f (Rect Double
rx Double
ry Double
rw Double
rh) = Double -> Double -> Double -> Double -> Rect
Rect (Double
f forall a. Num a => a -> a -> a
* Double
rx) (Double
f forall a. Num a => a -> a -> a
* Double
ry) (Double
f forall a. Num a => a -> a -> a
* Double
rw) (Double
f forall a. Num a => a -> a -> a
* Double
rh)

-- | Returns the middle point of a rect.
rectCenter :: Rect -> Point
rectCenter :: Rect -> Point
rectCenter (Rect Double
rx Double
ry Double
rw Double
rh) = Double -> Double -> Point
Point (Double
rx forall a. Num a => a -> a -> a
+ Double
rw forall a. Fractional a => a -> a -> a
/ Double
2) (Double
ry forall a. Num a => a -> a -> a
+ Double
rh forall a. Fractional a => a -> a -> a
/ Double
2)

-- | Checks if a rectangle is completely inside a rect.
rectInRect :: Rect -> Rect -> Bool
rectInRect :: Rect -> Rect -> Bool
rectInRect Rect
inner Rect
outer = Rect -> Rect -> Bool
rectInRectH Rect
inner Rect
outer Bool -> Bool -> Bool
&& Rect -> Rect -> Bool
rectInRectV Rect
inner Rect
outer

-- | Checks if a rectangle is completely inside a rectangle horizontal area.
rectInRectH :: Rect -> Rect -> Bool
rectInRectH :: Rect -> Rect -> Bool
rectInRectH (Rect Double
x1 Double
y1 Double
w1 Double
h1) (Rect Double
x2 Double
y2 Double
w2 Double
h2) =
  Double
x1 forall a. Ord a => a -> a -> Bool
>= Double
x2 Bool -> Bool -> Bool
&& Double
x1 forall a. Num a => a -> a -> a
+ Double
w1 forall a. Ord a => a -> a -> Bool
<= Double
x2 forall a. Num a => a -> a -> a
+ Double
w2

-- | Checks if a rectangle is completely inside a rectangle vertical area.
rectInRectV :: Rect -> Rect -> Bool
rectInRectV :: Rect -> Rect -> Bool
rectInRectV (Rect Double
x1 Double
y1 Double
w1 Double
h1) (Rect Double
x2 Double
y2 Double
w2 Double
h2) =
  Double
y1 forall a. Ord a => a -> a -> Bool
>= Double
y2 Bool -> Bool -> Bool
&& Double
y1 forall a. Num a => a -> a -> a
+ Double
h1 forall a. Ord a => a -> a -> Bool
<= Double
y2 forall a. Num a => a -> a -> a
+ Double
h2

-- | Checks if a rectangle overlaps another rectangle.
rectsOverlap :: Rect -> Rect -> Bool
rectsOverlap :: Rect -> Rect -> Bool
rectsOverlap (Rect Double
x1 Double
y1 Double
w1 Double
h1) (Rect Double
x2 Double
y2 Double
w2 Double
h2) = Bool
overlapX Bool -> Bool -> Bool
&& Bool
overlapY where
  overlapX :: Bool
overlapX = Double
x1 forall a. Ord a => a -> a -> Bool
< Double
x2 forall a. Num a => a -> a -> a
+ Double
w2 Bool -> Bool -> Bool
&& Double
x1 forall a. Num a => a -> a -> a
+ Double
w1 forall a. Ord a => a -> a -> Bool
> Double
x2
  overlapY :: Bool
overlapY = Double
y1 forall a. Ord a => a -> a -> Bool
< Double
y2 forall a. Num a => a -> a -> a
+ Double
h2 Bool -> Bool -> Bool
&& Double
y1 forall a. Num a => a -> a -> a
+ Double
h1 forall a. Ord a => a -> a -> Bool
> Double
y2

-- | Returns a point bounded to the horizontal and vertical limits of a rect.
rectBoundedPoint :: Rect -> Point -> Point
rectBoundedPoint :: Rect -> Point -> Point
rectBoundedPoint (Rect Double
rx Double
ry Double
rw Double
rh) (Point Double
px Double
py) = Double -> Double -> Point
Point Double
px2 Double
py2 where
  px2 :: Double
px2 = forall a. Ord a => a -> a -> a
max Double
rx forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min (Double
rx forall a. Num a => a -> a -> a
+ Double
rw) forall a b. (a -> b) -> a -> b
$ Double
px
  py2 :: Double
py2 = forall a. Ord a => a -> a -> a
max Double
ry forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => a -> a -> a
min (Double
ry forall a. Num a => a -> a -> a
+ Double
rh) forall a b. (a -> b) -> a -> b
$ Double
py

-- | Returns a rect using the provided points as boundaries
rectFromPoints :: Point -> Point -> Rect
rectFromPoints :: Point -> Point -> Rect
rectFromPoints (Point Double
x1 Double
y1) (Point Double
x2 Double
y2) = Double -> Double -> Double -> Double -> Rect
Rect Double
x Double
y Double
w Double
h where
  x :: Double
x = forall a. Ord a => a -> a -> a
min Double
x1 Double
x2
  y :: Double
y = forall a. Ord a => a -> a -> a
min Double
y1 Double
y2
  w :: Double
w = forall a. Num a => a -> a
abs (Double
x2 forall a. Num a => a -> a -> a
- Double
x1)
  h :: Double
h = forall a. Num a => a -> a
abs (Double
y2 forall a. Num a => a -> a -> a
- Double
y1)

-- | Adds individual x, y, w and h coordinates to a rect.
addToRect :: Rect -> Double -> Double -> Double -> Double -> Maybe Rect
addToRect :: Rect -> Double -> Double -> Double -> Double -> Maybe Rect
addToRect (Rect Double
x Double
y Double
w Double
h) Double
l Double
r Double
t Double
b = Maybe Rect
newRect where
  nx :: Double
nx = Double
x forall a. Num a => a -> a -> a
- Double
l
  ny :: Double
ny = Double
y forall a. Num a => a -> a -> a
- Double
t
  nw :: Double
nw = Double
w forall a. Num a => a -> a -> a
+ Double
l forall a. Num a => a -> a -> a
+ Double
r
  nh :: Double
nh = Double
h forall a. Num a => a -> a -> a
+ Double
t forall a. Num a => a -> a -> a
+ Double
b
  newRect :: Maybe Rect
newRect
    | Double
nw forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
nh forall a. Ord a => a -> a -> Bool
>= Double
0 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect
Rect Double
nx Double
ny Double
nw Double
nh
    | Bool
otherwise = forall a. Maybe a
Nothing

-- | Subtracts individual x, y, w and h coordinates from a rect.
subtractFromRect :: Rect -> Double -> Double -> Double -> Double -> Maybe Rect
subtractFromRect :: Rect -> Double -> Double -> Double -> Double -> Maybe Rect
subtractFromRect (Rect Double
x Double
y Double
w Double
h) Double
l Double
r Double
t Double
b = Maybe Rect
newRect where
  nx :: Double
nx = Double
x forall a. Num a => a -> a -> a
+ Double
l
  ny :: Double
ny = Double
y forall a. Num a => a -> a -> a
+ Double
t
  nw :: Double
nw = Double
w forall a. Num a => a -> a -> a
- Double
l forall a. Num a => a -> a -> a
- Double
r
  nh :: Double
nh = Double
h forall a. Num a => a -> a -> a
- Double
t forall a. Num a => a -> a -> a
- Double
b
  newRect :: Maybe Rect
newRect
    | Double
nw forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
nh forall a. Ord a => a -> a -> Bool
>= Double
0 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect
Rect Double
nx Double
ny Double
nw Double
nh
    | Bool
otherwise = forall a. Maybe a
Nothing

-- | Returns the intersection of two rects, if any.
intersectRects :: Rect -> Rect -> Maybe Rect
intersectRects :: Rect -> Rect -> Maybe Rect
intersectRects (Rect Double
x1 Double
y1 Double
w1 Double
h1) (Rect Double
x2 Double
y2 Double
w2 Double
h2) = Maybe Rect
newRect where
  nx1 :: Double
nx1 = forall a. Ord a => a -> a -> a
max Double
x1 Double
x2
  nx2 :: Double
nx2 = forall a. Ord a => a -> a -> a
min (Double
x1 forall a. Num a => a -> a -> a
+ Double
w1) (Double
x2 forall a. Num a => a -> a -> a
+ Double
w2)
  ny1 :: Double
ny1 = forall a. Ord a => a -> a -> a
max Double
y1 Double
y2
  ny2 :: Double
ny2 = forall a. Ord a => a -> a -> a
min (Double
y1 forall a. Num a => a -> a -> a
+ Double
h1) (Double
y2 forall a. Num a => a -> a -> a
+ Double
h2)
  nw :: Double
nw = Double
nx2 forall a. Num a => a -> a -> a
- Double
nx1
  nh :: Double
nh = Double
ny2 forall a. Num a => a -> a -> a
- Double
ny1
  newRect :: Maybe Rect
newRect
    | Double
nw forall a. Ord a => a -> a -> Bool
>= Double
0 Bool -> Bool -> Bool
&& Double
nh forall a. Ord a => a -> a -> Bool
>= Double
0 = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Double -> Double -> Double -> Double -> Rect
Rect Double
nx1 Double
ny1 Double
nw Double
nh
    | Bool
otherwise = forall a. Maybe a
Nothing