ImagerStrokeImpl:
CEDAR
PROGRAM
IMPORTS Basics, ImagerError, ImagerPath, ImagerTransformation, Real, RealFns, RealInline, Vector2, ProcessProps, IO
EXPORTS ImagerStroke
~ BEGIN
EndCode: TYPE ~ ImagerStroke.EndCode;
JointCode:
TYPE ~ ImagerStroke.JointCode;
maxReal: REAL ~ Real.LargestNumber;
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;
VertexIndex: TYPE ~ NAT;
Bezier: TYPE ~ ARRAY [0..4) OF VEC;
dbug: BOOL ~ FALSE; -- A compile-time FALSE inhibits generation of debugging code.
DBug:
PROC [label: Rope.
ROPE, v:
LIST
OF Vector2.
VEC, d:
INT ¬
FIRST[
INT]] ~ {
IF dbug
THEN {
WITH ProcessProps.GetProp[$ErrOut]
SELECT
FROM
s:
IO.
STREAM => {
IO.PutRope[s, label];
IF d #
FIRST[
INT]
THEN {
IO.PutF1[s, "(%g)", [integer[d]]];
};
FOR tail:
LIST
OF Vector2.
VEC ¬ v, tail.rest
UNTIL tail =
NIL
DO
IO.PutFL[s, " [%g, %g]", LIST[[real[tail.first.x]], [real[tail.first.y]]]];
ENDLOOP;
IO.PutRope[s, "\n"];
};
ENDCASE;
};
};
RealMax:
PROC [x, y:
REAL]
RETURNS [
REAL] =
INLINE {
RETURN [IF x > y THEN x ELSE y];
};
curveTolerance:
REAL ¬ 0.5;
Used to control "flatness" in Flat[] and relatives
SetCurveTolerance:
PROC [millis:
INT] = {
IF millis
IN [1..10000]
THEN
curveTolerance ¬ millis * 0.001;
};
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 [r*0.5];
};
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]};
This is needed to prevent confusion about minus zero.
AddMod:
PROC [a, b:
NAT, mod:
NAT]
RETURNS [c:
NAT] ~
INLINE {
IF (c ¬ a + b) >= mod THEN c ¬ c - mod;
};
FindVertex:
PUBLIC
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
prv: NAT ~ IF i = 0 THEN penSizeLess1 ELSE i - 1;
dotPrv: REAL ~ Vector2.InlineDot[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.InlineDot[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] ~ {
t: NAT ¬ state.left; state.left ¬ state.right; state.right ¬ t;
state.v ¬ [RealInline.Neg[state.v.x], RealInline.Neg[state.v.y]];
RETURN [state];
};
PenBB:
PROC [pen: ImagerPen.Pen]
RETURNS [ImagerBox.Box] ~ {
box: ImagerBox.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: ImagerBox.Box]
RETURNS [ImagerBox.Box] ~ {
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]];
};
Turning: TYPE ~ { undecided, left, right };
TraverseParabola:
PROC [pen: Pen, p: BezierParabola, vertex, endVertex: VertexIndex, lineTo: LineToProc, conicTo: ImagerPath.ConicToProc, turning: Turning]
RETURNS [Turning] ~ {
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 ~ SELECT turning FROM $left => FALSE, $right => TRUE, ENDCASE => (Vector2.InlineCross[delta0, delta1] < 0);
IF dbug THEN DBug["TraverseParabola", LIST[p[0], p[1], p[2], [vertex, endVertex], delta0, delta1], ORD[turnRight]];
UNTIL vertex = endVertex
DO
nextVertex: NAT ~ IF turnRight THEN Back[vertex] ELSE Forw[vertex];
nextDirection: VEC ~ Sub[pen[nextVertex], offset];
d0: REAL ~ Vector2.InlineCross[delta0, nextDirection];
d1: REAL ~ Vector2.InlineCross[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, IF t = 1.0 THEN 1.0 ELSE (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;
IF dbug THEN DBug["TraverseParabolaStep", LIST[b[0], b[1], b[2], [t, newT]], ORD[turnRight]];
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];
RETURN [IF turnRight THEN $left ELSE $right]
};
ExternalHalfPlane: TYPE ~ {xLo, xHi, yLo, yHi};
Region: TYPE ~ PACKED ARRAY ExternalHalfPlane OF BOOL;
Intersect:
PROC [a, b: Region]
RETURNS [Region] ~ {
Hopefully the extra bits in the word are all zero; does the compiler guarantee this?
RETURN [LOOPHOLE[Basics.BITAND[LOOPHOLE[a], LOOPHOLE[b]]]];
};
depthLimit: NAT = 15; -- Prevent runaways
PenStroke:
PUBLIC
PROC [path: ImagerPath.PathProc, pen: ImagerPen.Pen, closed:
BOOL,
moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, conicTo: ImagerPath.ConicToProc,
end:
PROC [p:
VEC, v:
VEC, i0, i1: VertexIndex],
joint:
PROC [p:
VEC, v0, v1:
VEC, i0, i1: VertexIndex],
box: ImagerBox.Box, cull:
BOOL
] ~ {
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, 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].
bb: ImagerBox.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.InlineCross[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;
};
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] ~ {
This does a degree-two Bezier piece (a parabola); we don't worry about bounding box checks, since all the callers of this have already done at least some of that.
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];
turning: Turning ¬ undecided;
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.InlineCross[last.v, v0] > 0;
IF dbug THEN DBug["Parabola", LIST[p0, p1, p2, v0, v2], ORD[isLine] + 2*ORD[jointFirst]];
IF where = normal
THEN {
IF jointFirst
THEN {
moveTo[Add[p0, pen[last.right]]];
IF last.right # right THEN join[p0, last.v, v0, last.right, right];
}
ELSE {
moveTo[p0];
lineTo[Add[p0, pen[right]]];
};
}
ELSE {
moveTo[Add[p0, pen[right]]];
};
IF isLine
THEN lineTo[Add[p2, pen[newRight]]]
ELSE turning ¬ TraverseParabola[pen, [p0, p1, p2], right, newRight, lineTo, conicTo, turning];
lineTo[Add[p2, pen[newLeft]]];
IF isLine
THEN lineTo[Add[p0, pen[left]]]
ELSE turning ¬ TraverseParabola[pen, [p2, p1, p0], newLeft, left, lineTo, conicTo, turning];
IF where = normal
THEN {
IF jointFirst
THEN { lineTo[p0] }
ELSE { 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 depth > depthLimit
OR OutsideOfBB[]
OR
NOT RealInline.IsValid[r]
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 (RealInline.Abs[m.x]+RealInline.Abs[m.y])*RealInline.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 dbug THEN DBug["Curve", LIST[p0, p1, p2, p3], depth];
IF depth = 0 THEN firstHalf ¬ TRUE;
depth ¬ depth + 1;
IF depth > depthLimit
OR 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 ~ RealInline.Abs[q1.x-q2.x]+RealInline.Abs[q1.y-q2.y];
IF error < curveTolerance
AND (depth > 1
OR error = 0.0)
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 ~ {ImagerPath.ArcToConics[last.p, p1, p2, Conic]};
path[Move, Line, Curve, Conic, Arc];
Finish[];
};
verySmallNumber:
REAL ¬ Real.FScale[1, -20];
SignalSquareEndWithNoDirection:
PUBLIC
PROC ~ {
SIGNAL ImagerError.Warning[[$squareEndOnStrokeOfZeroLength, "Zero-length stroke has no direction for square end"]];
};
PathFromStroke:
PUBLIC
PROC [path: ImagerPath.PathProc, closed:
BOOL, pen: Pen, end: EndCode, joint: JointCode, m: ImagerTransformation.Transformation, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc, conicTo: ImagerPath.ConicToProc, box: ImagerBox.Box, pathT: ImagerTransformation.Transformation ¬
NIL, miterLimit:
REAL ¬ 0] = {
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 {
IF end = ImagerStroke.warningSquareEnd THEN SignalSquareEndWithNoDirection[];
GOTO Exception;
v ¬ IF pen[i0].y < 0 THEN [1, 0] ELSE [-1, 0];
};
{
ihalf: VertexIndex ¬ FindVertex[pen, v, i0];
V: VEC = ImagerTransformation.InverseTransformVec[m, v ! Real.RealException => GOTO Exception];
U: VEC = [-V.y, V.x];
u: VEC ¬ ImagerTransformation.TransformVec[m, U];
IF Vector2.InlineCross[u, v] > 0 THEN u ¬ Vector2.Neg[u];
MiterJoint[p, v, u, i0, ihalf];
MiterJoint[p, u, Vector2.Neg[v], ihalf, i1];
};
EXITS Exception => {lineTo[Add[p, pen[i1]]]};
};
Beam:
PROC [v:
VEC, i: VertexIndex]
RETURNS [
VEC] = {
This finds the intersection point of the line through pen[i] parallel to v and the line through the origin which is perpendicular to v in client coordinates.
V:
VEC = ImagerTransformation.InverseTransformVec[
m, v ! Real.RealException => GOTO Singular];
u: VEC = ImagerTransformation.TransformVec[m, [-V.y, V.x]];
a: REAL = Vector2.InlineCross[pen[i], v] / Vector2.InlineCross[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 {
beam0: VEC = Beam[v0, i0];
beam1: VEC = Beam[v1, i1];
lineTo[Add[p, beam0]];
lineTo[Sub[p, beam0]];
lineTo[Sub[p, pen[i0]]];
lineTo[p];
lineTo[Add[p, beam1]];
lineTo[Add[p, pen[i1]]];
lineTo[Sub[p, pen[i1]]];
lineTo[Sub[p, beam1]];
lineTo[p];
lineTo[Add[p, beam0]];
lineTo[Add[p, beam1]];
lineTo[p];
lineTo[Sub[p, pen[i0]]];
};
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.InlineCross[v0, v1];
a: REAL ¬ Vector2.InlineCross[u, v1] / (RealMax[d, verySmallNumber]);
lineTo[Add[p, Add[pen[i0], Vector2.Mul[v0, a]]]];
lineTo[Add[p, pen[i1]]];
};
MiterOrBevelJoint:
PROC [p:
VEC, v0, v1:
VEC, i0, i1: VertexIndex] = {
u: VEC = Sub[pen[i1], pen[i0]];
d: REAL ¬ Vector2.InlineCross[v0, v1];
a: REAL ¬ Vector2.InlineCross[u, v1] / (RealMax[d, verySmallNumber]);
miterTipDelta: VEC = Add[pen[i0], Vector2.Mul[v0, a]];
IF miterLimit <
Vector2.Length[miterTipDelta] / RealInline.AbsMin[Vector2.Length[pen[i0]], Vector2.Length[pen[i1]]]
THEN {
this does the miterlimit test in device space, and takes a stab at what would be meant by strokewidth. Need to experiment to figure out the way PS implementations do it and optimize calculation.
BevelJoint[p, v0, v1, i0, i1]
}
ELSE { lineTo[Add[p, miterTipDelta]]; lineTo[Add[p, pen[i1]]] };
};
Path:
PROC [
moveTo: MoveToProc, lineTo: LineToProc, curveTo: CurveToProc,
conicTo: ConicToProc, arcTo: ArcToProc] = {
ImagerPath.Transform[
path: path, m: IF pathT = NIL THEN m ELSE pathT, moveTo: moveTo,
lineTo: lineTo, curveTo: curveTo, conicTo: conicTo, arcTo: arcTo];
};
Joint:
PROC [p:
VEC, v0, v1:
VEC, i0, i1: VertexIndex] ¬
SELECT joint
FROM
ImagerStroke.miterJoint => (
SELECT miterLimit
FROM
< 1.0 => MiterJoint,
= 1.0 => BevelJoint,
ENDCASE => MiterOrBevelJoint
),
ImagerStroke.bevelJoint => BevelJoint,
ImagerStroke.roundJoint => RoundJoint,
ENDCASE => MiterJoint;
End:
PROC [p:
VEC, v:
VEC, i0, i1: VertexIndex] ¬
SELECT end
FROM
ImagerStroke.warningSquareEnd, ImagerStroke.squareEnd => SquareEnd,
ImagerStroke.buttEnd => ButtEnd,
ImagerStroke.roundEnd => 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 Joint = MiterOrBevelJoint OR End = SquareEnd)];
};
PathFromVector:
PUBLIC
PROC [p0, p1:
VEC, pen: Pen, end: EndCode, m: ImagerTransformation.Transformation, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] ~ {
d0: VEC ~ ImagerTransformation.Transform[m, p0];
d1: VEC ~ ImagerTransformation.Transform[m, p1];
IF end = ImagerStroke.roundEnd
THEN {
Round ends just involve walking around the two halfs of the pen, spliced together by two segments.
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 {
Square or butt ends are done by first finding a coordinate system that differs from the client coordinate system only by a rotation (and possibly by a uniform scale and/or translation, which do not matter) in which the vector lies on the x axis; then the bounding box of the pen vertices is computed in this system, and the appropriate points of the this box are transformed back into device coordinates to determine the offsets to the four corners of the vector's outline.
min: VEC ¬ [maxReal, maxReal];
max: VEC ¬ [-maxReal, -maxReal];
delta: VEC ~ Sub[p1, p0];
s: REAL ~ RealInline.Abs[delta.x]+RealInline.Abs[delta.y];
t: Transformation ¬ NIL;
IF s=0.0
THEN {
IF end = ImagerStroke.warningSquareEnd THEN SignalSquareEndWithNoDirection[];
t ← ImagerTransformation.Scale[1];
RETURN;
}
ELSE {
The things called cos and sin may be off by a arbitrary scale factor; the only reason for dividing though by s is to increase the odds of getting an easy transformation so subsequent calculations might go faster.
cos: REAL ~ delta.x/s;
sin: REAL ~ delta.y/s;
t ¬ ImagerTransformation.Create[a: cos, b: -sin, c: 0, d: sin, e: cos, f: 0];
ImagerTransformation.ApplyPostConcat[t, m];
ImagerTransformation.ApplyInvert[t];
};
FOR i:
NAT
IN [0..pen.size)
DO
p: VEC ~ ImagerTransformation.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;
ImagerTransformation.ApplyInvert[t];
IF end = ImagerStroke.buttEnd THEN { min.x ¬ max.x ¬ 0 };
moveTo[Add[d0, ImagerTransformation.TransformVec[t, [min.x, max.y]]]];
lineTo[Add[d0, ImagerTransformation.TransformVec[t, [min.x, min.y]]]];
lineTo[Add[d1, ImagerTransformation.TransformVec[t, [max.x, min.y]]]];
lineTo[Add[d1, ImagerTransformation.TransformVec[t, [max.x, max.y]]]];
ImagerTransformation.Destroy[t];
};
};
nPts: NAT ¬ 6;
RealPlusOrMinus: TYPE ~ RECORD [value: REAL, error: REAL];
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 ¬ maxReal;
max: REAL ¬ 0;
delta:
ARRAY [0..3)
OF
VEC ~ [Sub[p[1], p[0]], Sub[p[2], p[1]], 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 ¬ Add[Vector2.Mul[delta[0], t], Vector2.Mul[delta[1], s]];
d12: VEC ¬ Add[Vector2.Mul[delta[1], t], Vector2.Mul[delta[2], s]];
d012: VEC ¬ 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 ¬ 10;
DivideUntilSmooth:
PROC [p: Bezier, piece:
PROC [p: Bezier, speed:
REAL], fullScale:
REAL, maxDepth:
NAT] ~ {
a: RealPlusOrMinus ¬ AverageSpeed[p];
UNTIL maxDepth <= 1
OR Real.FScale[a.error, sigBits] <= fullScale
DO
Mid:
PROC [a,b:
VEC]
RETURNS [
VEC] ~
INLINE {
RETURN [[(a.x+b.x)*0.5, (a.y+b.y)*0.5]];
};
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];
maxDepth ¬ maxDepth-1;
DivideUntilSmooth[[p[0], p01, p012, p0123], piece, fullScale, maxDepth];
p ¬ [p0123, p123, p23, p[3]];
a ¬ AverageSpeed[p];
ENDLOOP;
IF a.value # 0 THEN 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];
IF t1 # 0.0 THEN {t0 ¬ t0/t1; t1 ¬ 1.0};
};
IF t0 # 0.0 THEN b ¬ SubDivide[b, t0, TRUE];
RETURN [b];
};
MeasurePath:
PUBLIC
PROC [path: PathProc, closed:
BOOL ¬
FALSE]
RETURNS [sum:
REAL ¬ 0.0] ~ {
started: BOOL ¬ FALSE;
sp: VEC ¬ [0,0];
lp: VEC ¬ [0,0];
move:
PROC [p0:
VEC] ~ {
IF started AND closed THEN line[sp];
sp ¬ lp ¬ p0;
started ¬ TRUE;
};
line:
PROC [p1:
VEC] ~ {
sum ¬ sum + Vector2.Length[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, depthLimit];
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];
IF started AND closed THEN line[sp];
};
FirstDashType: TYPE = {line, curve};
FirstDashRep:
TYPE =
RECORD [
dashType: FirstDashType ¬ line,
p1, p2: VEC ¬ [0,0] -- only used if first segment is a curve
ComputeStretch:
PROC [path: ImagerPath.PathProc, length:
REAL]
RETURNS [
REAL] = {
IF length <= 0.0
THEN
RETURN [1.0]
ELSE {
pathUnits: REAL = MeasurePath[path];
IF pathUnits = 0.0 THEN RETURN [1.0];
RETURN [MIN[MAX[pathUnits / length, 1.0e-8], 1.0e+8]];
};
};
AdjustOffset:
PROC [offset:
REAL, patternLen:
NAT, pattern:
PROC [i:
NAT]
RETURNS [
REAL]]
RETURNS [
REAL] = {
patternTotal: REAL ¬ 0.0;
FOR i:
INT
IN [0..patternLen)
DO
element: REAL = pattern[i];
IF element < 0.0
THEN {
ERROR ImagerError.Error[[$illegalArguments, "Negative element in dash pattern"]];
};
patternTotal ¬ patternTotal + element;
ENDLOOP;
IF
NOT (RealInline.IsValid[patternTotal]
AND RealInline.IsPositive[patternTotal])
THEN {
ERROR ImagerError.Error[[$illegalArguments, "Dash pattern sum must be positive"]];
};
IF offset = 0.0
THEN
RETURN [0.0]
ELSE {
r: REAL ¬ offset / patternTotal;
IF
ABS[r] >= 2**20
THEN {
If the offset is this far out, it is pretty meaningless anyway due to roundoff, so just kill it.
RETURN [0.0];
};
RETURN [offset - Real.Floor[r]*patternTotal]
};
};
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, closed:
BOOL ¬
FALSE] = {
The 'closed' argument is provided for the to the PostScript closepath operator. If closed is TRUE, then Dashes will perform a lineto[firstPoint] at the end of the provided path. Emission of the first dash segment is delayed until the end to ensure proper joint closure.
stretch: REAL = ComputeStretch[path, length];
lp, fp, startOfFirstDash, endOfFirstDash: VEC ¬ [0, 0];
index: NAT ¬ 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;
needsClosedSetup: BOOL ¬ closed;
firstDash: FirstDashRep ¬ [dashType: line];
Advance:
PROC [patternOffset:
REAL, startAction, stopAction:
PROC ¬
NIL] = {
anyProgress: BOOL ¬ TRUE;
UNTIL used >= patternOffset
DO
nextUsed: REAL = used + residual;
IF nextUsed > used
-- Test this instead of residual=0.0, because of floating point fuzz.
THEN {
Still have part of the current piece to use up.
nextResidual: REAL = nextUsed - patternOffset;
anyProgress ¬ TRUE;
IF nextResidual <= 0.0
THEN {residual ¬ 0.0; used ¬ nextUsed}
ELSE {residual ¬ nextResidual; 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;
IF
NOT anyProgress
THEN {
We have run through the whole pattern with no progress!
used ¬ patternOffset; -- Bail out silently.
};
anyProgress ¬ FALSE;
};
residual ¬ pattern[index] * stretch;
on ¬ NOT on;
IF on AND startAction # NIL THEN startAction[];
};
ENDLOOP;
};
move:
PROC [p0:
VEC] = {
lp ¬ p0;
IF needsClosedSetup THEN fp ¬ startOfFirstDash ¬ p0;
IF on THEN moveTo[lp]
};
line:
PROC [p1:
VEC] = {
delta: VEC = Sub[p1, lp];
d: REAL = Vector2.Length[delta];
segmentStart: REAL = used;
segmentEnd: REAL = used + d;
start:
PROC = {
s: REAL ¬ (used - segmentStart) / d;
p: VEC ¬ Add[lp, Vector2.Mul[delta, s]];
moveTo[p];
IF needsClosedSetup THEN startOfFirstDash ¬ p;
};
stop:
PROC = {
s: REAL ¬ (used - segmentStart) / d;
p: VEC ¬ Add[lp, Vector2.Mul[delta, s]];
IF needsClosedSetup
THEN {
endOfFirstDash ¬ p;
needsClosedSetup ¬ FALSE;
}
ELSE { lineTo[p] };
};
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 ¬ IF speed = 0.0 THEN 1.0 ELSE (used - segmentStart) / speed;
needMove ¬ TRUE;
};
stop:
PROC = {
dashEndParam: REAL ¬ IF speed = 0.0 THEN 1.0 ELSE (used - segmentStart) / speed;
b: Bezier ¬ SubPiece[p, dashStartParam, dashEndParam];
IF needsClosedSetup
THEN {
startOfFirstDash ¬ b[0];
firstDash.p1 ¬ b[1];
firstDash.p2 ¬ b[2];
endOfFirstDash ¬ b[3];
firstDash.dashType ¬ curve;
needsClosedSetup ¬ FALSE;
RETURN;
};
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, depthLimit];
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[AdjustOffset[offset, patternLen, pattern] * stretch];
path[moveTo: move, lineTo: line, curveTo: curve, conicTo: conic, arcTo: arc];
IF closed
THEN {
IF needsClosedSetup THEN endOfFirstDash ¬ startOfFirstDash;
line[fp];
IF lp # startOfFirstDash THEN moveTo[startOfFirstDash];
IF firstDash.dashType = line
THEN lineTo[endOfFirstDash]
ELSE curveTo[firstDash.p1, firstDash.p2, endOfFirstDash];
};
};
ConvolvePenWithPath:
PUBLIC
PROC [path: ImagerPath.PathProc, pen: Pen, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] ~ {
The path must be wrapped in a counterclockwise direction, and must consist only of line segments.
started, move: BOOL ¬ FALSE;
fp: VEC ¬ [0.0, 0.0];
fi: NAT ¬ 0;
lp: VEC ¬ [0.0, 0.0];
li: NAT ¬ 0;
Move: ImagerPath.MoveToProc ~ {
IF started THEN Close[];
fp ¬ lp ¬ p;
started ¬ TRUE;
move ¬ TRUE;
};
Line: ImagerPath.LineToProc ~ {
dx: REAL ~ p1.x - lp.x;
dy: REAL ~ p1.y - lp.y;
IF
NOT (dx = 0.0
AND dy = 0.0)
THEN {
i: NAT ¬ FindVertex[pen: pen, direction: [dy, -dx], i: li];
IF move
THEN {
fi ¬ li ¬ i;
moveTo[Add[lp, pen[li]]];
move ¬ FALSE;
};
UNTIL li = i
DO
li ¬ AddMod[li, 1, pen.size];
lineTo[Add[lp, pen[li]]];
ENDLOOP;
lineTo[Add[p1, pen[li]]];
};
lp ¬ p1;
};
Close:
PROC ~ {
IF started
THEN {
IF move THEN { fi ¬ pen.size-1; li ¬ 0; moveTo[Add[lp, pen[li]]] } ELSE Line[fp];
UNTIL li = fi
DO
li ¬ AddMod[li, 1, pen.size];
lineTo[Add[fp, pen[li]]];
ENDLOOP;
started ¬ FALSE;
move ¬ FALSE;
};
};
path[moveTo: Move, lineTo: Line, curveTo: NIL, conicTo: NIL, arcTo: NIL];
IF started THEN Close[];
};
MapBitPath:
PUBLIC
PROC [byte:
BYTE, p0, v1, v2:
VEC, moveTo: ImagerPath.MoveToProc, lineTo: ImagerPath.LineToProc] ~ {
swap: BOOL ~ Vector2.InlineCross[v1, v2] < 0;
Emit:
PROC [p0, v1, v2:
VEC] ~ {
IF swap THEN { t: VEC ¬ v1; v1 ¬ v2; v2 ¬ t };
moveTo[p0]; lineTo[Add[p0, v1]]; lineTo[Add[p0, Add[v1, v2]]]; lineTo[Add[p0, v2]];
};
k: CARDINAL ¬ byte;
started: BOOL ¬ FALSE; start: VEC;
pi: VEC ¬ p0;
FOR i:
NAT
IN [0..8]
DO
IF k >= 128
THEN {
k ¬ k - 128;
IF NOT started THEN { started ¬ TRUE; start ¬ pi };
}
ELSE {
IF started
THEN {
Emit[start, v1, Sub[pi, start]];
started ¬ FALSE;
IF k = 0 THEN EXIT;
};
};
k ¬ 2*k;
pi ¬ Add[pi, v2];
ENDLOOP;
};