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
circle :: Point
-> Float
-> [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
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
rectangle :: Point
-> Float
-> Float
-> [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 ]
roundedRectangle :: Point
-> Float
-> Float
-> Float
-> Float
-> [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