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, TrappingNaN],
RealFns USING [SqRt],
RuntimeError USING [InformationalSignal],
Vector2 USING [Add, Cross, Dot, Length, Mul, Neg, VEC];
~
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;
};
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.mitered] => MiterJoint,
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];
};