{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
-- | Module implementing types used for geometry

-- bound calculations.

module Graphics.Rasterific.PlaneBoundable ( PlaneBound( .. )
                                          , PlaneBoundable( .. )
                                          , boundWidth
                                          , boundHeight
                                          , boundLowerLeftCorner
                                          ) where

import Graphics.Rasterific.Linear( V2( .. ) )
import Graphics.Rasterific.Types
import Graphics.Rasterific.CubicBezier

-- | Represent the minimal axis aligned rectangle

-- in which some primitives can be drawn. Should

-- fit to bezier curve and not use directly their

-- control points.

data PlaneBound = PlaneBound
    { -- | Corner upper left of the bounding box of

      -- the considered primitives.

      PlaneBound -> Point
_planeMinBound :: !Point
      -- | Corner lower right of the bounding box of

      -- the considered primitives.

    , PlaneBound -> Point
_planeMaxBound :: !Point
    }
    deriving (PlaneBound -> PlaneBound -> Bool
(PlaneBound -> PlaneBound -> Bool)
-> (PlaneBound -> PlaneBound -> Bool) -> Eq PlaneBound
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PlaneBound -> PlaneBound -> Bool
$c/= :: PlaneBound -> PlaneBound -> Bool
== :: PlaneBound -> PlaneBound -> Bool
$c== :: PlaneBound -> PlaneBound -> Bool
Eq, Int -> PlaneBound -> ShowS
[PlaneBound] -> ShowS
PlaneBound -> String
(Int -> PlaneBound -> ShowS)
-> (PlaneBound -> String)
-> ([PlaneBound] -> ShowS)
-> Show PlaneBound
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PlaneBound] -> ShowS
$cshowList :: [PlaneBound] -> ShowS
show :: PlaneBound -> String
$cshow :: PlaneBound -> String
showsPrec :: Int -> PlaneBound -> ShowS
$cshowsPrec :: Int -> PlaneBound -> ShowS
Show)

-- | Extract the width of the bounds

boundWidth :: PlaneBound -> Float
boundWidth :: PlaneBound -> Float
boundWidth (PlaneBound (V2 Float
x0 Float
_) (V2 Float
x1 Float
_)) = Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x0

-- | Extract the height of the bound

boundHeight :: PlaneBound -> Float
boundHeight :: PlaneBound -> Float
boundHeight (PlaneBound (V2 Float
_ Float
y0) (V2 Float
_ Float
y1)) = Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y0

-- | Extract the position of the lower left corner of the

-- bounds.

boundLowerLeftCorner :: PlaneBound -> Point
boundLowerLeftCorner :: PlaneBound -> Point
boundLowerLeftCorner (PlaneBound (V2 Float
x Float
_) (V2 Float
_ Float
y)) = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 Float
x Float
y

instance Semigroup PlaneBound where
  <> :: PlaneBound -> PlaneBound -> PlaneBound
(<>) (PlaneBound Point
mini1 Point
maxi1) (PlaneBound Point
mini2 Point
maxi2) =
    Point -> Point -> PlaneBound
PlaneBound (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float -> Float -> Float) -> Point -> V2 (Float -> Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point
mini1 V2 (Float -> Float) -> Point -> Point
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point
mini2)
               (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float -> Float -> Float) -> Point -> V2 (Float -> Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Point
maxi1 V2 (Float -> Float) -> Point -> Point
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Point
maxi2)

instance Monoid PlaneBound where
  mappend :: PlaneBound -> PlaneBound -> PlaneBound
mappend = PlaneBound -> PlaneBound -> PlaneBound
forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: PlaneBound
mempty = Point -> Point -> PlaneBound
PlaneBound Point
infPoint Point
negInfPoint
    where
      infPoint :: Point
infPoint = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0) (Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0)
      negInfPoint :: Point
negInfPoint = Float -> Float -> Point
forall a. a -> a -> V2 a
V2 (Float -> Float
forall a. Num a => a -> a
negate Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0) (Float -> Float
forall a. Num a => a -> a
negate Float
1 Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
0)

-- | Class used to calculate bounds of various geometrical

-- primitives. The calculated is precise, the bounding should

-- be minimal with respect with drawn curve.

class PlaneBoundable a where
    -- | Given a graphical elements, calculate it's bounds.

    planeBounds :: a -> PlaneBound

instance PlaneBoundable Point where
    planeBounds :: Point -> PlaneBound
planeBounds Point
a = Point -> Point -> PlaneBound
PlaneBound Point
a Point
a

instance PlaneBoundable Line where
    planeBounds :: Line -> PlaneBound
planeBounds (Line Point
p1 Point
p2) = Point -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds Point
p1 PlaneBound -> PlaneBound -> PlaneBound
forall a. Semigroup a => a -> a -> a
<> Point -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds Point
p2

instance PlaneBoundable Bezier where
    planeBounds :: Bezier -> PlaneBound
planeBounds (Bezier Point
p0 Point
p1 Point
p2) =
        CubicBezier -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds (Point -> Point -> Point -> Point -> CubicBezier
CubicBezier Point
p0 Point
p1 Point
p1 Point
p2)

instance PlaneBoundable CubicBezier where
    planeBounds :: CubicBezier -> PlaneBound
planeBounds = (Point -> PlaneBound) -> [Point] -> PlaneBound
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Point -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds ([Point] -> PlaneBound)
-> (CubicBezier -> [Point]) -> CubicBezier -> PlaneBound
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CubicBezier -> [Point]
cubicBezierBounds

instance PlaneBoundable Primitive where
    planeBounds :: Primitive -> PlaneBound
planeBounds (LinePrim Line
l) = Line -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds Line
l
    planeBounds (BezierPrim Bezier
b) = Bezier -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds Bezier
b
    planeBounds (CubicBezierPrim CubicBezier
c) = CubicBezier -> PlaneBound
forall a. PlaneBoundable a => a -> PlaneBound
planeBounds CubicBezier
c