ImagerPenImpl.mesa
Copyright © 1985 by Xerox Corporation. All rights reserved.
Michael Plass, August 15, 1985 2:16:02 pm PDT
Doug Wyatt, May 19, 1985 5:51:19 pm PDT
DIRECTORY
ImagerPen,
ImagerTransformation,
Real,
RealFns,
Vector2;
ImagerPenImpl: CEDAR MONITOR
IMPORTS ImagerTransformation, Real, RealFns
EXPORTS ImagerPen
~ 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
MakeTransformedCircle: PUBLIC PROC [strokeWidth: REAL, m: Transformation] RETURNS [Pen] ~ {
f: FactoredTransformation ~ ImagerTransformation.Factor[m];
RETURN [MakeEllipse[ABS[f.s.x*strokeWidth], ABS[f.s.y*strokeWidth], f.r2]];
};
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]];
FOR t: VertexList ← v, t.link UNTIL t.link=NIL DO
p[i] ← [Real.FScale[t.coord.x, -1], Real.FScale[t.coord.y, -1]];
i ← i + 1;
ENDLOOP;
FOR t: VertexList ← v, t.link UNTIL t.link=NIL DO
p[i] ← [-Real.FScale[t.coord.x, -1], -Real.FScale[t.coord.y, -1]];
i ← i + 1;
ENDLOOP;
IF i#p.size THEN ERROR;
IF cacheSize > 0 THEN EnterCache[majorAxis, minorAxis, theta, p];
FreeVertexList[v];
};
};
Cache stuff
cacheSize: NAT ← 5;
cache: LIST OF CacheRec ← NIL;
cacheHits: INT ← 0;
cacheMisses: INT ← 0;
CacheRec: TYPE ~ RECORD [
majorAxis, minorAxis, theta: REAL, p: Pen
];
CheckCache: ENTRY PROC [majorAxis, minorAxis: REAL, theta: Degrees] RETURNS [Pen] ~ {
prev: LIST OF CacheRec ← NIL;
FOR c: LIST OF CacheRec ← 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.p];
};
prev ← c;
ENDLOOP;
cacheMisses ← cacheMisses + 1;
RETURN [NIL]
};
EnterCache: ENTRY PROC [majorAxis, minorAxis: REAL, theta: Degrees, pen: Pen] ~ {
new: LIST OF CacheRec ← NIL;
prev: LIST OF CacheRec ← NIL;
i: NAT ← 2;
NB: The following code forces a cache size of >= 2
FOR p: LIST OF CacheRec ← cache, p.rest DO
IF p = NIL THEN {new ← LIST[[majorAxis, minorAxis, theta, pen]]; EXIT};
IF i >= cacheSize AND p.rest#NIL THEN {
new ← p.rest;
p.rest ← NIL;
new.rest ← NIL;
new.first ← [majorAxis, minorAxis, theta, 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
];
Floor: PROC [r: REAL] RETURNS [i: INT] ~ {
i ← Real.Round[r];
IF i > r THEN i ← i-1;
};
Round: PROC [r: REAL] RETURNS [INT] ~ {
RETURN [Floor[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 <= ABS[alpha] THEN {
IF alpha > 0 THEN alpha ← gamma - 1
ELSE alpha ← 1 - gamma;
};
s ← NEW [VertexRep ← [
coord: [alpha, beta],
rightU: undef, leftV: 1,
rightClass: undef, leftLength: gamma - alpha,
link: NIL
]];
r ← NEW [VertexRep ← [
coord: [gamma, beta],
rightU: 0, leftV: 0,
rightClass: beta, leftLength: beta + beta,
link: s
]];
q ← NEW [VertexRep ← [
coord: [gamma, -beta],
rightU: 1, leftV: -1,
rightClass: gamma, leftLength: gamma + alpha,
link: r
]];
halfPen ← p ← NEW [VertexRep ← [
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;
};
InsertLineBetweenpq: PROC [u, v: REAL, delta: INT] ~ {
s ← NEW[VertexRep ← [
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;
};
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 InsertLineBetweenpq[u, v, delta];
}
ELSE p ← q;
IF NOT MoveToNextpqr[].found 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;
};
FreeNode: PROC [p: REF VertexRep] ~ {p.link ← NIL};
FreeVertexList: PROC [p: VertexList] ~ {
UNTIL p = NIL DO t: VertexList ← p.link; p.link ← NIL; p ← t; 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.