ImagerStrokeImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Michael Plass, August 15, 1985 3:43:27 pm PDT
Doug Wyatt, March 7, 1986 4:38:52 pm PST
DIRECTORY
Imager USING [StrokeEnd, StrokeJoint],
ImagerPath USING [ArcToConics, ArcToProc, ConicToCurves, ConicToProc, CurveToProc, LineToProc, MoveToProc, PathProc, Transform],
ImagerPen USING [MakeTransformedCircle, Pen],
ImagerTransformation USING [InverseTransformVec, Transformation, TransformVec],
ImagerStroke USING [],
Real USING [FScale, LargestNumber, TrappingNaN],
RealFns USING [SqRt],
RuntimeError USING [InformationalSignal],
Vector2 USING [Add, Cross, Dot, Length, Mul, Neg, Square, Sub, VEC];
ImagerStrokeImpl: CEDAR PROGRAM
IMPORTS ImagerPath, ImagerPen, ImagerTransformation, Real, RealFns, RuntimeError, Vector2
EXPORTS ImagerStroke
~
BEGIN
VEC: TYPE ~ Vector2.VEC;
Pen: TYPE ~ ImagerPen.Pen;
PathProc: TYPE ~ ImagerPath.PathProc;
MoveToProc: TYPE ~ ImagerPath.MoveToProc;
LineToProc: TYPE ~ ImagerPath.LineToProc;
ConicToProc: TYPE ~ ImagerPath.ConicToProc;
CurveToProc: TYPE ~ ImagerPath.CurveToProc;
ArcToProc: TYPE ~ ImagerPath.ArcToProc;
Transformation: TYPE ~ ImagerTransformation.Transformation;
Add:
PROC [v1, v2:
VEC]
RETURNS [
VEC] ~ {
RETURN[[v1.x+v2.x, v1.y+v2.y]] };
Sub:
PROC [v1, v2:
VEC]
RETURNS [
VEC] ~ {
RETURN[[v1.x-v2.x, v1.y-v2.y]] };
non:
VEC ~ [Real.TrappingNaN, Real.TrappingNaN];
NonVec:
PROC [a:
VEC]
RETURNS [
BOOL] ~ {
With the current compiler, this is not needed, but just on principle . . .
A: TYPE ~ ARRAY [0..SIZE[VEC]) OF WORD;
RETURN [LOOPHOLE[a, A] = LOOPHOLE[non, A]]
};
Eq:
PROC [a, b:
VEC]
RETURNS [
BOOL] ~ {
RETURN [a.x=b.x
AND a.y=b.y]};
This is needed to prevent confusion about minus zero.
AddMod:
PROC [a, b:
NAT, mod:
NAT]
RETURNS [c:
NAT] ~ {
IF (c ← a + b) >= mod THEN c ← c - mod;
};
FindVertex:
PROC [pen: Pen, direction:
VEC, i:
NAT ← 0]
RETURNS [
NAT] ~ {
Finds the vertex of the pen that is farthest in the given direction; i provides the initial guess.
penSize: NAT ~ pen.size;
penSizeLess1: NAT ~ penSize-1;
DO
nxt: NAT ~ IF i = penSizeLess1 THEN 0 ELSE i + 1;
prv: NAT ~ IF i = 0 THEN penSizeLess1 ELSE i - 1;
dotNxt: REAL ~ Vector2.Dot[direction, Sub[pen[nxt], pen[i]]];
IF dotNxt > 0 THEN i ← nxt
ELSE {
dotPrv: REAL ~ Vector2.Dot[direction, Sub[pen[prv], pen[i]]];
IF dotPrv > 0 THEN i ← prv
ELSE RETURN [i];
};
ENDLOOP;
};
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] ~ {
t: NAT ← state.left; state.left ← state.right; state.right ← t;
state.v ← [-state.v.x, -state.v.y];
RETURN [state];
};
Bezier:
TYPE ~
ARRAY [0..4)
OF
VEC;
SubDivide:
PROC [b: Bezier, t:
REAL]
RETURNS [low, high: Bezier] ~ {
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]];
q3: VEC ~ Interpolate[b[2], b[3]];
qp1: VEC ~ Interpolate[q1, q2];
qp2: VEC ~ Interpolate[q2, q3];
q: VEC ~ Interpolate[qp1, qp2];
low ← [b[0], q1, qp1, q];
high ← [q, qp2, q3, b[3]];
};
Roots: TYPE = RECORD [nRoots: [0..2], root: ARRAY [0..2) OF REAL];
RealRoots:
PROC [a, b, c:
REAL]
RETURNS [Roots] ~ {
nan: REAL ~ Real.TrappingNaN;
IF a # 0.0
THEN {
d: REAL;
b ← b/a;
c ← c/a;
a ← 1.0;
d ← b*b-Real.FScale[c, 2];
IF d < 0.0 THEN RETURN [[0, [nan, nan]]]
ELSE {
sqrt: REAL ~ RealFns.SqRt[d];
t0: REAL ~ Real.FScale[(-b-(IF b>0 THEN sqrt ELSE -sqrt)), -1];
t1: REAL ~ IF t0 # 0.0 THEN c/t0 ELSE 0.0;
IF t0 > t1 THEN RETURN [[2, [t1, t0]]]
ELSE RETURN [[2, [t0, t1]]];
};
}
ELSE IF b # 0.0 THEN RETURN [[1, [-c/b, nan]]]
ELSE IF c = 0.0 THEN RETURN[[1, [0.0, nan]]]
ELSE RETURN [[0, [nan, nan]]]
};
TraverseCubic:
PROC [pen: Pen, p: Bezier, vertex, endVertex: VertexIndex, lineTo: LineToProc, curveTo: CurveToProc] ~ {
penSize: NAT ~ pen.size;
penSizeLess1: NAT ~ penSize-1;
delta0: VEC ~ Sub[p[1], p[0]];
delta1: VEC ~ Sub[p[2], p[1]];
delta2: VEC ~ Sub[p[3], p[2]];
offset: VEC ← pen[vertex];
t: REAL ← 0.0;
b: Bezier ← p;
UNTIL t = 1.0
DO
ParallelTo:
PROC [v:
VEC]
RETURNS [
REAL] ~ {
Finds the smallest parameter in the range (t..1] where the curve defined by p is parallel to v.
Returns 1 if none such, or if a double root is found.
d0: REAL ~ Vector2.Cross[delta0, v];
d1: REAL ~ Vector2.Cross[delta1, v];
d2: REAL ~ Vector2.Cross[delta2, v];
a: REAL ~ d0-Real.FScale[d1, 1]+d2;
b: REAL ~ Real.FScale[d1-d0, 1];
r: Roots ~ RealRoots[a, b, d0];
IF r.nRoots = 2 AND r.root[0] = r.root[1] THEN RETURN [1.0];
FOR i:
NAT
IN [0..r.nRoots)
DO
ti: REAL ~ r.root[i];
IF ti IN (t..1.0] THEN RETURN [ti];
IF ti = t
THEN {
dd: REAL ~ Real.FScale[a, 1]*ti + b;
IF dd < 0.0 THEN RETURN [ti];
};
ENDLOOP;
RETURN [1.0];
};
forw: NAT ~ IF vertex = penSizeLess1 THEN 0 ELSE vertex + 1;
back: NAT ~ IF vertex = 0 THEN penSizeLess1 ELSE vertex - 1;
tForwards: REAL ~ ParallelTo[Sub[pen[forw], offset]];
tBackwards: REAL ~ ParallelTo[Sub[pen[back], offset]];
newVertex: VertexIndex; newT: REAL; b0, b1: Bezier;
IF tForwards < tBackwards THEN {newVertex ← forw; newT ← tForwards}
ELSE IF tBackwards < tForwards THEN {newVertex ← back; newT ← tBackwards}
ELSE IF tForwards # 1.0 THEN {newVertex ← forw; newT ← tForwards}
ELSE {newVertex ← vertex; newT ← tForwards};
[b0, b1] ← SubDivide[b, (newT-t)/(1.0-t)];
curveTo[Add[b0[1], offset], Add[b0[2], offset], Add[b0[3], offset]];
offset ← pen[newVertex];
lineTo[Add[b1[0], offset]];
vertex ← newVertex;
b ← b1;
t ← newT;
ENDLOOP;
IF vertex # endVertex THEN lineTo[Add[p[3], pen[endVertex]]];
};
PenStroke:
PUBLIC
PROC [path: ImagerPath.PathProc, pen: ImagerPen.Pen, closed:
BOOL,
moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc,
conicTo: ImagerPath.ConicToProc, curveTo: ImagerPath.CurveToProc,
end:
PROC [p:
VEC, v:
VEC, i0, i1: VertexIndex],
joint:
PROC [p:
VEC, v0, v1:
VEC, i0, i1: VertexIndex]
] ~ {
The idea is that one output loop is made for each non-trivial input segment. This includes the connection (round joint or miter) with the previous piece, but is truncated at the active end by connecting the points corresponding to the two active vertices of the polygonal pen. The next piece will generally lap over this truncated end. In the case of a closed curve (designated by end=NIL), the start of the first segment is truncated, and the closing joint is put on last. The end and joint routines should emit only lineTo calls, assuming that the position starts at p + pen[i0]; the position should end up at p + pen[i1].
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 => {
Can't tell direction to miter, so instance whole pen to ensure coverage.
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;
};
Line:
PROC [p1:
VEC] ~ {
p0: VEC ~ last.p;
IF
NOT Eq[p1, p0]
THEN {
v: VEC ~ Sub[p1, p0];
left: VertexIndex ~ FindVertex[pen, [-v.y, v.x], last.left];
right: VertexIndex ~ FindVertex[pen, [v.y, -v.x], last.right];
turn: REAL ~ Vector2.Cross[last.v, v];
IF where = normal
AND turn > 0
THEN {
moveTo[Add[p0, pen[last.right]]];
joint[p0, last.v, v, last.right, right];
}
ELSE moveTo[Add[p0, pen[right]]];
lineTo[Add[p1, pen[right]]];
lineTo[Add[p1, pen[left]]];
lineTo[Add[p0, pen[left]]];
IF where = normal
AND turn < 0
THEN {
joint[p0, [-v.x, -v.y], [-last.v.x, -last.v.y], left, last.left];
};
IF where = firstpoint
THEN {
IF closed THEN first ← [p: p0, v: v, left: left, right: right]
ELSE end[p0, [-v.x, -v.y], left, right];
};
last ← [p: p1, v: v, left: left, right: right];
where ← normal;
};
};
Conic: ConicToProc ~ {ImagerPath.ConicToCurves[last.p, p1, p2, r, Curve]};
Curve: CurveToProc ~ {
p0: VEC ~ last.p;
p0PlusV0:
VEC ~
SELECT
TRUE
FROM
NOT Eq[p1, p0] => p1,
NOT Eq[p2, p0] => p2,
ENDCASE => p3;
IF p0PlusV0 = p3 THEN Line[p3]
ELSE {
v0: VEC ~ Sub[p0PlusV0, p0];
p3MinusV1:
VEC ~
SELECT
TRUE
FROM
NOT Eq[p2, p3] => p2,
NOT Eq[p1, p3] => p1,
ENDCASE => p0;
v1: VEC ~ Sub[p3, p3MinusV1];
left: VertexIndex ~ FindVertex[pen, [-v0.y, v0.x], last.left];
right: VertexIndex ~ FindVertex[pen, [v0.y, -v0.x], last.right];
newLeft: VertexIndex ~ FindVertex[pen, [-v1.y, v1.x], left];
newRight: VertexIndex ~ FindVertex[pen, [v1.y, -v1.x], right];
turn: REAL ~ Vector2.Cross[last.v, v0];
IF where = normal
AND turn > 0
THEN {
moveTo[Add[p0, pen[last.right]]];
joint[p0, last.v, v0, last.right, right];
}
ELSE moveTo[Add[p0, pen[right]]];
IF FALSE --Cull[p0, p1, p2, p3]-- THEN moveTo[Add[p0, pen[left]]]
ELSE {
TraverseCubic[pen, [p0, p1, p2, p3], right, newRight, lineTo, curveTo];
};
lineTo[p3.Add[pen[newLeft]]];
TraverseCubic[pen, [p3, p2, p1, p0], newLeft, left, lineTo, curveTo];
IF where = normal
AND turn < 0
THEN {
joint[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: p3, v: v1, left: newLeft, right: newRight];
where ← normal;
};
};
Arc: ArcToProc ~ {ImagerPath.ArcToConics[last.p, p1, p2, Conic]};
path[Move, Line, Curve, Conic, Arc];
Finish[];
};
epsilon:
REAL ← Real.FScale[1, -20];
SquareEndWithNoDirection:
PUBLIC
SIGNAL ~
CODE;
PathFromStroke:
PUBLIC
PROC [path: ImagerPath.PathProc, closed:
BOOL,
width:
REAL, end:
INT, joint:
INT, m: ImagerTransformation.Transformation,
moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc,
conicTo: ImagerPath.ConicToProc, curveTo: ImagerPath.CurveToProc
] ~ {
pen: Pen ~ ImagerPen.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 ~ ImagerTransformation.InverseTransformVec[m, v];
U: VEC ~ [-V.y, V.x];
u: VEC ← ImagerTransformation.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];
};
};
ButtEnd:
PROC [p:
VEC, v:
VEC, i0, i1: VertexIndex] ~ {
IF
NOT Eq[v, [0.0, 0.0]]
THEN {
V: VEC ~ ImagerTransformation.InverseTransformVec[m, v];
absV: REAL ~ Vector2.Length[V];
s: REAL ~ IF absV = 0.0 THEN 0.0 ELSE width/Real.FScale[absV, 1];
sV: VEC ~ Vector2.Mul[V, s];
u: VEC ← ImagerTransformation.TransformVec[m, [-sV.y, sV.x]];
v ← ImagerTransformation.TransformVec[m, V];
IF Vector2.Cross[u, v] < 0 THEN u ← Vector2.Neg[u];
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] ~ {
lineTo[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, epsilon]);
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] ~ {
ImagerPath.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[Imager.StrokeJoint.miter] => MiterJoint,
ORD[Imager.StrokeJoint.bevel] => BevelJoint,
ORD[Imager.StrokeJoint.round] => RoundJoint,
ENDCASE => MiterJoint;
End:
PROC [p:
VEC, v:
VEC, i0, i1: VertexIndex] ←
SELECT end
FROM
ORD[Imager.StrokeEnd.square] => SquareEnd,
ORD[Imager.StrokeEnd.butt] => ButtEnd,
ORD[Imager.StrokeEnd.round] => RoundEnd,
ENDCASE => SquareEnd;
PenStroke[path: Path, pen: pen, moveTo: moveTo, lineTo: lineTo, conicTo: conicTo, curveTo: curveTo, closed: closed, end: End, joint: Joint];
};
Dashes:
PUBLIC
PROC [path: ImagerPath.PathProc,
patternLen:
NAT, pattern:
PROC [i:
NAT]
RETURNS [
REAL], offset, length:
REAL,
moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc,
conicTo: ImagerPath.ConicToProc, curveTo: ImagerPath.CurveToProc
] ~ {
Bezier: TYPE ~ ARRAY [0..4) OF VEC;
RealPlusOrMinus: TYPE ~ RECORD [value: REAL, error: REAL];
nPts: NAT ← 6;
AverageSpeed:
PROC [p: Bezier]
RETURNS [RealPlusOrMinus] ~ {
Computes an approximation to the average speed of the point moving along the curve as a function of its parameter, along with estimated error bounds. Since the curve is parameterized from zero to one, its average speed is numerically equal to its arc length.
nReal: REAL ~ nPts;
min: REAL ← Real.LargestNumber;
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]]];
The deltas form a Bezier description of the velocity profile. We want its average magnitude.
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:
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] ~ {
ImagerPath.ConicToCurves[lp, p1, p2, r, curve]
};
arc: PROC [p1, p2: VEC] ~ {ImagerPath.ArcToConics[lp, p1, p2, conic]};
path[moveTo: move, lineTo: line, curveTo: curve, conicTo: conic, arcTo: arc];
};
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 {
Still have part of the current piece to use up.
IF used+residual <= patternOffset
THEN {used ← used+residual; residual ← 0.0}
ELSE {residual ← used+residual - patternOffset; used ← patternOffset};
}
ELSE {
The current piece is all used up; go on to the next.
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] ~ {ImagerPath.ConicToCurves[lp, p1, p2, r, curve]};
arc: PROC [p1, p2: VEC] ~ {ImagerPath.ArcToConics[lp, p1, p2, conic]};
Advance[offset*stretch];
path[moveTo: move, lineTo: line, curveTo: curve, conicTo: conic, arcTo: arc];
};
END.