```module Geometry where

---------[ primitive geometries ]-----------------------------------------------

data Point u = Point  { _x :: u, _y :: u }
deriving (Show, Eq, Ord)

data Line u = Line { _a :: Point u, _b :: Point u }
deriving (Show, Eq, Ord)

data Tri u = Tri (Point u) (Point u) (Point u)
deriving (Show, Eq, Ord)

data Poly u = Poly [Point u]
deriving (Show, Eq, Ord)

data Mesh u = Mesh [Tri u]
deriving (Show, Eq, Ord)

---------[ procedural geometrical objects ]-------------------------------------

data Rect u = Rect (Point u) (Point u)
deriving (Show, Eq, Ord)

data Circle u = Circle (Point u) u
deriving (Show, Eq, Ord)

data Elipse u = Elipse (Point u) u u
deriving (Show, Eq, Ord)

---------[ primitive geometry class ]-------------------------------------------

class Geometry g where
centroid  :: (Ord u, Floating u) => g u -> Point u
bounds    :: (Ord u, Floating u) => g u -> Rect u
translate :: (Ord u, Floating u) => u -> u -> g u -> g u
rotate    :: (Ord u, Floating u) => u -> Point u -> g u -> g u
scale     :: (Ord u, Floating u) => u -> Point u -> g u -> g u
outline   :: g u -> Poly u
mesh      :: g u -> Mesh u
discrete  :: (RealFrac u, Integral i) => g u -> g i

-- Shortcut translations.

{-g +- d = translate (d, 0)  g
g +| d = translate (0, d)  g
g +\ d = translate (d, d)  g
g +/ d = translate (d, -d) g-}

-- Rotate geometry around own centroid.

rotateLocal :: (Geometry g, Ord u, Floating u) => u -> g u -> g u
rotateLocal u g = rotate u (centroid g) g

---------[ discrete 2-dimensional point type ]----------------------------------

instance Geometry Point where
centroid  = centroidPoint
bounds    = boundsPoint
translate = translatePoint
rotate    = rotatePoint
scale     = scalePoint
outline   = outlinePoint
mesh      = meshPoint
discrete  = discretePoint

centroidPoint :: Point u -> Point u
centroidPoint = id

boundsPoint :: Point u -> Rect u
boundsPoint p = Rect p p

translatePoint :: Num u => u -> u -> Point u -> Point u
translatePoint dx dy (Point x y) = Point (x + dx) (y + dy)

rotatePoint :: Floating u => u -> Point u -> Point u -> Point u
rotatePoint t (Point ox oy) (Point x y) = Point
(ox + (x-ox) * cos t - (y-oy) * sin t)
(oy + (x-ox) * sin t + (y-oy) * cos t)

scalePoint :: (Num u) => u -> Point u -> Point u -> Point u
scalePoint t (Point ox oy) (Point x y) = Point
(ox + (x-ox) * t)
(oy + (y-oy) * t)

outlinePoint :: Point u -> Poly u
outlinePoint p = Poly [p, p]

meshPoint :: Point u -> Mesh u
meshPoint p = Mesh [Tri p p p]

discretePoint :: (RealFrac u, Integral i) => Point u -> Point i
discretePoint (Point a b) = Point (round a) (round b)

--------[ discrete 2-dimensional line type ]-----------------------------------

instance Geometry Line where
centroid  = centroidLine
bounds    = boundsLine
translate = translateLine
rotate    = rotateLine
scale     = scaleLine
outline   = outlineLine
mesh      = meshLine
discrete  = discreteLine

centroidLine :: Fractional u => Line u -> Point u
centroidLine (Line (Point x0 y0) (Point x1 y1)) = Point ((x0+x1) / 2) ((y0+y1) / 2)

boundsLine :: Line u -> Rect u
boundsLine (Line a b) = Rect a b

translateLine :: (Ord u, Floating u) => u -> u -> Line u -> Line u
translateLine dx dy (Line a b) = Line (translate dx dy a) (translate dx dy b)

rotateLine :: (Ord u, Floating u) => u -> Point u -> Line u -> Line u
rotateLine d o (Line a b) = Line (rotate d o a) (rotate d o b)

scaleLine :: (Ord u, Floating u) => u -> Point u -> Line u -> Line u
scaleLine d o (Line a b) = Line (scale d o a) (scale d o b)

outlineLine :: Line u -> Poly u
outlineLine (Line a b) = Poly [a, b]

meshLine :: Line u -> Mesh u
meshLine (Line a b) = Mesh [Tri a a b]

discreteLine :: (RealFrac u, Integral i) => Line u -> Line i
discreteLine (Line a b) = Line (discrete a) (discrete b)

--------[ discrete 2-dimensional triangle type ]-------------------------------

instance Geometry Tri where
centroid  = centroidTri
bounds    = boundsTri
translate = translateTri
rotate    = rotateTri
scale     = scaleTri
outline   = outlineTri
mesh      = meshTri
discrete  = discreteTri

centroidTri :: (Ord u, Floating u) => Tri u -> Point u
centroidTri (Tri a b c) = centroid \$ Line (centroid \$ Line a b) c

boundsTri :: Ord u => Tri u -> Rect u
boundsTri (Tri (Point x0 y0) (Point x1 y1) (Point x2 y2)) = Rect
(Point (min (min x0 x1) x2) (min (min y0 y1) y2))
(Point (max (max x0 x1) x2) (max (max y0 y1) y2))

translateTri :: (Ord u, Floating u) => u -> u -> Tri u -> Tri u
translateTri dx dy (Tri a b c) = Tri (translate dx dy a) (translate dx dy b) (translate dx dy c)

rotateTri :: (Ord u, Floating u) => u -> Point u -> Tri u -> Tri u
rotateTri d o (Tri a b c) = Tri (rotate d o a) (rotate d o b) (rotate d o c)

scaleTri :: (Ord u, Floating u) => u -> Point u -> Tri u -> Tri u
scaleTri d o (Tri a b c) = Tri (scale d o a) (scale d o b) (scale d o c)

outlineTri :: Tri u -> Poly u
outlineTri (Tri a b c) = Poly [a, b, c, a]

meshTri :: Tri u -> Mesh u
meshTri t = Mesh [t]

discreteTri :: (RealFrac u, Integral i) => Tri u -> Tri i
discreteTri (Tri a b c) = Tri (discrete a) (discrete b) (discrete c)

--------[ discrete 2-dimensional polygon type ]--------------------------------

instance Geometry Poly where
centroid  = centroidPoly
bounds    = boundsPoly
translate = translatePoly
rotate    = rotatePoly
scale     = scalePoly
outline   = outlinePoly
mesh      = meshPoly
discrete  = discretePoly

centroidPoly :: Fractional u => Poly u -> Point u
centroidPoly (Poly xs) = Point (sum (map _x xs) / n) (sum (map _y xs) / n)
where n = fromIntegral \$ length xs

boundsPoly :: Ord u => Poly u -> Rect u
boundsPoly (Poly xs) = Rect
(Point (minimum \$ map _x xs) (minimum \$ map _y xs))
(Point (maximum \$ map _x xs) (maximum \$ map _y xs))

translatePoly :: (Ord u, Floating u) => u -> u -> Poly u -> Poly u
translatePoly dx dy (Poly xs) = Poly \$ map (translate dx dy) xs

rotatePoly :: (Ord u, Floating u) => u -> Point u -> Poly u -> Poly u
rotatePoly d o (Poly xs) = Poly \$ map (rotate d o) xs

scalePoly :: (Ord u, Floating u) => u -> Point u -> Poly u -> Poly u
scalePoly d o (Poly xs) = Poly \$ map (scale d o) xs

outlinePoly :: Poly u -> Poly u
outlinePoly = id

meshPoly :: Poly u -> Mesh u
meshPoly = error "todo"

discretePoly :: (RealFrac u, Integral i) => Poly u -> Poly i
discretePoly (Poly xs) = Poly \$ map discrete xs

--------[ discrete 2-dimensional rectangle utils ]-----------------------------

inRect :: (Ord u) => Point u -> Rect u -> Bool
inRect (Point x y) (Rect (Point x0 y0) (Point x1 y1)) =
x >= x0 && x <= x1 && y >= y0 && y <= y1

intersectRect :: (Ord u, Num u) => Rect u -> Rect u -> Maybe (Rect u)
intersectRect (Rect (Point ax0 ay0) (Point ax1 ay1)) (Rect (Point bx0 by0) (Point bx1 by1)) =
if ((x1-x0) <= 0 || (y1-y0) <= 0)
then Nothing
else Just \$ Rect (Point x0 y0) (Point x1 y1)
where
x0 = max ax0 bx0
y0 = max ay0 by0
x1 = min ax1 bx1
y1 = min ay1 by1

star :: (Enum u, Floating u) => Point u -> u -> u -> u -> Poly u
star (Point x y) s r0 r1 = Poly \$ concat
[[  Point
(x + r0 * cos (2 * pi / s * t))
(y + r0 * sin (2 * pi / s * t))
, Point
(x + r1 * cos (2 * pi / (s*2) * (t*2+1)))
(y + r1 * sin (2 * pi / (s*2) * (t*2+1)))
] | t <- [0 .. s]]

```