module Wumpus.Drawing.Shapes.Circle
(
Circle
, DCircle
, circle
) where
import Wumpus.Drawing.Paths.Absolute
import Wumpus.Drawing.Shapes.Base
import Wumpus.Basic.Kernel
import Wumpus.Core
import Control.Applicative
data Circle u = Circle
{ circ_ctm :: ShapeCTM u
, circ_radius :: !u
}
type instance DUnit (Circle u) = u
type DCircle = Circle Double
instance Functor Circle where
fmap f (Circle ctm r) = Circle (fmap f ctm) (f r)
mapCTM :: (ShapeCTM u -> ShapeCTM u) -> Circle u -> Circle u
mapCTM f = (\s i -> s { circ_ctm = f i }) <*> circ_ctm
instance (Real u, Floating u) => Rotate (Circle u) where
rotate ang = mapCTM (rotate ang)
instance (Real u, Floating u) => RotateAbout (Circle u) where
rotateAbout ang pt = mapCTM (rotateAbout ang pt)
instance Fractional u => Scale (Circle u) where
scale sx sy = mapCTM (scale sx sy)
instance Num u => Translate (Circle u) where
translate dx dy = mapCTM (translate dx dy)
runDisplaceCenter :: (Real u, Floating u)
=> (u -> Vec2 u) -> Circle u -> Anchor u
runDisplaceCenter fn (Circle { circ_ctm = ctm
, circ_radius = radius }) =
projectFromCtr (fn radius) ctm
instance (Real u, Floating u) => CenterAnchor (Circle u) where
center = runDisplaceCenter $ \_ -> V2 0 0
instance (Real u, Floating u) => CardinalAnchor (Circle u) where
north = runDisplaceCenter $ \r -> V2 0 r
south = runDisplaceCenter $ \r -> V2 0 (r)
east = runDisplaceCenter $ \r -> V2 r 0
west = runDisplaceCenter $ \r -> V2 (r) 0
instance (Real u, Floating u) => CardinalAnchor2 (Circle u) where
northeast = radialAnchor (0.25*pi)
southeast = radialAnchor (1.75*pi)
southwest = radialAnchor (1.25*pi)
northwest = radialAnchor (0.75*pi)
instance (Real u, Floating u) => RadialAnchor (Circle u) where
radialAnchor ang = runDisplaceCenter $ \r -> avec ang r
circle :: (Real u, Floating u, InterpretUnit u, Tolerance u)
=> u -> Shape Circle u
circle radius = makeShape (mkCircle radius) (mkCirclePath radius)
mkCircle :: InterpretUnit u => u -> LocThetaQuery u (Circle u)
mkCircle radius = qpromoteLocTheta $ \ctr theta ->
pure $ Circle { circ_ctm = makeShapeCTM ctr theta
, circ_radius = radius
}
mkCirclePath :: (Floating u, Ord u, InterpretUnit u, Tolerance u)
=> u -> LocThetaQuery u (AbsPath u)
mkCirclePath radius = qpromoteLocTheta $ \ctr _ ->
pure $ curvePath $ bezierCircle radius ctr