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];
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]};
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:
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.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-- {
Hopefully the extra bits in the word are all zero; does the compiler guarantee this?
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
] ~ {
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].
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 => {
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];
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] ~ {
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 ~ 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 {
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 ~ 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 {
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 ← 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] ~ {
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 ~ [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:
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 {
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] ~ {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];
};