ImagerPenImpl.mesa
Copyright Ó 1985, 1987, 1989, 1990, 1991, 1992 by Xerox Corporation. All rights reserved.
Michael Plass, August 18, 1992 2:09 pm PDT
Doug Wyatt, May 19, 1985 5:51:19 pm PDT
Russ Atkinson (RRA) December 18, 1990 11:48 am PST
DIRECTORY
ImagerPen USING [PenRep],
ImagerPenExtras USING [],
ImagerTransformation USING [Destroy, Factor, FactoredTransformation, NumericalInstability, PostScale2, Transformation],
RealInline USING [MCFloor],
RealFns USING [CosDeg, SinDeg, SqRt],
Vector2 USING [VEC];
ImagerPenImpl: CEDAR MONITOR
IMPORTS ImagerTransformation, RealInline, RealFns
EXPORTS ImagerPen, ImagerPenExtras
~ BEGIN
VEC: TYPE ~ Vector2.VEC;
Transformation: TYPE ~ ImagerTransformation.Transformation;
FactoredTransformation: TYPE ~ ImagerTransformation.FactoredTransformation;
Pen: TYPE ~ REF PenRep;
Degrees: TYPE ~ REAL;
PenRep: TYPE ~ ImagerPen.PenRep;
Public procedures
hairline: Pen ~ MakeEllipse[0, 0, 0];
ScaleFactor: PROC [a, b, strokeWidth, thickening: REAL, minThickness: REAL] RETURNS [REAL] = {
e: REAL = RealFns.SqRt[a*a + b*b];
IF e = 0.0 THEN RETURN [strokeWidth]; -- The transformation is singular; forget thickening
RETURN [MAX[0.0, minThickness/e, strokeWidth + thickening/e]];
};
MakeTransformedCircle: PUBLIC PROC
[strokeWidth: REAL, m: Transformation, thickening: VEC ¬ [0.0, 0.0]]
RETURNS [Pen] ~ {
RETURN [MakeThickenedTransformedCircle[strokeWidth: strokeWidth, m: m, thickening: thickening, minThickness: [0.0, 0.0]]]
};
MakeThickenedTransformedCircle: PUBLIC PROC
[strokeWidth: REAL, m: Transformation, thickening: VEC ¬ [0.0, 0.0], minThickness: VEC ¬ [0.0, 0.0]]
RETURNS [Pen] ~ {
IF strokeWidth = 0.0 AND thickening.x < 0.5 AND thickening.y < 0.5 AND minThickness.x < 0.5 AND minThickness.y < 0.5
THEN {
Zero-width stroke - this one's easy.
RETURN [hairline]
}
ELSE {
sx: REAL ~ ScaleFactor[m.a, m.b, strokeWidth, thickening.x, minThickness.x];
sy: REAL ~ ScaleFactor[m.d, m.e, strokeWidth, thickening.y, minThickness.y];
mm: Transformation ~ ImagerTransformation.PostScale2[m: m, s: [sx, sy]];
f: FactoredTransformation ~ ImagerTransformation.Factor[mm ! ImagerTransformation.NumericalInstability => RESUME];
majorAxis: REAL ¬ ABS[f.s.x];
minorAxis: REAL ¬ ABS[f.s.y];
theta: Degrees ¬ f.r2;
IF majorAxis < minorAxis THEN {
t: REAL ¬ majorAxis; majorAxis ¬ minorAxis; minorAxis ¬ t;
theta ¬ theta + 90.0;
};
WHILE theta > 90.0 DO theta ¬ theta - 180.0 ENDLOOP;
WHILE theta <= -90.0 DO theta ¬ theta + 180.0 ENDLOOP;
ImagerTransformation.Destroy[mm];
RETURN [MakeEllipse[majorAxis: majorAxis, minorAxis: minorAxis, theta: theta]];
};
};
Half: PROC [real: REAL] RETURNS [REAL] ~ INLINE { RETURN [0.5 * real] };
MakeEllipse: PUBLIC PROC [majorAxis, minorAxis: REAL, theta: Degrees] RETURNS [p: Pen] ~ {
IF cacheSize > 0 AND (p ¬ CheckCache[majorAxis, minorAxis, theta])#NIL THEN RETURN
ELSE {
v: VertexList ~ MakeHalfEllipse[majorAxis, minorAxis, theta];
n: NAT ~ CountVertexList[v]-1;
i: NAT ¬ 0;
p ¬ NEW[PenRep[n*2]];
p.majorAxis ¬ majorAxis;
p.minorAxis ¬ minorAxis;
p.theta ¬ theta;
FOR t: VertexList ¬ v, t.link UNTIL t.link=NIL DO
p[i] ¬ [Half[t.coord.x], Half[t.coord.y]];
i ¬ i + 1;
ENDLOOP;
FOR t: VertexList ¬ v, t.link UNTIL t.link=NIL DO
p[i] ¬ [-Half[t.coord.x], -Half[t.coord.y]];
i ¬ i + 1;
ENDLOOP;
FOR i: NAT IN [0..p.size) DO
p.bounds.x ¬ MAX[p.bounds.x, ABS[p[i].x]];
p.bounds.y ¬ MAX[p.bounds.y, ABS[p[i].y]];
ENDLOOP;
IF i#p.size THEN ERROR;
IF cacheSize > 0 THEN EnterCache[p];
FreeVertexList[v];
};
};
Cache stuff
cacheSize: NAT ¬ 5;
cache: LIST OF Pen ¬ NIL;
cacheHits: INT ¬ 0;
cacheMisses: INT ¬ 0;
CheckCache: ENTRY PROC [majorAxis, minorAxis: REAL, theta: Degrees] RETURNS [Pen] ~ {
prev: LIST OF Pen ¬ NIL;
FOR c: LIST OF Pen ¬ cache, c.rest UNTIL c = NIL DO
IF c.first.majorAxis = majorAxis
AND c.first.minorAxis = minorAxis
AND (c.first.theta = theta OR majorAxis=minorAxis) THEN {
IF prev # NIL THEN {
Move to front
prev.rest ¬ c.rest;
c.rest ¬ cache;
cache ¬ c;
};
cacheHits ¬ cacheHits + 1;
RETURN [c.first];
};
prev ¬ c;
ENDLOOP;
cacheMisses ¬ cacheMisses + 1;
RETURN [NIL]
};
EnterCache: ENTRY PROC [pen: Pen] ~ {
majorAxis: REAL ~ pen.majorAxis;
minorAxis: REAL ~ pen.minorAxis;
theta: Degrees ~ pen.theta;
new: LIST OF Pen ¬ NIL;
prev: LIST OF Pen ¬ NIL;
i: NAT ¬ 2;
NB: The following code forces a cache size of >= 2
FOR p: LIST OF Pen ¬ cache, p.rest DO
IF p = NIL THEN {new ¬ LIST[pen]; EXIT};
IF i >= cacheSize AND p.rest#NIL THEN {
new ¬ p.rest;
p.rest ¬ NIL;
new.rest ¬ NIL;
new.first ¬ pen;
EXIT;
};
i ¬ i + 1;
ENDLOOP;
new.rest ¬ cache;
cache ¬ new;
};
Elliptical pen construction
VertexList: TYPE ~ REF VertexRep;
VertexRep: TYPE ~ RECORD [
coord: Vector2.VEC,
rightU, leftV: REAL,
rightClass: INT,
leftLength: INT,
link: REF VertexRep
];
Round: PROC [r: REAL] RETURNS [INT] ~ {
RETURN [RealInline.MCFloor[r+0.5]];
};
MakeHalfEllipse: PROC [semiMajorAxis, semiMinorAxis: REAL, theta: REAL] RETURNS [halfPen: VertexList] ~ {
Makes one-half of a polygonal approximation to an elliptical pen, using an algorithm developed by John Hobby and Donald Knuth. Refer to section 25 of Metafont 84 for more details about how it works. The half-pen has all vertices on integer coordinates.
undef: INT ~ -99999;
cos: REAL ~ RealFns.CosDeg[theta];
sin: REAL ~ RealFns.SinDeg[theta];
p, q, r, s: VertexList;
Initialize the ellipse data structure by beginning with directions (0, -1), (1, 0), and (0, 1)
BEGIN
alpha, beta, gamma: INT;
[alpha, beta, gamma] ¬ CalculateGreek[semiMajorAxis, semiMinorAxis, cos, sin];
It is an invariant of the pen data structure that all the points are distinct. This revises the values of alpha, beta, and gamma so that degenerate lines of length 0 will not be obtained.
IF beta = 0 THEN beta ¬ 1;
IF gamma = 0 THEN gamma ¬ 1;
IF gamma <= INT[ABS[alpha]] THEN {
IF alpha > 0 THEN alpha ¬ gamma - 1
ELSE alpha ¬ 1 - gamma;
};
s ¬ AllocNode[
coord: [alpha, beta],
rightU: undef, leftV: 1,
rightClass: undef, leftLength: gamma - alpha,
link: NIL];
r ¬ AllocNode[
coord: [gamma, beta],
rightU: 0, leftV: 0,
rightClass: beta, leftLength: beta + beta,
link: s];
q ¬ AllocNode[
coord: [gamma, -beta],
rightU: 1, leftV: -1,
rightClass: gamma, leftLength: gamma + alpha,
link: r];
halfPen ¬ p ¬ AllocNode[
coord: [-alpha, -beta],
rightU: 0, leftV: undef,
rightClass: beta, leftLength: undef,
link: q];
END;
Interpolate new vertices in the ellipse data structure until improvement is impossible.
BEGIN
MoveToNextpqr: PROC RETURNS [found: BOOL] ~ {
DO
q ¬ p.link;
IF q = NIL THEN RETURN [found: FALSE];
IF q.leftLength = 0
THEN {
p.link ¬ q.link;
p.rightClass ¬ q.rightClass;
p.rightU ¬ q.rightU;
FreeNode[q];
}
ELSE {
r ¬ q.link;
IF r = NIL THEN RETURN [found: FALSE];
IF r.leftLength = 0 THEN {
p.link ¬ r;
FreeNode[q];
p ¬ r;
}
ELSE RETURN [found: TRUE];
};
ENDLOOP;
};
RemoveLinepqAndAdjustq: PROC [u, v: REAL] ~ {
At this point there is a line of length <= delta from vertex p to vertex q, orthogonal to direction (p.rightU, q.leftV), and there's a line of length >= delta from vertex q to vertex r, orthogonal to direction (q.rightU, r.leftV). The best line to direction (u, v) should replace the line from p to q; this new line will have the same length as the old.
delta: INT ~ q.leftLength;
p.rightClass ¬ (p.rightClass + q.rightClass) - delta;
p.rightU ¬ u;
q.leftV ¬ v;
q.coord ¬ [x: q.coord.x - delta*r.leftV, y: q.coord.y + delta*q.rightU];
r.leftLength ¬ r.leftLength - delta;
};
DO
u: REAL ~ p.rightU + q.rightU;
v: REAL ~ q.leftV + r.leftV;
delta: INT ¬ (p.rightClass + q.rightClass) - IntegerDistanceToEllipseTowards[u, v, semiMajorAxis, semiMinorAxis, cos, sin];
IF delta > 0
THEN {
Want to move delta steps back from the intersection vertex q.
delta ¬ MIN[delta, r.leftLength];
IF delta >= q.leftLength
THEN RemoveLinepqAndAdjustq[u, v]
ELSE {
s ¬ AllocNode[
coord: [q.coord.x + delta*q.leftV, q.coord.y - delta*p.rightU],
rightU: u, leftV: q.leftV,
rightClass: (p.rightClass + q.rightClass)-delta,
leftLength: q.leftLength-delta,
link: q
];
p.link ¬ s;
q.coord ¬ [x: q.coord.x - delta*r.leftV, y: q.coord.y + delta*q.rightU];
q.leftV ¬ v;
q.leftLength ¬ delta;
r.leftLength ¬ r.leftLength-delta;
};
}
ELSE p ¬ q;
IF NOT MoveToNextpqr[] THEN EXIT;
ENDLOOP;
END;
Now we use a somewhat tricky fact: the pointer q will be NIL iff the line for the final direction (0,1) has been removed. It that line still survives, it should be combined with a possibly surviving line in the initial direction (0,-1).
BEGIN
IF q # NIL THEN {
IF halfPen.rightU=0 THEN {
p ¬ halfPen;
halfPen ¬ p.link;
FreeNode[p];
q.coord.x ¬ -halfPen.coord.x;
};
p ¬ q;
}
ELSE q ¬ p;
END;
};
freeNodes: REF VertexRep ¬ NIL;
AllocNode: ENTRY PROC [
coord: Vector2.VEC, rightU, leftV: REAL, rightClass: INT, leftLength: INT,
link: REF VertexRep ¬ NIL]
RETURNS [REF VertexRep] ~ {
p: REF VertexRep ¬ freeNodes;
IF p # NIL
THEN {
freeNodes ¬ p.link;
p­ ¬ [coord: coord, rightU: rightU, leftV: leftV,
rightClass: rightClass, leftLength: leftLength,
link: link];
}
ELSE
p ¬ NEW[VertexRep ¬ [
coord: coord, rightU: rightU, leftV: leftV,
rightClass: rightClass, leftLength: leftLength,
link: link]];
RETURN [p];
};
FreeNode: ENTRY PROC [p: REF VertexRep] ~ {
IF p # NIL THEN {
p.link ¬ freeNodes;
freeNodes ¬ p;
};
};
FreeVertexList: ENTRY PROC [p: VertexList] ~ {
lag: VertexList ¬ p;
IF lag # NIL THEN DO
next: VertexList = lag.link;
IF next = NIL THEN {
lag.link ¬ freeNodes;
freeNodes ¬ p;
RETURN;
};
lag ¬ next;
ENDLOOP;
};
CountVertexList: PROC [p: VertexList] RETURNS [n: NAT ¬ 0] ~ {
UNTIL p = NIL DO p ¬ p.link; n ¬ n + 1 ENDLOOP
};
PythAdd: PROC [a, b: REAL] RETURNS [c: REAL] ~ {
c ¬ RealFns.SqRt[a*a + b*b];
};
CalculateGreek: PROC [semiMajorAxis, semiMinorAxis: REAL, cos, sin: REAL] RETURNS [INT, INT, INT] ~ {
a, b, g: REAL;
IF sin = 0.0 OR semiMajorAxis = semiMinorAxis THEN {
a ¬ 0;
b ¬ semiMinorAxis;
g ¬ semiMajorAxis;
}
ELSE {
d: REAL ¬ semiMinorAxis*cos;
g ¬ semiMajorAxis*sin;
b ¬ PythAdd[g, d];
a ¬ semiMajorAxis*(g/b)*cos - semiMinorAxis*(d/b)*sin;
g ¬ PythAdd[semiMajorAxis*cos, semiMinorAxis*sin];
};
RETURN [Round[a], Round[b], Round[g]]
};
IntegerDistanceToEllipseTowards: PROC
[u, v: REAL, semiMajorAxis, semiMinorAxis: REAL, cos, sin: REAL] RETURNS [INT] ~ {
Compute the distance from class 0 to the edge of the ellipse in direction (u, v), times PythAdd[u, v], rounded to the nearest integer.
alpha: REAL ~ (u*cos + v*sin);
beta: REAL ~ (v*cos - u*sin);
dReal: REAL ~ PythAdd[semiMajorAxis*alpha, semiMinorAxis*beta];
RETURN [Round[MAX[dReal, u, v]]];
};
END.