-- | Provide definition for some higher level objects (only slightly)
module Graphics.Rasterific.ComplexPrimitive( rectangle
                                           , roundedRectangle
                                           , circle
                                           , ellipse
                                           ) where

import Control.Applicative( empty, (<|>) )
import Control.Exception( throw, ArithException( .. ) )

import Graphics.Rasterific.Linear( V2( .. ), (^+^), (^*) )
import Graphics.Rasterific.Line
import Graphics.Rasterific.CubicBezier
import Graphics.Rasterific.Types

isCoordValid :: RealFloat a => a -> Maybe ArithException
isCoordValid v
  | isInfinite v = pure Overflow
  | isNaN v || isDenormalized v = pure Denormal
  | otherwise = empty

isPointValid :: RealFloat a => V2 a -> Maybe ArithException
isPointValid (V2 x y) = isCoordValid x <|> isCoordValid y

-- | Generate a list of primitive representing a circle.
--
-- > fill $ circle (V2 100 100) 75
--
-- <<docimages/fill_circle.png>>
--
circle :: Point -- ^ Circle center in pixels
       -> Float -- ^ Circle radius in pixels
       -> [Primitive]
circle p r
  | Just ex <- isCoordValid r <|> isPointValid p = throw ex
circle center radius =
    CubicBezierPrim . transform mv <$> cubicBezierCircle
  where
    mv p = (p ^* radius) ^+^ center

-- | Generate a list of primitive representing an ellipse.
--
-- > fill $ ellipse (V2 100 100) 75 30
--
-- <<docimages/fill_ellipse.png>>
--
ellipse :: Point -> Float -> Float -> [Primitive]
ellipse c rx ry
  | Just ex <- isCoordValid rx <|> isCoordValid ry <|> isPointValid c = throw ex
ellipse center rx ry =
    CubicBezierPrim . transform mv <$> cubicBezierCircle
  where
    mv (V2 x y) = V2 (x * rx) (y * ry) ^+^ center

-- | Generate a list of primitive representing a
-- rectangle
--
-- > fill $ rectangle (V2 30 30) 150 100
--
-- <<docimages/fill_rect.png>>
--
rectangle :: Point -- ^ Corner upper left
          -> Float -- ^ Width in pixel
          -> Float -- ^ Height in pixel
          -> [Primitive]
rectangle p w h
  | Just ex <- isCoordValid w <|> isCoordValid h <|> isPointValid p = throw ex
rectangle p@(V2 px py) w h =
  LinePrim <$> lineFromPath
    [ p, V2 (px + w) py, V2 (px + w) (py + h), V2 px (py + h), p ]

-- | Generate a list of primitive representing a rectangle
-- with rounded corner.
--
-- > fill $ roundedRectangle (V2 10 10) 150 150 20 10
--
-- <<docimages/fill_roundedRectangle.png>>
--
roundedRectangle :: Point -- ^ Corner upper left
                 -> Float -- ^ Width in pixel
                 -> Float -- ^ Height in pixel.
                 -> Float -- ^ Radius along the x axis of the rounded corner. In pixel.
                 -> Float -- ^ Radius along the y axis of the rounded corner. In pixel.
                 -> [Primitive]
roundedRectangle p w h rx ry
  | Just ex <- isCoordValid w
        <|> isCoordValid h
        <|> isCoordValid rx
        <|> isCoordValid ry
        <|> isPointValid p = throw ex
roundedRectangle (V2 px py) w h rx ry =
    [ CubicBezierPrim . transform (^+^ V2 xFar yNear) $ cornerTopR
    , LinePrim $ Line (V2 xFar py) (V2 xNear py)
    , CubicBezierPrim . transform (^+^ V2 (px + rx) (py + ry)) $ cornerTopL
    , LinePrim $ Line (V2 px yNear) (V2 px yFar)
    , CubicBezierPrim . transform (^+^ V2 (px + rx) yFar) $ cornerBottomL
    , LinePrim $ Line (V2 xNear (py + h)) (V2 xFar (py + h))
    , CubicBezierPrim . transform (^+^ V2 xFar yFar) $ cornerBottomR
    , LinePrim $ Line (V2 (px + w) yFar) (V2 (px + w) yNear)
    ]
  where
   xNear = px + rx
   xFar = px + w - rx

   yNear = py + ry
   yFar = py + h - ry

   (cornerBottomR :
    cornerTopR     :
    cornerTopL  :
    cornerBottomL:_) = transform (\(V2 x y) -> V2 (x * rx) (y * ry)) <$> cubicBezierCircle