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;
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 {
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];
};
};
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 {
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;
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;
};
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] ~ {
undef: INT ~ -99999;
cos: REAL ~ RealFns.CosDeg[theta];
sin: REAL ~ RealFns.SinDeg[theta];
p, q, r, s: VertexList;
BEGIN
alpha, beta, gamma: INT;
[alpha, beta, gamma] ¬ CalculateGreek[semiMajorAxis, semiMinorAxis, cos, sin];
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;
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] ~ {
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 {
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;
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] ~ {
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.
&
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

Public procedures
Zero-width stroke - this one's easy.
Cache stuff
Move to front
NB: The following code forces a cache size of >= 2
Elliptical pen construction
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.
Initialize the ellipse data structure by beginning with directions (0, -1), (1, 0), and (0, 1)
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. 
Interpolate new vertices in the ellipse data structure until improvement is impossible.
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.
Want to move delta steps back from the intersection vertex q.
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).
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.
Κ
{–
(cedarcode) style•NewlineDelimiter

™
head™Icodešœ
Οe
œO™ZL™*L™'L™2L™š
Οk	˜	Lšœ
žœ
˜Lšœžœ˜Lšœžœ]˜wLšœžœ˜Lšœžœ˜%Lšœžœžœ˜——šΟn
œžœ
ž˜Lšžœ*˜1Lšžœ˜"Lšœž˜L˜Lšžœžœžœ
˜Lšœžœ'˜;Lšœžœ/˜KLšœžœžœ˜Lšœ	žœžœ
˜Lšœžœ˜ —™˜%L˜—šŸœžœ!žœžœžœžœ˜^Lšœžœ˜"Lšžœ	žœ
žœΟc4˜ZLšžœžœ3˜>Lš
œ˜L˜—šŸœžœ
žœžœ!žœžœ
˜yLšžœs˜yLš
œ˜L˜—šŸœžœ
žœžœ!žœžœžœ
˜’
š
žœžœžœžœžœ˜tšžœ˜J™$Lšžœ˜L˜
—šžœ˜LšœžœD˜LLšœžœD˜LLš
œH˜HLšœjžœ˜rLšœžœžœ˜Lšœžœžœ˜Lš
œ˜šžœžœ˜Lšœžœ3˜:Lš
œ˜Lš
œ˜—Lšžœžœžœ
˜4Lšžœžœžœ
˜6L˜!LšžœI˜OLš
œ˜——Lš
œ˜L˜—šŸœžœžœžœžœžœžœ˜HL˜—š
Ÿœžœ
žœžœžœ
˜ZLš	žœžœ/žœ
žœ
ž˜Ršžœ˜Lš
œ=˜=Lšœžœ˜Lšœžœ˜Lšœžœ˜L˜L˜L˜šžœžœžœ
ž˜1L˜*L˜
Lšžœ
˜—šžœžœžœ
ž˜1L˜,L˜
Lšžœ
˜—šžœžœ
žœ
ž˜Lšœ
žœ
žœ
˜*Lšœ
žœ
žœ
˜*Lšžœ
˜—Lšžœ
žœ
žœ
˜Lšžœžœ˜$Lš
œ˜Lš
œ˜—Lš
œ˜——š
œ™Lšœžœ˜Lšœžœ
žœžœ
˜Lšœžœ˜šœ
žœ˜L˜—š
Ÿ
œžœ
žœžœžœ
˜ULšœžœ
žœžœ
˜šžœžœ
žœžœžœ
ž˜3Lšžœ˜ Lšžœ˜!šžœžœžœ˜9šžœžœ
žœ˜L™
Lš
œ˜Lš
œ˜Lš
œ
˜
Lš
œ˜—Lš
œ˜Lšžœ˜Lš
œ˜—Lš
œ	˜	Lšžœ
˜—Lš
œ˜Lšžœžœ
˜Lš
œ˜L˜—šŸ
œžœ
žœ˜%Lšœžœ˜ Lšœžœ˜ L˜Lšœžœ
žœžœ
˜Lšœžœ
žœžœ
˜Lšœžœ˜L™2šžœžœ
žœž˜%Lš
žœžœ
žœžœžœ˜(šžœžœžœ
žœ˜'Lš
œ
˜
Lšœ	žœ
˜
Lšœžœ
˜L˜Lšžœ
˜Lš
œ˜—L˜
Lšžœ
˜—Lš
œ˜Lš
œ˜Lš
œ˜——™šœžœžœ˜!L˜—šœžœžœ˜Lšœžœ
˜Lšœžœ
˜Lšœžœ
˜Lšœžœ
˜Lšœžœ
˜Lš
œ˜L˜—š
Ÿœžœžœžœžœ˜'Lšžœ˜#Lš
œ˜L˜—š
Ÿœžœ žœ	žœžœ˜iL™ώ
Lšœžœ
˜Lšœžœ˜"Lšœžœ˜"Lš
œ˜Lš
œ^™^š
ž˜Lšœžœ
˜Lš
œN˜Nš
œ½
™½
Lšžœ
žœ
˜Lšžœžœ˜šžœ
žœ
žœ	žœ˜"Lšžœžœ˜#Lšžœ˜Lš
œ˜——š
œ˜Lš
œ˜Lš
œ˜Lš
œ-˜-Lšœžœ˜—š
œ˜Lš
œ˜Lš
œ˜Lš
œ*˜*Lš
œ	˜	—š
œ˜Lš
œ˜Lš
œ˜Lš
œ-˜-Lš
œ	˜	—š
œ˜Lš
œ˜Lš
œ˜Lš
œ$˜$Lš
œ	˜	—Lšžœ
˜—Lš
œW™Wš
ž˜šŸ
œžœ
žœ	žœ˜-š
ž˜L˜Lš
žœžœ
žœ
žœ	žœ˜&šžœ˜šžœ˜L˜L˜Lš
œ˜L˜Lš
œ
˜
—šžœ˜L˜Lš
žœžœ
žœ
žœ	žœ˜&šžœžœ˜L˜L˜L˜Lš
œ
˜
—Lšžœ
žœ	žœ˜Lš
œ˜——Lšžœ
˜—Lš
œ˜—šŸœžœžœ˜-L™βLšœžœ˜Lš
œ5˜5L˜
L˜Lš
œH˜HLš
œ$˜$L˜—š
ž˜Lšœžœ˜Lšœžœ˜Lšœžœq˜{šžœ
˜šžœ˜L™=Lšœžœ˜!šžœ˜Lšžœ˜!šžœ˜Lš
œΕ
˜Ε
L˜Lš
œH˜HL˜L˜L˜"L˜——Lš
œ
˜
—Lšžœ˜—Lšžœ
žœžœ
žœ
˜!Lšžœ
˜—Lšžœ
˜—L™ν
š
ž˜šžœžœ
žœ˜•StartOfExpansion[]šžœžœ˜L˜L˜L˜L˜Lš
œ˜—L˜Lš
œ
˜
—Lšžœ˜Lšžœ
˜—Lš
œ˜L˜—šœžœ
žœ
˜L˜—šŸ	œžœ
žœžœžœžœžœžœ
žœžœžœ˜™
Lšœžœ˜šžœž˜
šžœ˜Lš
œ˜Lš
œn˜nL˜
—š
ž˜Lšœžœx˜——Lšžœ˜Lš
œ˜L˜—šŸœžœ
žœžœ˜+šžœžœ
žœ˜Lš
œ˜Lš
œ˜L˜—Lš
œ˜L˜—šŸœžœ
žœ˜.Lš
œ˜šžœžœ
žœ
ž˜Lš
œ˜šžœžœ
žœ˜Lš
œ˜Lš
œ˜Lšžœ
˜L˜—Lš
œ˜Lšžœ
˜—L˜L˜—šŸœžœžœžœ	˜>Lšžœžœ
žœž˜.L˜L˜—š
Ÿœžœžœžœžœ˜0Lš
œ˜L˜L˜—šŸœžœ žœžœžœžœžœžœ˜eLšΠgl
œ‘
œ‘
œžœ
˜šžœžœžœ˜4Lš‘
œ˜Lš‘
œ˜Lš‘
œ˜Lš
œ
˜
—šžœ˜Lš‘
œžœ˜Lš‘
œ˜Lš‘
œ‘
œ‘
œ˜Lš
‘
œ‘
œ
‘
œ‘
œ
‘
œ˜6Lš‘
œ1˜2Lš
œ˜—Lšžœ‘
œ	‘
œ	‘
œ˜%Lš
œ˜L˜—šŸœžœžœ žœžœžœžœ˜xL™†
Lšœžœ˜Lšœžœ˜Lšœžœ4˜?Lšžœžœ˜!Lš
œ˜L˜——L˜Lšžœ
˜—…—!ά6}