module Wumpus.Drawing.Shapes.Ellipse
(
Ellipse
, DEllipse
, ellipse
) where
import Wumpus.Drawing.Paths
import Wumpus.Drawing.Shapes.Base
import Wumpus.Basic.Kernel
import Wumpus.Core
import Control.Applicative
data Ellipse u = Ellipse
{ ell_ctm :: ShapeCTM u
, ell_rx :: !u
, ell_ry :: !u
}
type DEllipse = Ellipse Double
type instance DUnit (Ellipse u) = u
mapEllipseCTM :: (ShapeCTM u -> ShapeCTM u) -> Ellipse u -> Ellipse u
mapEllipseCTM f = (\s i -> s { ell_ctm = f i }) <*> ell_ctm
instance Num u => Scale (Ellipse u) where
scale sx sy = mapEllipseCTM (scale sx sy)
instance Rotate (Ellipse u) where
rotate ang = mapEllipseCTM (rotate ang)
instance (Real u, Floating u) => RotateAbout (Ellipse u) where
rotateAbout ang pt = mapEllipseCTM (rotateAbout ang pt)
instance Num u => Translate (Ellipse u) where
translate dx dy = mapEllipseCTM (translate dx dy)
runDisplaceCenter :: (Real u, Floating u)
=> (u -> u -> Vec2 u) -> Ellipse u -> Point2 u
runDisplaceCenter fn (Ellipse { ell_ctm = ctm
, ell_rx = rx
, ell_ry = ry }) =
displaceCenter (fn rx ry) ctm
scaleEll :: (Scale t, Fractional u, u ~ DUnit t) => u -> u -> t -> t
scaleEll rx ry = scale 1 (ry/rx)
instance (Real u, Floating u) => CenterAnchor (Ellipse u) where
center = runDisplaceCenter $ \_ _ -> V2 0 0
instance (Real u, Floating u) => RadialAnchor (Ellipse u) where
radialAnchor theta = runDisplaceCenter $ \rx ry ->
scaleEll rx ry $ avec theta rx
instance (Real u, Floating u) => CardinalAnchor (Ellipse u) where
north = radialAnchor (0.5*pi)
south = radialAnchor (1.5*pi)
east = radialAnchor 0
west = radialAnchor pi
instance (Real u, Floating u) => CardinalAnchor2 (Ellipse u) where
northeast = radialAnchor (0.25*pi)
southeast = radialAnchor (1.75*pi)
southwest = radialAnchor (1.25*pi)
northwest = radialAnchor (0.75*pi)
ellipse :: (Real u, Floating u, FromPtSize u, Ord u)
=> u -> u -> Shape u (Ellipse u)
ellipse rx ry = makeShape (mkEllipse rx ry) (mkEllipsePath rx ry)
mkEllipse :: Num u => u -> u -> LocThetaCF u (Ellipse u)
mkEllipse rx ry = promoteR2 $ \ctr theta ->
pure $ Ellipse { ell_ctm = makeShapeCTM ctr theta
, ell_rx = rx
, ell_ry = ry
}
mkEllipsePath :: (Real u, Floating u, FromPtSize u, Ord u)
=> u -> u -> LocThetaCF u (Path u)
mkEllipsePath rx ry = promoteR2 $ \pt theta ->
pure $ traceCurvePoints $ map (rotateAbout theta pt)
$ bezierEllipse rx ry pt