module Wumpus.Drawing.Basis.DrawingPrimitives
(
(<>)
, hline
, vline
, pivotLine
, oStraightLines
, cStraightLines
, blRectangle
, ctrRectangle
, arc
, wedge
)
where
import Wumpus.Basic.Geometry
import Wumpus.Basic.Kernel
import Wumpus.Core
import Data.AffineSpace
import Data.Monoid
infixr 6 <>
(<>) :: Monoid a => a -> a -> a
(<>) = mappend
vline :: InterpretUnit u => u -> LocGraphic u
vline len = locStraightLine $ vvec len
hline :: InterpretUnit u => u -> LocGraphic u
hline len = locStraightLine $ hvec len
pivotLine :: (Floating u, InterpretUnit u) => u -> u -> Radian -> LocGraphic u
pivotLine lu ru ang = promoteLoc $ \pt ->
straightLine (pt .+^ avec (ang+pi) lu) (pt .+^ avec ang ru)
oStraightLines :: InterpretUnit u => [Point2 u] -> Graphic u
oStraightLines ps = liftQuery (vertexPP ps) >>= dcOpenPath
cStraightLines :: InterpretUnit u => DrawStyle -> [Point2 u] -> Graphic u
cStraightLines sty ps = liftQuery (vertexPP ps) >>= dcClosedPath sty
blRectangle :: InterpretUnit u => DrawStyle -> u -> u -> LocGraphic u
blRectangle = dcRectangle
ctrRectangle :: (Fractional u, InterpretUnit u)
=> DrawStyle -> u -> u -> LocGraphic u
ctrRectangle sty w h =
moveStart (vec (hw) (hh)) $ dcRectangle sty w h
where
hw = 0.5 * w
hh = 0.5 * h
arc :: (Floating u, InterpretUnit u) => u -> Radian -> LocThetaGraphic u
arc radius ang = promoteLocTheta $ \pt inclin ->
let ps = bezierArcPoints ang radius inclin pt
in liftQuery (curvePP ps) >>= dcOpenPath
wedge :: (Floating u, InterpretUnit u)
=> DrawStyle -> u -> Radian -> LocThetaGraphic u
wedge sty radius ang = promoteLocTheta $ \pt inclin ->
let ps = bezierArcPoints ang radius inclin pt
in uconvertCtxF pt >>= \dpt ->
mapM uconvertCtxF ps >>= \dps ->
dcClosedPath sty (build dpt dps)
where
build :: DPoint2 -> [DPoint2] -> PrimPath
build pt [] = emptyPrimPath pt
build pt (p1:ps) = let cs = curves ps
in absPrimPath pt (absLineTo p1 : cs)
curves (a:b:c:ps) = absCurveTo a b c : curves ps
curves _ = []