<> <> <> <> DIRECTORY Basics, IIBox, II USING [StrokeEnd, StrokeJoint], IIPath USING [ArcToConics, ArcToProc, ConicToCurves, ConicToProc, CurveToProc, LineToProc, MoveToProc, PathProc, Transform], IIPen USING [MakeTransformedCircle, Pen], IITransformation, IIStroke USING [], Real USING [FScale, LargestNumber, RealException, TrappingNaN], RealFns USING [SqRt], RuntimeError USING [InformationalSignal], Vector2 USING [Add, Cross, Dot, Length, Mul, Neg, Square, Sub, VEC]; IIStrokeImpl: CEDAR PROGRAM IMPORTS Basics, IIPath, IIPen, IITransformation, Real, RealFns, RuntimeError, Vector2 EXPORTS IIStroke ~ BEGIN maxReal: REAL ~ Real.LargestNumber; VEC: TYPE ~ Vector2.VEC; Pen: TYPE ~ IIPen.Pen; PathProc: TYPE ~ IIPath.PathProc; MoveToProc: TYPE ~ IIPath.MoveToProc; LineToProc: TYPE ~ IIPath.LineToProc; ConicToProc: TYPE ~ IIPath.ConicToProc; CurveToProc: TYPE ~ IIPath.CurveToProc; ArcToProc: TYPE ~ IIPath.ArcToProc; Transformation: TYPE ~ IITransformation.Transformation; VertexIndex: TYPE ~ NAT; Bezier: TYPE ~ ARRAY [0..4) OF VEC; Add: PROC [v1, v2: VEC] RETURNS [VEC] ~ INLINE { RETURN[[v1.x+v2.x, v1.y+v2.y]] }; Sub: PROC [v1, v2: VEC] RETURNS [VEC] ~ INLINE { RETURN[[v1.x-v2.x, v1.y-v2.y]] }; Half: PROC [r: REAL] RETURNS [REAL] ~ INLINE { RETURN [Real.FScale[r, -1]] }; Mid: PROC [p, q: VEC] RETURNS [VEC] ~ INLINE { RETURN [[Half[p.x+q.x], Half[p.y+q.y]]] }; non: VEC ~ [Real.TrappingNaN, Real.TrappingNaN]; Eq: PROC [a, b: VEC] RETURNS [BOOL] ~ --INLINE-- {RETURN [a.x=b.x AND a.y=b.y]}; <> AddMod: PROC [a, b: NAT, mod: NAT] RETURNS [c: NAT] ~ INLINE { IF (c _ a + b) >= mod THEN c _ c - mod; }; FindVertex: PROC [pen: Pen, direction: VEC, i: NAT _ 0] RETURNS [NAT] ~ { <> penSize: NAT ~ pen.size; penSizeLess1: NAT ~ penSize-1; DO prv: NAT ~ IF i = 0 THEN penSizeLess1 ELSE i - 1; dotPrv: REAL ~ Vector2.Dot[direction, Sub[pen[prv], pen[i]]]; IF dotPrv > 0 THEN i _ prv ELSE EXIT ENDLOOP; DO nxt: NAT ~ IF i = penSizeLess1 THEN 0 ELSE i + 1; dotNxt: REAL ~ Vector2.Dot[direction, Sub[pen[nxt], pen[i]]]; IF dotNxt > 0 THEN i _ nxt ELSE EXIT ENDLOOP; RETURN [i] }; State: TYPE ~ RECORD [ p: VEC _ non, -- position v: VEC _ non, -- velocity left: NAT _ NAT.LAST, -- index of active pen vertex to the left right: NAT _ NAT.LAST -- index of active pen vertex to the right ]; Reverse: PROC [state: State] RETURNS [State] ~ --INLINE-- { t: NAT _ state.left; state.left _ state.right; state.right _ t; state.v _ [-state.v.x, -state.v.y]; RETURN [state]; }; PenBB: PROC [pen: IIPen.Pen] RETURNS [IIBox.Box] ~ --INLINE-- { box: IIBox.Box _ [xmin: maxReal, ymin: maxReal, xmax: -maxReal, ymax: -maxReal]; FOR i: NAT IN [0..pen.size) DO p: VEC ~ pen[i]; IF p.x < box.xmin THEN box.xmin _ p.x; IF p.x > box.xmax THEN box.xmax _ p.x; IF p.y < box.ymin THEN box.ymin _ p.y; IF p.y > box.ymax THEN box.ymax _ p.y; ENDLOOP; RETURN [box]; }; ExtendBB: PROC [b0, b1: IIBox.Box] RETURNS [IIBox.Box] ~ --INLINE-- { RETURN [[xmin: b0.xmin+b1.xmin, xmax: b0.xmax+b1.xmax, ymin: b0.ymin+b1.ymin, ymax: b0.ymax+b1.ymax]] }; BezierParabola: TYPE ~ ARRAY [0..3) OF VEC; SubDivideParabola: PROC [b: BezierParabola, t: REAL] RETURNS [low, high: BezierParabola] ~ { s: REAL ~ 1-t; Interpolate: PROC [a, b: VEC] RETURNS [VEC] ~ { RETURN [[a.x*s+b.x*t, a.y*s+b.y*t]] }; q1 : VEC ~ Interpolate[b[0], b[1]]; q2: VEC ~ Interpolate[b[1], b[2]]; qp1: VEC ~ Interpolate[q1, q2]; low _ [b[0], q1, qp1]; high _ [qp1, q2, b[2]]; }; TraverseParabola: PROC [pen: Pen, p: BezierParabola, vertex, endVertex: VertexIndex, lineTo: LineToProc, conicTo: IIPath.ConicToProc] ~ { penSize: NAT ~ pen.size; max: NAT ~ penSize-1; Forw: PROC [v: NAT] RETURNS [NAT] ~ INLINE {RETURN [IF v = max THEN 0 ELSE v + 1]}; Back: PROC [v: NAT] RETURNS [NAT] ~ INLINE {RETURN [IF v = 0 THEN max ELSE v - 1]}; delta0: VEC ~ Sub[p[1], p[0]]; delta1: VEC ~ Sub[p[2], p[1]]; offset: VEC _ pen[vertex]; t: REAL _ 0.0; b: BezierParabola _ p; turnRight: BOOLEAN ~ Vector2.Cross[delta0, delta1] < 0; UNTIL vertex = endVertex DO nextVertex: NAT ~ IF turnRight THEN Back[vertex] ELSE Forw[vertex]; nextDirection: VEC ~ Sub[pen[nextVertex], offset]; d0: REAL ~ Vector2.Cross[delta0, nextDirection]; d1: REAL ~ Vector2.Cross[delta1, nextDirection]; r: REAL ~ IF d0 = d1 THEN 1.0 ELSE d0/(d0-d1); newT: REAL ~ IF r < t OR r > 1.0 THEN 1.0 ELSE r; b0, b1: BezierParabola; [b0, b1] _ SubDivideParabola[b, (newT-t)/(1.0-t)]; conicTo[Add[b0[1], offset], Add[b0[2], offset], 0.5]; vertex _ nextVertex; offset _ pen[vertex]; lineTo[Add[b1[0], offset]]; b _ b1; t _ newT; ENDLOOP; IF b[0]#b[1] OR b[1]#b[2] THEN conicTo[Add[b[1], offset], Add[b[2], offset], 0.5]; }; ExternalHalfPlane: TYPE ~ {xLo, xHi, yLo, yHi}; Region: TYPE ~ PACKED ARRAY ExternalHalfPlane OF BOOL; Intersect: PROC [a, b: Region] RETURNS [Region] ~ --INLINE-- { <> RETURN [LOOPHOLE[Basics.BITAND[LOOPHOLE[a], LOOPHOLE[b]]]]; }; curveTolerance: REAL _ 1.0; PenStroke: PUBLIC PROC [path: IIPath.PathProc, pen: IIPen.Pen, closed: BOOL, moveTo: IIPath.MoveToProc, lineTo: IIPath.LineToProc, conicTo: IIPath.ConicToProc, end: PROC [p: VEC, v: VEC, i0, i1: VertexIndex], joint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex], box: IIBox.Box, cull: BOOL ] ~ { <> bb: IIBox.Box ~ ExtendBB[PenBB[pen], box]; RegionOf: PROC [p: VEC] RETURNS [Region] ~ { RETURN [[xLo: p.x < bb.xmin, xHi: p.x > bb.xmax, yLo: p.y < bb.ymin, yHi: p.y > bb.ymax]] }; where: {nowhere, firstpoint, normal} _ nowhere; first: State _ []; last: State _ []; Joint: PROC [s0, s1: State] ~ INLINE { joint[s0.p, s0.v, s1.v, s0.right, s1.right] }; Finish: PROC ~ { SELECT where FROM nowhere => NULL; firstpoint => { moveTo[Add[last.p, pen[last.right]]]; end[last.p, [-last.v.x, -last.v.y], last.right, last.left]; end[last.p, last.v, last.left, last.right]; }; ENDCASE => { IF closed THEN { Line[first.p]; SELECT Vector2.Cross[last.v, first.v] FROM > 0 => { moveTo[Add[last.p, pen[last.right]]]; Joint[last, first]; lineTo[Add[last.p, pen[last.left]]]; }; < 0 => { moveTo[Add[last.p, pen[first.left]]]; Joint[Reverse[first], Reverse[last]]; lineTo[Add[last.p, pen[first.right]]]; }; ENDCASE => { <> moveTo[Add[last.p, pen[0]]]; FOR i: VertexIndex IN (0..pen.size) DO lineTo[Add[last.p, pen[i]]]; ENDLOOP; }; } ELSE { moveTo[Add[last.p, pen[last.right]]]; end[last.p, last.v, last.right, last.left]; }; }; where _ nowhere; last.p _ non; }; Move: PROC [p: VEC] ~ { Finish[]; last _ [p, [0, 0], 0, pen.size/2]; where _ firstpoint; }; RoundJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ~ { UNTIL i0 = i1 DO i0 _ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; depth: NAT _ 0; -- keeps track of recursion depth for Conic and Curve inCurve: BOOL _ FALSE; -- used to prevent mitering inside of curves Parabola: PROC [p1, p2: VEC] ~ { <> join: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ~ IF inCurve THEN RoundJoint ELSE joint; p0: VEC ~ last.p; isLine: BOOL ~ Eq[p1, p2] OR Eq[p0, p1]; v0: VEC ~ Sub[IF isLine THEN p2 ELSE p1, p0]; v2: VEC ~ IF isLine THEN v0 ELSE Sub[p2, p1]; IF NOT (isLine AND Eq[p0, p2]) THEN { left: VertexIndex ~ FindVertex[pen, [-v0.y, v0.x], last.left]; right: VertexIndex ~ FindVertex[pen, [v0.y, -v0.x], last.right]; newLeft: VertexIndex ~ IF isLine THEN left ELSE FindVertex[pen, [-v2.y, v2.x], left]; newRight: VertexIndex ~ IF isLine THEN right ELSE FindVertex[pen, [v2.y, -v2.x], right]; jointFirst: BOOL ~ Vector2.Cross[last.v, v0] > 0; IF where = normal AND jointFirst THEN { moveTo[Add[p0, pen[last.right]]]; IF last.right # right THEN join[p0, last.v, v0, last.right, right]; } ELSE moveTo[Add[p0, pen[right]]]; IF isLine THEN lineTo[Add[p2, pen[newRight]]] ELSE TraverseParabola[pen, [p0, p1, p2], right, newRight, lineTo, conicTo]; lineTo[Add[p2, pen[newLeft]]]; IF isLine THEN lineTo[Add[p0, pen[left]]] ELSE TraverseParabola[pen, [p2, p1, p0], newLeft, left, lineTo, conicTo]; IF where = normal AND NOT jointFirst THEN { join[p0, [-v0.x, -v0.y], [-last.v.x, -last.v.y], left, last.left]; }; IF where = firstpoint THEN { IF closed THEN first _ [p: p0, v: v0, left: left, right: right] ELSE end[p0, [-v0.x, -v0.y], left, right]; }; last _ [p: p2, v: v2, left: newLeft, right: newRight]; where _ normal; IF depth # 0 THEN inCurve _ TRUE; }; }; Line: PROC [p1: VEC] ~ { IF Eq[p1, last.p] OR ((NOT closed AND where # firstpoint) AND cull AND Intersect[RegionOf[last.p], RegionOf[p1]] # ALL[FALSE]) THEN { last.p _ p1; RETURN }; Parabola[p1, p1]; }; Conic: ConicToProc ~ { p0: VEC ~ last.p; OutsideOfBB: PROC RETURNS [BOOL] ~ INLINE { r: Region _ Intersect[RegionOf[p0], RegionOf[p2]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; r _ Intersect[r, RegionOf[p1]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; RETURN [TRUE]; }; depth _ depth + 1; IF OutsideOfBB[] THEN { Line[p1]; Line[p2] } ELSE { SELECT r FROM > 0.9999 => { Line[p1]; Line[p2] }; <= 0.0 => { Line[p2] }; ENDCASE => { p02: VEC ~ Mid[p0, p2]; m: VEC ~ [p1.x-p02.x, p1.y-p02.y]; IF (ABS[m.x]+ABS[m.y])*ABS[r-0.5] < curveTolerance THEN { Parabola[p1, p2] } ELSE { q: VEC ~ [m.x*r+p02.x, m.y*r+p02.y]; rNew: REAL ~ 1.0/(1.0+RealFns.SqRt[2.0*(1-r)]); Conic[[(p1.x-p0.x)*r+p0.x, (p1.y-p0.y)*r+p0.y], q, rNew]; Conic[[(p1.x-p2.x)*r+p2.x, (p1.y-p2.y)*r+p2.y], p2, rNew]; }; }; }; depth _ depth - 1; IF depth = 0 THEN inCurve _ FALSE; }; firstHalf: BOOL _ FALSE; Curve: CurveToProc ~ { p0: VEC ~ last.p; OutsideOfBB: PROC RETURNS [BOOL] ~ INLINE { r: Region _ Intersect[RegionOf[p0], RegionOf[p3]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; r _ Intersect[r, RegionOf[p1]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; r _ Intersect[r, RegionOf[p2]]; IF r = ALL[FALSE] THEN RETURN [FALSE]; RETURN [TRUE]; }; IF depth = 0 THEN firstHalf _ TRUE; depth _ depth + 1; IF OutsideOfBB[] THEN { Line[p1]; Line[p2]; Line[p3] } ELSE { R: PROC [p, q: REAL] RETURNS [REAL] ~ INLINE { RETURN [q + Half[q-p]] }; Ext: PROC [p, q: VEC] RETURNS [VEC] ~ INLINE { RETURN [[R[p.x, q.x], R[p.y, q.y]]] }; q1: VEC ~ Ext[p0, p1]; q2: VEC ~ Ext[p3, p2]; error: REAL ~ ABS[q1.x-q2.x]+ABS[q1.y-q2.y]; IF (depth=0 AND error=0.0) OR (error < curveTolerance) THEN { Parabola[IF firstHalf THEN q1 ELSE q2, p3] } ELSE { p01: VEC ~ Mid[p0, p1]; p12: VEC ~ Mid[p1, p2]; p23: VEC ~ Mid[p2, p3]; p012: VEC ~ Mid[p01, p12]; p123: VEC ~ Mid[p12, p23]; p0123: VEC ~ Mid[p012, p123]; Curve[p01, p012, p0123]; IF depth = 1 THEN firstHalf _ FALSE; Curve[p123, p23, p3]; }; }; depth _ depth - 1; IF depth = 0 THEN inCurve _ FALSE; }; Arc: ArcToProc ~ {IIPath.ArcToConics[last.p, p1, p2, Conic]}; path[Move, Line, Curve, Conic, Arc]; Finish[]; }; verySmallNumber: REAL _ Real.FScale[1, -20]; SquareEndWithNoDirection: PUBLIC SIGNAL ~ CODE; PathFromStroke: PUBLIC PROC [path: IIPath.PathProc, closed: BOOL, width: REAL, end: INT, joint: INT, m: IITransformation.Transformation, moveTo: IIPath.MoveToProc, lineTo: IIPath.LineToProc, conicTo: IIPath.ConicToProc, box: IIBox.Box] ~ { pen: Pen ~ IIPen.MakeTransformedCircle[width, m]; RoundEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] ~ { UNTIL i0 = i1 DO i0 _ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; SquareEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] ~ { IF v.x = 0.0 AND v.y = 0.0 THEN { RuntimeError.InformationalSignal[SquareEndWithNoDirection]; v _ IF pen[i0].y < 0 THEN [1,0] ELSE [-1,0]; }; { ihalf: VertexIndex _ FindVertex[pen, v, i0]; V: VEC ~ IITransformation.InverseTransformVec[m, v ! Real.RealException => GOTO Singular]; U: VEC ~ [-V.y, V.x]; u: VEC _ IITransformation.TransformVec[m, U]; IF Vector2.Cross[u, v] > 0 THEN u _ Vector2.Neg[u]; MiterJoint[p, v, u, i0, ihalf]; MiterJoint[p, u, Vector2.Neg[v], ihalf, i1]; }; EXITS Singular => { lineTo[Add[p, pen[i1]]] }; }; Beam: PROC [v: VEC, i: VertexIndex] RETURNS [VEC] ~ { <> V: VEC ~ IITransformation.InverseTransformVec[m, v ! Real.RealException => GOTO Singular]; u: VEC ~ IITransformation.TransformVec[m, [-V.y, V.x]]; a: REAL ~ Vector2.Cross[pen[i], v]/Vector2.Cross[u, v]; beam: VEC ~ Vector2.Mul[u, a]; RETURN [beam]; EXITS Singular => { RETURN [pen[i]] } }; ButtEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] ~ { IF NOT Eq[v, [0.0, 0.0]] THEN { u: VEC ~ Beam[v, i0]; lineTo[Add[p, u]]; lineTo[Sub[p, u]]; }; lineTo[Add[p, pen[i1]]]; }; RoundJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ~ { UNTIL i0 = i1 DO i0 _ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; BevelJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ~ { IF NOT (Eq[v0, [0.0, 0.0]] OR Eq[v1, [0.0, 0.0]]) THEN { lineTo[Vector2.Add[p, Beam[v0, i0]]]; lineTo[Vector2.Sub[p, Beam[v0, i0]]]; lineTo[Vector2.Sub[p, pen[i0]]]; lineTo[p]; lineTo[Vector2.Add[p, Beam[v1, i1]]]; lineTo[Vector2.Add[p, pen[i1]]]; lineTo[Vector2.Sub[p, pen[i1]]]; lineTo[Vector2.Sub[p, Beam[v1, i1]]]; lineTo[p]; lineTo[Vector2.Add[p, Beam[v0, i0]]]; lineTo[Vector2.Add[p, Beam[v1, i1]]]; lineTo[p]; lineTo[Vector2.Sub[p, pen[i0]]]; }; lineTo[Vector2.Add[p, pen[i1]]]; }; MiterJoint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] ~ { u: VEC ~ Sub[pen[i1], pen[i0]]; d: REAL _ Vector2.Cross[v0, v1]; a: REAL _ Vector2.Cross[u, v1]/(MAX[d, verySmallNumber]); lineTo[Add[p, Add[pen[i0], Vector2.Mul[v0, a]]]]; lineTo[Add[p, pen[i1]]]; }; Path: PROC [moveTo: MoveToProc, lineTo: LineToProc, curveTo: CurveToProc, conicTo: ConicToProc, arcTo: ArcToProc] ~ { IIPath.Transform[path: path, m: m, moveTo: moveTo, lineTo: lineTo, curveTo: curveTo, conicTo: conicTo, arcTo: arcTo]; }; Joint: PROC [p: VEC, v0, v1: VEC, i0, i1: VertexIndex] _ SELECT joint FROM ORD[II.StrokeJoint.miter] => MiterJoint, ORD[II.StrokeJoint.bevel] => BevelJoint, ORD[II.StrokeJoint.round] => RoundJoint, ENDCASE => MiterJoint; End: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] _ SELECT end FROM ORD[II.StrokeEnd.square] => SquareEnd, ORD[II.StrokeEnd.butt] => ButtEnd, ORD[II.StrokeEnd.round] => RoundEnd, ENDCASE => SquareEnd; PenStroke[path: Path, pen: pen, moveTo: moveTo, lineTo: lineTo, conicTo: conicTo, closed: closed, end: End, joint: Joint, box: box, cull: NOT (Joint=MiterJoint OR End=SquareEnd)]; }; PathFromVector: PUBLIC PROC [p0, p1: VEC, width: REAL, end: INT, m: IITransformation.Transformation, moveTo: IIPath.MoveToProc, lineTo: IIPath.LineToProc] ~ { pen: Pen ~ IIPen.MakeTransformedCircle[width, m]; d0: VEC ~ IITransformation.Transform[m, p0]; d1: VEC ~ IITransformation.Transform[m, p1]; IF end = ORD[II.StrokeEnd.round] THEN { <> RoundEnd: PROC [p: VEC, v: VEC, i0, i1: VertexIndex] ~ INLINE { UNTIL i0 = i1 DO i0 _ AddMod[i0, 1, pen.size]; lineTo[Add[p, pen[i0]]]; ENDLOOP; }; direction: VEC ~ Sub[d1, d0]; ix0: NAT ~ FindVertex[pen: pen, direction: [-direction.y, direction.x]]; ix1: NAT ~ FindVertex[pen: pen, direction: [direction.y, -direction.x], i: AddMod[ix0, pen.size/2, pen.size]]; moveTo[Add[d0, pen[ix0]]]; RoundEnd[d0, Sub[d0, d1], ix0, ix1]; lineTo[Add[d1, pen[ix1]]]; RoundEnd[d1, direction, ix1, ix0]; } ELSE { <> min: VEC _ [maxReal, maxReal]; max: VEC _ [-maxReal, -maxReal]; delta: VEC ~ Sub[p1, p0]; s: REAL ~ ABS[delta.x]+ABS[delta.y]; t: Transformation _ NIL; IF s=0.0 THEN { t _ IITransformation.Scale[1]; IF end = ORD[II.StrokeEnd.square] THEN RuntimeError.InformationalSignal[SquareEndWithNoDirection]; } ELSE { <> cos: REAL ~ delta.x/s; sin: REAL ~ delta.y/s; t _ IITransformation.Create[a: cos, b: -sin, c: 0, d: sin, e: cos, f: 0]; IITransformation.ApplyPostConcat[t, m]; IITransformation.ApplyInvert[t]; }; FOR i: NAT IN [0..pen.size) DO p: VEC ~ IITransformation.TransformVec[t, pen[i]]; IF p.x < min.x THEN min.x _ p.x; IF p.x > max.x THEN max.x _ p.x; IF p.y < min.y THEN min.y _ p.y; IF p.y > max.y THEN max.y _ p.y; ENDLOOP; IITransformation.ApplyInvert[t]; IF end = ORD[II.StrokeEnd.butt] THEN { min.x _ max.x _ 0 }; moveTo[Add[d0, IITransformation.TransformVec[t, [min.x, max.y]]]]; lineTo[Add[d0, IITransformation.TransformVec[t, [min.x, min.y]]]]; lineTo[Add[d1, IITransformation.TransformVec[t, [max.x, min.y]]]]; lineTo[Add[d1, IITransformation.TransformVec[t, [max.x, max.y]]]]; IITransformation.Destroy[t]; }; }; nPts: NAT _ 6; RealPlusOrMinus: TYPE ~ RECORD [value: REAL, error: REAL]; AverageSpeed: PROC [p: Bezier] RETURNS [RealPlusOrMinus] ~ { <> nReal: REAL ~ nPts; min: REAL _ maxReal; max: REAL _ 0; delta: ARRAY [0..3) OF VEC ~ [Vector2.Sub[p[1], p[0]], Vector2.Sub[p[2], p[1]], Vector2.Sub[p[3], p[2]]]; <> FOR i: NAT IN [0..nPts] DO t: REAL ~ i/nReal; s: REAL ~ 1.0-t; d01: VEC _ Vector2.Add[Vector2.Mul[delta[0], t], Vector2.Mul[delta[1], s]]; d12: VEC _ Vector2.Add[Vector2.Mul[delta[1], t], Vector2.Mul[delta[2], s]]; d012: VEC _ Vector2.Add[Vector2.Mul[d01, t], Vector2.Mul[d12, s]]; sqr: REAL ~ Vector2.Square[d012]; IF sqr > max THEN max _ sqr; IF sqr < min THEN min _ sqr; ENDLOOP; max _ RealFns.SqRt[max]; min _ RealFns.SqRt[min]; RETURN [[(max+min)*1.5, (max-min)*1.5]] }; sigBits: NAT _ 5; DivideUntilSmooth: PROC [p: Bezier, piece: PROC [p: Bezier, speed: REAL], fullScale: REAL] ~ { a: RealPlusOrMinus _ AverageSpeed[p]; UNTIL Real.FScale[a.error, sigBits] <= fullScale DO Mid: PROC [a,b: VEC] RETURNS [VEC] ~ INLINE {RETURN [[Real.FScale[a.x+b.x, -1], Real.FScale[a.y+b.y, -1]]]}; p01: VEC ~ Mid[p[0],p[1]]; p12: VEC ~ Mid[p[1],p[2]]; p23: VEC ~ Mid[p[2],p[3]]; p012: VEC ~ Mid[p01,p12]; p123: VEC ~ Mid[p12,p23]; p0123: VEC ~ Mid[p012,p123]; DivideUntilSmooth[[p[0], p01, p012, p0123], piece, fullScale]; p _ [p0123, p123, p23, p[3]]; a _ AverageSpeed[p]; ENDLOOP; piece[p, a.value]; }; SubDivide: PROC [b: Bezier, t: REAL, hi: BOOL] RETURNS [Bezier] ~ { s: REAL ~ 1-t; Interpolate: PROC [a, b: VEC] RETURNS [VEC] ~ INLINE { RETURN [[a.x*s+b.x*t, a.y*s+b.y*t]] }; q1 : VEC ~ Interpolate[b[0], b[1]]; q2: VEC ~ Interpolate[b[1], b[2]]; q3: VEC ~ Interpolate[b[2], b[3]]; qp1: VEC ~ Interpolate[q1, q2]; qp2: VEC ~ Interpolate[q2, q3]; q: VEC ~ Interpolate[qp1, qp2]; RETURN [IF hi THEN [q, qp2, q3, b[3]] ELSE [b[0], q1, qp1, q]] }; SubPiece: PROC [b: Bezier, t0, t1: REAL] RETURNS [Bezier] ~ { IF t1 # 1.0 THEN { b _ SubDivide[b, t1, FALSE]; t0 _ t0/t1; t1 _ 1; }; IF t0 # 0.0 THEN b _ SubDivide[b, t0, TRUE]; RETURN [b]; }; MeasurePath: PUBLIC PROC [path: PathProc] RETURNS [sum: REAL _ 0.0] ~ { lp: VEC _ [0,0]; move: PROC [p0: VEC] ~ { lp _ p0; }; line: PROC [p1: VEC] ~ { sum _ sum + Vector2.Length[Vector2.Sub[p1, lp]]; lp _ p1; }; piece: PROC [p: Bezier, speed: REAL] ~ { sum _ sum + speed; }; curve: PROC [p1, p2, p3: VEC] ~ TRUSTED { p: Bezier ~ [lp, p1, p2, p3]; fullScale: REAL ~ AverageSpeed[p].value; IF fullScale > 0.0 THEN DivideUntilSmooth[p, piece, fullScale]; lp _ p3; }; conic: PROC [p1, p2: VEC, r: REAL] ~ { IIPath.ConicToCurves[lp, p1, p2, r, curve] }; arc: PROC [p1, p2: VEC] ~ {IIPath.ArcToConics[lp, p1, p2, conic]}; path[moveTo: move, lineTo: line, curveTo: curve, conicTo: conic, arcTo: arc]; }; Dashes: PUBLIC PROC [path: IIPath.PathProc, patternLen: NAT, pattern: PROC [i: NAT] RETURNS [REAL], offset, length: REAL, moveTo: IIPath.MoveToProc, lineTo: IIPath.LineToProc, conicTo: IIPath.ConicToProc, curveTo: IIPath.CurveToProc ] ~ { pathUnits: REAL ~ MeasurePath[path]; stretch: REAL ~ IF length <= 0.0 OR pathUnits = 0.0 THEN 1.0 ELSE pathUnits/length; lp: VEC _ [0,0]; index: INT _ 0; -- index of currently active pattern element. residual: REAL _ pattern[0]*stretch; -- remaining part of current pattern element, in master units. used: REAL _ 0.0; -- amount of pattern used, in master units. on: BOOL _ TRUE; Advance: PROC [patternOffset: REAL, startAction, stopAction: PROC _ NIL] ~ { UNTIL used >= patternOffset DO IF residual > 0.0 THEN { <> IF used+residual <= patternOffset THEN {used _ used+residual; residual _ 0.0} ELSE {residual _ used+residual - patternOffset; used _ patternOffset}; } ELSE { <> IF on AND stopAction#NIL THEN stopAction[]; index _ index + 1; IF index = patternLen THEN index _ 0; residual _ pattern[index]*stretch; on _ NOT on; IF on AND startAction#NIL THEN startAction[]; }; ENDLOOP; }; move: PROC [p0: VEC] ~ {lp _ p0; IF on THEN moveTo[lp]}; line: PROC [p1: VEC] ~ { delta: VEC ~ Vector2.Sub[p1, lp]; d: REAL ~ Vector2.Length[delta]; segmentStart: REAL ~ used; segmentEnd: REAL ~ used + d; start: PROC ~ { s: REAL _ (used-segmentStart)/d; moveTo[Vector2.Add[lp, Vector2.Mul[delta, s]]]; }; stop: PROC ~ { s: REAL _ (used-segmentStart)/d; lineTo[Vector2.Add[lp, Vector2.Mul[delta, s]]]; }; Advance[segmentEnd, start, stop]; IF on THEN lineTo[p1]; lp _ p1; }; curve: PROC [p1, p2, p3: VEC] ~ { piece: PROC [p: Bezier, speed: REAL] ~ { segmentStart: REAL ~ used; segmentEnd: REAL ~ used + speed; dashStartParam: REAL _ 0; needMove: BOOL _ FALSE; start: PROC ~ { dashStartParam _ (used-segmentStart)/speed; needMove _ TRUE; }; stop: PROC ~ { dashEndParam: REAL _ (used-segmentStart)/speed; b: Bezier _ SubPiece[p, dashStartParam, dashEndParam]; IF needMove THEN moveTo[b[0]]; curveTo[b[1], b[2], b[3]]; needMove _ FALSE; }; Advance[segmentEnd, start, stop]; IF on THEN stop[]; }; p: Bezier ~ [lp, p1, p2, p3]; fullScale: REAL ~ AverageSpeed[p].value; IF fullScale > 0.0 THEN DivideUntilSmooth[p, piece, fullScale]; lp _ p3; }; conic: PROC [p1, p2: VEC, r: REAL] ~ {IIPath.ConicToCurves[lp, p1, p2, r, curve]}; arc: PROC [p1, p2: VEC] ~ {IIPath.ArcToConics[lp, p1, p2, conic]}; Advance[offset*stretch]; path[moveTo: move, lineTo: line, curveTo: curve, conicTo: conic, arcTo: arc]; }; END.