module Wumpus.Drawing.Shapes.Base
(
LocShape
, intoLocShape
, strokedShape
, filledShape
, borderedShape
, roundCornerShapePath
, ShapeCTM
, makeShapeCTM
, ctmCenter
, ctmAngle
, projectPoint
) where
import Wumpus.Basic.Kernel
import Wumpus.Drawing.Paths
import Wumpus.Core
import Control.Applicative
type LocShape u a = LocCF u (a, Path u)
intoLocShape :: LocCF u a -> LocCF u (Path u) -> LocCF u (a,Path u)
intoLocShape = liftA2 (,)
strokedShape :: Num u => LocShape u a -> LocImage u a
strokedShape mf =
promoteR1 $ \pt ->
(mf `at` pt) >>= \(a,spath) ->
intoImage (pure a) (closedStroke $ toPrimPath spath)
filledShape :: Num u => LocShape u a -> LocImage u a
filledShape mf =
promoteR1 $ \pt ->
(mf `at` pt) >>= \(a,spath) ->
intoImage (pure a) (filledPath $ toPrimPath spath)
borderedShape :: Num u => LocShape u a -> LocImage u a
borderedShape mf =
promoteR1 $ \pt ->
(mf `at` pt) >>= \(a,spath) ->
intoImage (pure a) (borderedPath $ toPrimPath spath)
roundCornerShapePath :: (Real u, Floating u, FromPtSize u)
=> [Point2 u] -> CF (Path u)
roundCornerShapePath xs = getRoundCornerSize >>= \sz ->
if sz == 0 then return (traceLinePoints xs)
else return (roundTrail sz xs)
data ShapeCTM u = ShapeCTM
{ ctm_center :: Point2 u
, ctm_scale_x :: !u
, ctm_scale_y :: !u
, ctm_rotation :: Radian
}
deriving (Eq,Ord,Show)
type instance DUnit (ShapeCTM u) = u
makeShapeCTM :: Num u => Point2 u -> ShapeCTM u
makeShapeCTM pt = ShapeCTM { ctm_center = pt
, ctm_scale_x = 1
, ctm_scale_y = 1
, ctm_rotation = 0 }
instance Num u => Scale (ShapeCTM u) where
scale sx sy = (\s x y -> s { ctm_scale_x = x*sx, ctm_scale_y = y*sy })
<*> ctm_scale_x <*> ctm_scale_y
instance Rotate (ShapeCTM u) where
rotate ang = (\s i -> s { ctm_rotation = circularModulo $ i+ang })
<*> ctm_rotation
instance (Real u, Floating u) => RotateAbout (ShapeCTM u) where
rotateAbout ang pt =
(\s ctr i -> s { ctm_rotation = circularModulo $ i+ang
, ctm_center = rotateAbout ang pt ctr })
<*> ctm_center <*> ctm_rotation
instance Num u => Translate (ShapeCTM u) where
translate dx dy = (\s (P2 x y) -> s { ctm_center = P2 (x+dx) (y+dy) })
<*> ctm_center
ctmCenter :: ShapeCTM u -> Point2 u
ctmCenter = ctm_center
ctmAngle :: ShapeCTM u -> Radian
ctmAngle = ctm_rotation
projectPoint :: (Real u, Floating u) => Point2 u -> ShapeCTM u -> Point2 u
projectPoint (P2 x y) (ShapeCTM { ctm_center = (P2 dx dy)
, ctm_scale_x = sx
, ctm_scale_y = sy
, ctm_rotation = theta }) =
translate dx dy $ rotate theta $ P2 (sx*x) (sy*y)