public
Last active

Offsetting Cubic segments.

  • Download Gist
offsetCubicSegment.hs
Haskell
1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20 21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36 37 38 39 40 41 42 43 44 45 46 47 48 49 50 51 52 53 54 55 56 57 58 59 60 61 62 63 64 65 66 67 68 69 70 71 72 73 74 75 76 77 78 79 80 81 82 83 84 85 86 87 88 89 90 91 92 93 94 95 96 97 98 99 100 101 102 103 104 105 106 107 108 109 110 111 112 113 114 115 116 117 118
{-# LANGUAGE NoMonomorphismRestriction, ViewPatterns #-}
import Diagrams.Prelude
import Diagrams.Backend.Postscript.CmdLine
import Diagrams.Solve
import Diagrams.TwoD.Curvature
 
import Data.Monoid.PosInf
 
 
import qualified Debug.Trace as T
 
-- The basic plan here is to subdivide the segment until we have a reasonable approximation
-- of an arc, we can then scale offset handle lengths by the ratio of radii. This means we
-- also need to approximate the radius of a segment. One possibility for determining the
-- depth of recursion is to produce the offset curve, then compare points at some t-values.
-- If we have recursed far enough the distance between each pair with the same t-value
-- should be r. There should be some good upper bound on the number of points we need to
-- check that follows from both curves being cubic.
--
-- There are some strange corner cases and I'm not sure how bad they are. If there is some
-- sub-curve that we come to that approximates an arc with radius matching the offset radius
-- then we "should" end up with a degenerate sub-curve in the offset. Really we should just
-- skip this segment, but that does mean that the result will not always be C^1 continuous.
-- On the other hand, we can't represent an arc exactly so that may not be precisely the
-- conditions that give us the degenerate curve.
--
offsetCubicSegment :: Double -> Double -> Segment R2 -> (Point R2, Trail R2)
offsetCubicSegment epsilon r s@(Cubic a b c) = (origin .+^ va, Trail (go (radiusOfCurvature s 0.5)) False)
where
-- Perpendiculars to handles.
va = r *^ vperp (0 - a)
vc = r *^ vperp (b - c)
-- Split segments.
ss = (\(a,b) -> [a,b]) $ splitAtParam s 0.5
subdivided = concatMap (trailSegments . snd . offsetCubicSegment epsilon r) ss
 
-- Offset with handles scaled based on curvature.
offset factor = Cubic (a^*factor) ((b - c)^*factor + c + vc - va) (c + vc - va)
 
 
-- We observe a corner. Subdivide right away.
go (Finite 0) = subdivided
-- Some curvrature
go roc
| close = [o]
| otherwise = subdivided
where
-- We want the mulitplicative factor that takes us from the original
-- segment's radius of curvature roc, to roc + r.
--
-- r + sr = x * sr
--
o = offset $ case roc of
PosInfty -> 1
Finite sr -> 1 - r / sr -- TODO: I think my r's are backwards.
 
close = and [epsilon > (magnitude (p o + va - p s - pp s))
-- | t <- [0.01, 0.25, 0.5, 0.75, 0.99]
| t <- [0.25, 0.5, 0.75]
, let p = (`atParam` t)
, let pp = (`perpAtParam` t)
]
 
---------------------------------------------------------------------
 
vperp :: R2 -> R2
vperp v = rotateBy (-1/4) (normalized v)
 
perpAtParam :: Segment R2 -> Double -> R2
perpAtParam s@(Cubic _ _ _) t = vperp (-a)
where
(Cubic a _ _) = snd $ splitAtParam s t
 
fromFixed' :: [FixedSegment R2] -> (Point R2, Trail R2)
fromFixed' [] = (p2 zeroV, Trail [] False) -- ???
fromFixed' (s:ss) = (a, Trail (b : map (snd . rel) ss) False)
where
(a, b) = rel s
 
rel (FLinear a b) = (a, Linear $ b .-. a)
rel (FCubic a b c d) = (a, Cubic (b .-. a) (c .-. a) (d .-. a))
 
---------------------------------------------------------------------
 
showExample :: Segment R2 -> Diagram Postscript R2
showExample s = pad 1.1 . centerXY $ d # lc blue # lw 0.1 <> d' # lw 0.1
where
-- d = stroke $ Path [(origin, Trail [s] False)]
d = mconcat . map (f blue) $ explodeTrail origin (Trail [s] False)
d' = mconcat . zipWith f colors . uncurry explodeTrail $ offsetCubicSegment 0.1 1 s
 
f c p@(Path [(a, Trail [Cubic vb vc vd] False)])
= lw 0.01 (stroke (a ~~ (a .+^ vb)))
<> lw 0.01 (stroke ((a .+^ vc) ~~ (a .+^ vd)))
<> (lc c . stroke $ p)
f c p = lc c . stroke $ p
 
colors = cycle [green, red]
 
showExample' :: Segment R2 -> Diagram Postscript R2
showExample' s = pad 1.1 . centerXY $ d # lc blue # lw 0.1 <> d' # lw 0.1
where
d = stroke $ Path [(origin, Trail [s] False)]
d' = mconcat . zipWith lc colors . map stroke . uncurry explodeTrail $ offsetCubicSegment 0.1 1 s
 
colors = cycle [green, red]
 
----------------------------------------------------------------------
 
example :: Diagram Postscript R2
example = hcat . map showExample' $
[ Cubic (10 & 0) ( 5 & 18) (10 & 20)
, Cubic ( 0 & 20) ( 10 & 10) ( 5 & 10)
, Cubic (10 & 20) ( 0 & 10) (10 & 0)
, Cubic (10 & 20) ((-5) & 10) (10 & 0)
]
 
main = defaultMain example

Please sign in to comment on this gist.

Something went wrong with that request. Please try again.