module Wumpus.Drawing.Basis.DrawingPrimitives
(
(<>)
, horizontalLine
, verticalLine
, 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
verticalLine :: InterpretUnit u => u -> LocGraphic u
verticalLine len = locStraightLine $ vvec len
horizontalLine :: InterpretUnit u => u -> LocGraphic u
horizontalLine 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 => DrawMode -> [Point2 u] -> Graphic u
cStraightLines mode ps = liftQuery (vertexPP ps) >>= dcClosedPath mode
blRectangle :: InterpretUnit u => DrawMode -> u -> u -> LocGraphic u
blRectangle = dcRectangle
ctrRectangle :: (Fractional u, InterpretUnit u)
=> DrawMode -> u -> u -> LocGraphic u
ctrRectangle mode w h =
moveStart (vec (hw) (hh)) $ dcRectangle mode 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 :: (Real u, Floating u, InterpretUnit u)
=> DrawMode -> u -> Radian -> LocThetaGraphic u
wedge mode radius ang = promoteLocTheta $ \pt inclin ->
let half_ang = 0.5 * ang
line_in = catline $ avec (inclin + half_ang) radius
line_out = catline $ avec (inclin half_ang) (radius)
w_arc = circularArcCW ang radius (inclin half_pi)
ct = line_in `mappend` w_arc `mappend` line_out
in supplyLoc pt $ drawCatTrail (closedMode mode) ct