ImagerStrokeImpl.mesa
Copyright © 1984, 1985, 1986 by Xerox Corporation. All rights reserved.
Michael Plass, August 15, 1985 3:43:27 pm PDT
Doug Wyatt, May 15, 1986 10:19:10 am PDT
DIRECTORY
Imager USING [StrokeEnd],
ImagerExtras USING [NewStrokeJoint],
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, TrappingNaN],
RealFns USING [SqRt],
RuntimeError USING [InformationalSignal],
Vector2 USING [Add, Cross, Dot, Length, Mul, Neg, 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;
};
VertexIndex: TYPE ~ NAT;
State: TYPE ~ RECORD [
p: VEC ← non, -- position
v: VEC ← non, -- velocity
left: NATNAT.LAST, -- index of active pen vertex to the left
right: NATNAT.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[ImagerExtras.NewStrokeJoint.miter] => MiterJoint,
ORD[ImagerExtras.NewStrokeJoint.bevel] => BevelJoint,
ORD[ImagerExtras.NewStrokeJoint.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];
};
END.