{-# LANGUAGE TypeFamilies #-} {-# LANGUAGE FlexibleContexts #-} {-# OPTIONS -Wall #-} -------------------------------------------------------------------------------- -- | -- Module : Wumpus.Drawing.Paths.Base.AbsPath -- Copyright : (c) Stephen Tetley 2010-2011 -- License : BSD3 -- -- Maintainer : Stephen Tetley -- Stability : highly unstable -- Portability : GHC -- -- Absolute path type - this should be more amenable for building -- complex drawings than the PrimPath type in Wumpus-Core. -- -------------------------------------------------------------------------------- module Wumpus.Drawing.Paths.Base.AbsPath ( -- * Absolute path type AbsPath , DAbsPath -- * Construction , empty , line1 , curve1 , vertexPath , curvePath , controlCurve -- * Queries , null , length -- * Concat and extension , append , consLineTo , snocLineTo , consCurveTo , snocCurveTo , pathconcat -- * Conversion , toPrimPath , openAbsPath , closedAbsPath -- * Shortening , shortenPath , shortenL , shortenR -- * Tips and direction , tipL , tipR , directionL , directionR -- * Path anchors , midway , midway_ , atstart , atstart_ , atend , atend_ -- * Views , PathViewL(..) , DPathViewL , PathViewR(..) , DPathViewR , PathSegment(..) , DPathSegment , pathViewL , pathViewR , optimizeLines , roundTrail , roundInterior ) where import Wumpus.Basic.Geometry.Base -- package: wumpus-basic import Wumpus.Basic.Kernel import Wumpus.Basic.Utils.JoinList ( JoinList, ViewL(..), viewl , ViewR(..), viewr, cons, snoc, join ) import qualified Wumpus.Basic.Utils.JoinList as JL import Wumpus.Core -- package: wumpus-core import Data.AffineSpace import Data.List ( foldl' ) import qualified Data.Traversable as T import Prelude hiding ( null, length ) -- | Absolute path data type. data AbsPath u = AbsPath { _abs_path_length :: u , _abs_path_start :: Point2 u , _abs_path_elements :: JoinList (AbsPathSeg u) , _abs_path_end :: Point2 u } deriving (Eq,Show) type instance DUnit (AbsPath u) = u type DAbsPath = AbsPath Double -- Annotating each segment with length is \*\* good \*\*. -- Makes it much more efficient to find the midway point. -- -- But what do we do about the start point: -- -- a) put it in the segment - too much info in the type, allows -- consistency problems vis-a-vis gaps in the path. -- -- b) leave it out - too little info in the type, allows -- consistency problems with length. -- -- Option (a) is probably most convenient espcially as the -- constructors won\'t be exported. -- Annotation is length... -- data AbsPathSeg u = AbsLineSeg { _abs_line_length :: u , _abs_line_start :: Point2 u , _abs_line_end :: Point2 u } | AbsCurveSeg { _abs_curve_length :: u , _abs_curve_start :: Point2 u , _abs_ctrl_pt_one :: Point2 u , _abs_ctrl_pt_two :: Point2 u , _abs_curve_end :: Point2 u } deriving (Eq,Show) type instance DUnit (AbsPathSeg u) = u -------------------------------------------------------------------------------- instance Functor AbsPath where fmap f (AbsPath u sp ls ep) = AbsPath (f u) (fmap f sp) (fmap (fmap f) ls) (fmap f ep) instance Functor AbsPathSeg where fmap f (AbsLineSeg u p0 p1) = AbsLineSeg (f u) (fmap f p0) (fmap f p1) fmap f (AbsCurveSeg u p0 p1 p2 p3) = AbsCurveSeg (f u) (fmap f p0) (fmap f p1) (fmap f p2) (fmap f p3) -------------------------------------------------------------------------------- -- TODO - must organize the Path datatype modules so they provide -- Containers-like API functions when appropriate. -------------------------------------------------------------------------------- -- Construction -- | Create the empty path. -- -- Note - an absolute path needs /locating/ and cannot be built -- without a start point. Figuratively, the empty path is a path -- from the start point to the start point. -- -- Thus AbsPath operates as a semigroup but not a monoid. -- empty :: Floating u => Point2 u -> AbsPath u empty = zeroPath -- | Create an absolute path as a straight line between the -- supplied points. -- line1 :: Floating u => Point2 u -> Point2 u -> AbsPath u line1 p0 p1 = AbsPath v p0 (JL.one $ AbsLineSeg v p0 p1) p1 where v = vlength $ pvec p0 p1 -- | Create an absolute path from a single cubic Bezier curve. -- curve1 :: (Floating u, Ord u, Tolerance u) => Point2 u -> Point2 u -> Point2 u -> Point2 u -> AbsPath u curve1 p0 p1 p2 p3 = AbsPath v p0 (JL.one $ AbsCurveSeg v p0 p1 p2 p3) p3 where v = bezierLength (BezierCurve p0 p1 p2 p3) -- | 'vertexPath' throws a runtime error if the supplied list -- is empty. -- vertexPath :: (Floating u, Ord u, Tolerance u) => [Point2 u] -> AbsPath u vertexPath [] = error "traceLinePoints - empty point list." vertexPath [a] = line1 a a vertexPath (a:b:xs) = step (line1 a b) b xs where step acc _ [] = acc step acc e (y:ys) = step (acc `append` line1 e y) y ys -- | 'curvePath' consumes 4 points from the list on the -- intial step (start, control1, control2, end) then steps -- through the list taking 3 points at a time thereafter -- (control1,control2, end). Leftover points are discarded. -- -- 'curvePath' throws a runtime error if the supplied list -- is has less than 4 elements (start, control1, control2, end). -- curvePath :: (Floating u, Ord u, Tolerance u) => [Point2 u] -> AbsPath u curvePath (a:b:c:d:xs) = step (curve1 a b c d) d xs where step acc p0 (x:y:z:zs) = step (acc `append` curve1 p0 x y z) z zs step acc _ _ = acc curvePath _ = error "curvePath - less than 4 elems." -- NOTE - need a proper arc path builder. -- | This is not an arc... -- controlCurve :: (Floating u, Ord u, Tolerance u) => Point2 u -> Radian -> Radian -> Point2 u -> AbsPath u controlCurve start cin cout end = curve1 start (start .+^ v1) (end .+^ v2) end where sz = 0.375 * (vlength $ pvec start end) v1 = avec cin sz v2 = avec cout sz -------------------------------------------------------------------------------- -- Queries -- | Is the path empty? -- null :: AbsPath u -> Bool null = JL.null . _abs_path_elements -- | Length of the Path. -- -- Length is the length of the path as it is drawn, it is not a -- count of the number or path segments. -- -- Length is cached so this operation is cheap - though this puts -- a tax on the build operations. -- length :: Num u => AbsPath u -> u length (AbsPath u _ _ _) = u -------------------------------------------------------------------------------- -- Concat infixr 1 `append` -- | Append two AbsPaths. -- -- If the end of the first path and the start of the second path -- coalesce then the paths are joined directly, otherwise, a -- straight line segment is added to join the paths. -- -- Neither path is /moved/. Consider 'RelPath' if you need -- different concatenation. -- append :: (Floating u, Ord u, Tolerance u) => AbsPath u -> AbsPath u -> AbsPath u append (AbsPath len1 start1 se1 end1) (AbsPath len2 start2 se2 end2) | end1 == start2 = AbsPath (len1+len2) start1 (se1 `join` se2) end2 | otherwise = AbsPath total_len start1 segs end2 where joint = lineSegment end1 start2 total_len = len1 + len2 + segmentLength joint segs = se1 `join` (cons joint se2) -- | Prefix the path with a straight line segment from the -- supplied point. -- consLineTo :: Floating u => Point2 u -> AbsPath u -> AbsPath u consLineTo p0 (AbsPath len1 sp se1 ep) = AbsPath (v+len1) p0 (cons s1 se1) ep where s1@(AbsLineSeg v _ _) = lineSegment p0 sp -- | Suffix the path with a straight line segment to the -- supplied point. -- snocLineTo :: Floating u => AbsPath u -> Point2 u -> AbsPath u snocLineTo (AbsPath len1 sp se1 ep) p1 = AbsPath (len1+v) sp (snoc se1 s1) p1 where s1@(AbsLineSeg v _ _) = lineSegment ep p1 -- | Prefix the path with a Bezier curve segment formed by the -- supplied points. -- consCurveTo :: (Floating u, Ord u, Tolerance u) => Point2 u -> Point2 u -> Point2 u -> AbsPath u -> AbsPath u consCurveTo p0 p1 p2 (AbsPath len1 sp se1 ep) = AbsPath (v+len1) p0 (cons s1 se1) ep where s1@(AbsCurveSeg v _ _ _ _) = curveSegment p0 p1 p2 sp -- | Suffix the path with a Bezier curve segment formed by the -- supplied points. -- snocCurveTo :: (Floating u, Ord u, Tolerance u) => AbsPath u -> Point2 u -> Point2 u -> Point2 u -> AbsPath u snocCurveTo (AbsPath len1 sp se1 ep) p1 p2 p3 = AbsPath (v+len1) sp (snoc se1 s1) p3 where s1@(AbsCurveSeg v _ _ _ _) = curveSegment ep p1 p2 p3 -- | Concat the list of paths onto the intial path. -- -- Because a true empty path cannot be constructed (i.e. the -- /empty/ path needs a start point even if it has no segments) - -- the list is in /destructor form/. Client code has to decide -- how to handle the empty list case, e.g.: -- -- > case paths of -- > (x:xs) -> Just $ pathconcat x xs -- > [] -> Nothing -- -- pathconcat :: (Floating u, Ord u, Tolerance u) => AbsPath u -> [AbsPath u] -> AbsPath u pathconcat p0 ps = foldl' append p0 ps segmentLength :: AbsPathSeg u -> u segmentLength (AbsLineSeg u _ _) = u segmentLength (AbsCurveSeg u _ _ _ _) = u segmentStart :: AbsPathSeg u -> Point2 u segmentStart (AbsLineSeg _ p0 _) = p0 segmentStart (AbsCurveSeg _ p0 _ _ _) = p0 segmentEnd :: AbsPathSeg u -> Point2 u segmentEnd (AbsLineSeg _ _ p1) = p1 segmentEnd (AbsCurveSeg _ _ _ _ p3) = p3 -- | Helper - construct a curve segment. -- lineSegment :: Floating u => Point2 u -> Point2 u -> AbsPathSeg u lineSegment p0 p1 = AbsLineSeg v p0 p1 where v = vlength $ pvec p0 p1 -- | Helper - construct a curve segment. -- curveSegment :: (Floating u, Ord u, Tolerance u) => Point2 u -> Point2 u -> Point2 u -> Point2 u -> AbsPathSeg u curveSegment p0 p1 p2 p3 = AbsCurveSeg v p0 p1 p2 p3 where v = bezierLength (BezierCurve p0 p1 p2 p3) -- | Helper - construct the /empty/ but located path. -- zeroPath :: Floating u => Point2 u -> AbsPath u zeroPath p0 = AbsPath 0 p0 JL.empty p0 openAbsPath :: InterpretUnit u => AbsPath u -> Image u (AbsPath u) openAbsPath rp = replaceAns rp $ zapQuery (toPrimPath rp) >>= dcOpenPath closedAbsPath :: InterpretUnit u => DrawStyle -> AbsPath u -> Image u (AbsPath u) closedAbsPath sty rp = replaceAns rp $ zapQuery (toPrimPath rp) >>= dcClosedPath sty -- | Turn a Path into an ordinary PrimPath. -- -- Assumes path is properly formed - i.e. end point of one -- segment is the same point as the start point of the next -- segment. -- toPrimPath :: InterpretUnit u => AbsPath u -> Query u PrimPath toPrimPath (AbsPath _ start segs _) = uconvertCtxF start >>= \dstart -> T.mapM uconvertCtxF segs >>= \dsegs -> return $ step1 dstart (viewl dsegs) where step1 p0 EmptyL = emptyPrimPath p0 step1 _ (e :< se) = let (p0,a) = seg1 e rest = step2 (viewl se) in absPrimPath p0 (a:rest) step2 EmptyL = [] step2 (e :< se) = seg2 e : step2 (viewl se) seg1 (AbsLineSeg _ p0 p1) = (p0, absLineTo p1) seg1 (AbsCurveSeg _ p0 p1 p2 p3) = (p0, absCurveTo p1 p2 p3) seg2 (AbsLineSeg _ _ p1) = absLineTo p1 seg2 (AbsCurveSeg _ _ p1 p2 p3) = absCurveTo p1 p2 p3 -- | 'sortenPath' : @ left_dist * right_dist * path -> Path @ -- shortenPath :: (Real u , Floating u) => u -> u -> AbsPath u -> AbsPath u shortenPath l r = shortenL l . shortenR r -------------------------------------------------------------------------------- -- shorten from the left... -- | Note - shortening a line from the left by -- greater-than-or-equal its length is operationally equivalent -- to making a zero-length line at the end point. -- shortenL :: (Real u, Floating u) => u -> AbsPath u -> AbsPath u shortenL n (AbsPath u _ segs ep) | n >= u = line1 ep ep | otherwise = step n (viewl segs) where step _ EmptyL = line1 ep ep -- should be unreachable step d (e :< se) = let z = segmentLength e in case compare d z of GT -> step (d-z) (viewl se) EQ -> makeLeftPath (u-n) se ep LT -> let e1 = shortenSegL d e sp = segmentStart e1 in AbsPath (u-n) sp (e1 `cons` se) ep makeLeftPath :: Floating u => u -> JoinList (AbsPathSeg u) -> Point2 u -> AbsPath u makeLeftPath u se ep = case viewl se of EmptyL -> line1 ep ep (e :< _) -> AbsPath u (segmentStart e) se ep shortenSegL :: (Real u, Floating u) => u -> AbsPathSeg u -> AbsPathSeg u shortenSegL n (AbsLineSeg u p0 p1) = AbsLineSeg (u-n) (shortenLineL n p0 p1) p1 shortenSegL n (AbsCurveSeg u p0 p1 p2 p3) = AbsCurveSeg (u-n) q0 q1 q2 q3 where (BezierCurve q0 q1 q2 q3) = snd $ subdividet (n/u) (BezierCurve p0 p1 p2 p3) shortenLineL :: (Real u, Floating u) => u -> Point2 u -> Point2 u -> Point2 u shortenLineL n p0 p1 = p0 .+^ v where v0 = p1 .-. p0 v = avec (vdirection v0) n -------------------------------------------------------------------------------- -- shorten from the right ... -- | Note - shortening a line from the right by -- greater-than-or-equal its length is operationally equivalent -- to making a zero-length line at the start point. -- shortenR :: (Real u, Floating u) => u -> AbsPath u -> AbsPath u shortenR n (AbsPath u sp segs _) | n >= u = line1 sp sp | otherwise = step n (viewr segs) where step _ EmptyR = line1 sp sp -- should be unreachable step d (se :> e) = let z = segmentLength e in case compare d z of GT -> step (d-z) (viewr se) EQ -> makeRightPath n sp se LT -> let e1 = shortenSegR d e ep = segmentEnd e1 in AbsPath (u-n) sp (se `snoc` e1) ep makeRightPath :: Floating u => u -> Point2 u -> JoinList (AbsPathSeg u) -> AbsPath u makeRightPath u sp se = case viewr se of EmptyR -> line1 sp sp (_ :> e) -> AbsPath u sp se (segmentEnd e) shortenSegR :: (Real u, Floating u) => u -> AbsPathSeg u -> AbsPathSeg u shortenSegR n (AbsLineSeg u p0 p1) = AbsLineSeg (u-n) p0 (shortenLineR n p0 p1) shortenSegR n (AbsCurveSeg u p0 p1 p2 p3) = AbsCurveSeg (u-n) q0 q1 q2 q3 where (BezierCurve q0 q1 q2 q3) = fst $ subdividet ((u-n)/u) (BezierCurve p0 p1 p2 p3) shortenLineR :: (Real u, Floating u) => u -> Point2 u -> Point2 u -> Point2 u shortenLineR n p0 p1 = p1 .+^ v where v0 = p0 .-. p1 v = avec (vdirection v0) n -------------------------------------------------------------------------------- -- tips tipL :: AbsPath u -> Point2 u tipL (AbsPath _ sp _ _) = sp tipR :: AbsPath u -> Point2 u tipR (AbsPath _ _ _ ep) = ep -------------------------------------------------------------------------------- -- line direction -- | Direction of empty path is considered to be 0. -- directionL :: (Real u, Floating u) => AbsPath u -> Radian directionL (AbsPath _ _ se _) = step $ viewl se where step (AbsLineSeg _ p0 p1 :< _) = lineDirection p1 p0 -- 1-to-0 step (AbsCurveSeg _ p0 p1 _ _ :< _) = lineDirection p1 p0 step _ = 0 -- should be unreachable -- | Direction of empty path is considered to be 0. -- directionR :: (Real u, Floating u) => AbsPath u -> Radian directionR (AbsPath _ _ se _) = step $ viewr se where step (_ :> AbsLineSeg _ p0 p1) = lineDirection p0 p1 step (_ :> AbsCurveSeg _ _ _ p2 p3) = lineDirection p2 p3 step _ = 0 -- should be unreachable -------------------------------------------------------------------------------- -- Return direction as well because the calculation is expensive... -- midway :: (Real u, Floating u) => AbsPath u -> (Point2 u, Radian) midway pa@(AbsPath u sp _ _) | u == 0 = (sp,0) | otherwise = let pa1 = shortenR (u/2) pa in (tipR pa1, directionR pa1) -- Just the midway point. -- midway_ :: (Real u, Floating u) => AbsPath u -> Point2 u midway_ = fst . midway atstart :: (Real u, Floating u) => AbsPath u -> (Point2 u, Radian) atstart pa@(AbsPath _ sp _ _) = (sp, directionL pa) atstart_ :: AbsPath u -> Point2 u atstart_ (AbsPath _ sp _ _) = sp atend :: (Real u, Floating u) => AbsPath u -> (Point2 u, Radian) atend pa@(AbsPath _ _ _ ep) = (ep, directionR pa) atend_ :: AbsPath u -> Point2 u atend_ (AbsPath _ _ _ ep) = ep -- nearstart, nearend, verynear ... -------------------------------------------------------------------------------- infixr 5 :<< infixl 5 :>> data PathViewL u = PathOneL (PathSegment u) | PathSegment u :<< AbsPath u deriving (Eq,Show) type DPathViewL = PathViewL Double data PathViewR u = PathOneR (PathSegment u) | AbsPath u :>> PathSegment u deriving (Eq,Show) type DPathViewR = PathViewR Double data PathSegment u = LineSeg (Point2 u) (Point2 u) | CurveSeg (Point2 u) (Point2 u) (Point2 u) (Point2 u) deriving (Eq,Show) type DPathSegment = PathSegment Double -------------------------------------------------------------------------------- instance Functor PathSegment where fmap f (LineSeg p0 p1) = LineSeg (fmap f p0) (fmap f p1) fmap f (CurveSeg p0 p1 p2 p3) = CurveSeg (fmap f p0) (fmap f p1) (fmap f p2) (fmap f p3) instance Functor PathViewL where fmap f (PathOneL a) = PathOneL (fmap f a) fmap f (a :<< as) = fmap f a :<< fmap f as instance Functor PathViewR where fmap f (PathOneR a) = PathOneR (fmap f a) fmap f (as :>> a) = fmap f as :>> fmap f a -------------------------------------------------------------------------------- pathViewL :: Num u => AbsPath u -> PathViewL u pathViewL (AbsPath u _ segs ep) = go (viewl segs) where go EmptyL = error "pathViewL - (not) unreachable." go (AbsLineSeg v p0 p1 :< se) | JL.null se = PathOneL (LineSeg p0 p1) | otherwise = LineSeg p0 p1 :<< AbsPath (u-v) p1 se ep go (AbsCurveSeg v p0 p1 p2 p3 :< se) | JL.null se = PathOneL (CurveSeg p0 p1 p2 p3) | otherwise = CurveSeg p0 p1 p2 p3 :<< AbsPath (u-v) p3 se ep pathViewR :: Num u => AbsPath u -> PathViewR u pathViewR (AbsPath u _ segs ep) = go (viewr segs) where go EmptyR = error "pathViewR - (not) unreachable." go (se :> AbsLineSeg v p0 p1) | JL.null se = PathOneR (LineSeg p0 p1) | otherwise = AbsPath (u-v) p1 se ep :>> LineSeg p0 p1 go (se :> AbsCurveSeg v p0 p1 p2 p3) | JL.null se = PathOneR (CurveSeg p0 p1 p2 p3) | otherwise = AbsPath (u-v) p3 se ep :>> CurveSeg p0 p1 p2 p3 -------------------------------------------------------------------------------- -- Path should be same length afterwards. optimizeLines :: (Real u, Floating u, Ord u, Tolerance u) => AbsPath u -> AbsPath u optimizeLines (AbsPath _ sp0 segs _) = outer (zeroPath sp0) (viewl segs) where outer acc (AbsLineSeg _ p0 p1 :< se) = inner acc (vdirection $ pvec p0 p1) p0 p1 (viewl se) outer acc (AbsCurveSeg _ _ p1 p2 p3 :< se) = outer (snocCurveTo acc p1 p2 p3) (viewl se) outer acc EmptyL = acc inner acc d1 sp ep (AbsLineSeg _ p0 p1 :< se) = let d2 = vdirection $ pvec p0 p1 in if (d1 == d2) then inner acc d1 sp p1 (viewl se) else inner (acc `snocLineTo` ep) d2 ep p1 (viewl se) inner acc _ _ ep (AbsCurveSeg _ _ p1 p2 p3 :< se) = let acc1 = snocCurveTo (snocLineTo acc ep) p1 p2 p3 in outer acc1 (viewl se) inner acc _ _ ep EmptyL = acc `snocLineTo` ep -------------------------------------------------------------------------------- -- Round corners -- NOTE - round corners are probably better suited to construction -- rather than transformation. -- -- The code below is pencilled in to change. -- -- | The length of the control-point vector wants to be slighly -- longer than half of /d/ (d - being the distance between the -- /truncated/ points and the corner). -- cornerCurve :: (Real u, Floating u, Tolerance u) => Point2 u -> Point2 u -> Point2 u -> AbsPath u cornerCurve p1 p2 p3 = curve1 p1 cp1 cp2 p3 where len1 = 0.6 * (vlength $ pvec p1 p2) len2 = 0.6 * (vlength $ pvec p3 p2) cp1 = p1 .+^ (avec (lineAngle p1 p2) len1) cp2 = p3 .+^ (avec (lineAngle p3 p2) len2) -- | 'roundTrail' : @ rounding_distance * [point] -> Path @ -- -- Build a path from the list of vertices, all the interior -- corners are rounded by the rounding distance \*and\* final -- round corner is created \"incorporating\" the start point (as -- the start point becomes a rounded corner the actual path will -- not intersect it). -- -- It is expected that this function will be used to create round -- cornered shapes. -- -- 'roundTrail' throws a runtime error if the input list is empty. -- If the list has one element /the null path/ is built, if the -- list has two elements a straight line is built. -- roundTrail :: (Real u, Floating u, Tolerance u) => u -> [Point2 u] -> AbsPath u roundTrail _ [] = error "roundTrail - empty list." roundTrail _ [a] = zeroPath a roundTrail _ [a,b] = line1 a b roundTrail u (start:b:c:xs) = step (lineCurveTrail u start b c) (b:c:xs) where step acc (m:n:o:ps) = step (acc `append` lineCurveTrail u m n o) (n:o:ps) step acc [n,o] = acc `append` lineCurveTrail u n o start `append` lineCurveTrail u o start b step acc _ = acc -- | Two parts - line and corner curve... -- -- Note - the starting point is moved, this function is for -- closed, rounded paths. -- lineCurveTrail :: (Real u, Floating u, Tolerance u) => u -> Point2 u -> Point2 u -> Point2 u -> AbsPath u lineCurveTrail u a b c = line1 p1 p2 `append` cornerCurve p2 b p3 where p1 = a .+^ (avec (vdirection $ pvec a b) u) p2 = b .+^ (avec (vdirection $ pvec b a) u) p3 = b .+^ (avec (vdirection $ pvec b c) u) -- | 'roundInterior' : @ rounding_distance * [point] -> Path @ -- -- Build a path from the list of vertices, all the interior -- corners are rounded by the rounding distance. Unlike -- 'roundTrail' there is no /loop around/ to the start point, -- and start path will begin exactly on the start point and end -- exactly on the end point. -- -- 'roundInterior' throws a runtime error if the input list is -- empty. If the list has one element /the null path/ is built, -- if the list has two elements a straight line is built. -- roundInterior :: (Real u, Floating u, Tolerance u) => u -> [Point2 u] -> AbsPath u roundInterior _ [] = error "roundEveryInterior - empty list." roundInterior _ [a] = zeroPath a roundInterior _ [a,b] = line1 a b roundInterior u (start:b:c:xs) = let (path1,p1) = lineCurveInter1 u start b c in step path1 (p1:c:xs) where step acc (m:n:o:ps) = let (seg2,p1) = lineCurveInter1 u m n o in step (acc `append` seg2) (p1:o:ps) step acc [n,o] = acc `append` line1 n o step acc _ = acc -- | Two parts - line and corner curve... -- -- Note - draws a straight line from the starting point - this is -- the first step of an interior (non-closed) rounded path -- lineCurveInter1 :: (Real u, Floating u, Tolerance u) => u -> Point2 u -> Point2 u -> Point2 u -> (AbsPath u, Point2 u) lineCurveInter1 u a b c = (line1 a p2 `append` cornerCurve p2 b p3, p3) where p2 = b .+^ (avec (vdirection $ pvec b a) u) p3 = b .+^ (avec (vdirection $ pvec b c) u)