IIScanCvImpl.mesa
Copyright Ó 1986 by Xerox Corporation. All rights reserved.
Michael Plass, November 25, 1986 1:55:05 pm PST
DIRECTORY Basics, IIManhattan, IIScanConverter, IIPath, II, Real, RealFns, Scaled, SF, IISample;
IIScanCvImpl: CEDAR PROGRAM
IMPORTS Basics, IIManhattan, IIPath, Real, RealFns, Scaled, SF, IISample
EXPORTS IIScanConverter
~ BEGIN
Pair: TYPE ~ RECORD [s, f: REAL];
RealBox: TYPE ~ RECORD [min, max: Pair ← [0, 0]];
ExternalHalfPlane: TYPE ~ {sLo, sHi, fLo, fHi};
Region: TYPE ~ PACKED ARRAY ExternalHalfPlane OF BOOL;
AreaState: TYPE ~ {nil, awaitMove, awaitLine, complete, completeMonotone};
WrapFillRule: TYPE ~ {nonZero, odd};
Edge: TYPE ~ REF EdgeRep;
Edges: TYPE ~ REF EdgeRep;
EdgeRep: TYPE ~ RECORD [
sMin: INTEGER, -- First scan line touched
sCount: NAT, -- Number of scan lines touched
f0: Scaled.Value, -- Initial value of f
df: Scaled.Value, -- df/ds
link: REF EdgeRep
];
Area: TYPE ~ REF AreaRep;
AreaRep: TYPE ~ RECORD [
bounds: SF.Box, -- For clipping as the area is built
realBounds: RealBox, -- Floating-point version of same
tightBounds: SF.Box, -- Computed bounding box of area
state: AreaState, -- Indicates state of outline
moveCount: INT, -- Number of MoveTo calls
firstPt: Pair,  -- Argument of most recent MoveTo
firstRegion: Region, -- Region of most recent MoveTo
lastPt: Pair,  -- Most recent point inserted
lastRegion: Region, -- Region of lastPt
totalCrossings: INT, -- Total number of scan-line crossings
increasingEdges: Edges, -- Edges that were increasing in s
decreasingEdges: Edges, -- Edges that were decreasing in s
freeEdges: Edges, -- Avail list of edges for reuse
tolerance: REAL-- For subdividing curves
];
checking: BOOLTRUE;
Enables some consistency checks that shouldn't be needed when the bugs are out.
Change to a compile-time FALSE for production.
Union: PROC [a, b: Region] RETURNS [Region] ~ INLINE {
RETURN [LOOPHOLE[Basics.BITOR[LOOPHOLE[a], LOOPHOLE[b]]]];
};
Odd: PROC [i: INTEGER] RETURNS [BOOL] ~ INLINE {
RETURN [LOOPHOLE[Basics.BITAND[LOOPHOLE[i], 1]]]
};
Floor: PROC [r: REAL] RETURNS [i: INT] ~ INLINE {
i ← Real.Round[r];
IF i > r THEN i ← i - 1;
};
Ceiling: PROC [r: REAL] RETURNS [i: INT] ~ INLINE {
i ← Real.Round[r];
IF i < r THEN i ← i + 1;
};
Round: PROC [r: REAL] RETURNS [INT] ~ INLINE {
RETURN [Floor[r+0.5]]
};
Create: PUBLIC PROC RETURNS [Area] ~ {
area: Area ~ NEW[AreaRep ← [
bounds: [],
realBounds: [],
tightBounds: [],
state: nil,
moveCount: 0,
firstPt: [0, 0],
firstRegion: ALL[FALSE],
lastPt: [0, 0],
lastRegion: ALL[FALSE],
totalCrossings: 0,
increasingEdges: NIL,
decreasingEdges: NIL,
freeEdges: NIL,
tolerance: 1.0
]];
RETURN [area]
};
FreeEdges: PROC [area: Area, edges: Edges] RETURNS [nil: Edges ← NIL] ~ {
IF edges # NIL THEN {
last: Edges ← edges;
WHILE last.link # NIL DO last ← last.link ENDLOOP;
last.link ← area.freeEdges;
area.freeEdges ← edges;
};
};
SetBounds: PROC [area: Area, box: SF.Box] ~ {
IF box.max.s < box.min.s THEN box.max.s ← box.min.s;
IF box.max.f < box.min.f THEN box.max.f ← box.min.f;
area.bounds ← box;
area.realBounds ← [min: [s: box.min.s, f: box.min.f], max: [s: box.max.s, f: box.max.f]];
area.tightBounds ← [min: SF.maxVec, max: SF.minVec];
area.state ← awaitMove;
area.moveCount ← 0;
area.firstPt ← [0, 0];
area.lastPt ← [0, 0];
area.totalCrossings ← 0;
area.increasingEdges ← FreeEdges[area, area.increasingEdges];
area.decreasingEdges ← FreeEdges[area, area.decreasingEdges];
};
RegionOf: PROC [area: Area, pt: Pair] RETURNS [Region] ~ {
region: Region ~ [
sLo: pt.s < area.realBounds.min.s,
sHi: pt.s > area.realBounds.max.s,
fLo: pt.f < area.realBounds.min.f,
fHi: pt.f > area.realBounds.max.f
];
RETURN [region]
};
MoveTo: PROC [area: Area, pt: Pair] ~ {
Close[area];
area.firstPt ← area.lastPt ← pt;
area.firstRegion ← area.lastRegion ← RegionOf[area, pt];
area.state ← awaitLine;
area.moveCount ← area.moveCount + 1;
};
Close: PROC [area: Area] ~ {
IF area.state = awaitLine THEN LineTo[area, area.firstPt];
area.state ← awaitMove;
};
LineTo: PROC [area: Area, pt: Pair] ~ {
region: Region ~ RegionOf[area, pt];
IF Union[region, area.lastRegion] = ALL[FALSE]
THEN AppendSeg[area, area.lastPt, pt] -- Whole segment is visible
ELSE ClipSeg[area: area, p0: area.lastPt, r0: area.lastRegion, p1: pt, r1: region];
area.lastPt ← pt;
area.lastRegion ← region;
};
Half: PROC [r: REAL] RETURNS [REAL] ~ INLINE {
RETURN [Real.FScale[r, -1]]
};
Mid: PROC [p, q: Pair] RETURNS [Pair] ~ INLINE {
RETURN [[Half[p.s+q.s], Half[p.f+q.f]]]
};
ParTo: PROC [area: Area, p1, p2: Pair] ~ {
p0: Pair ~ area.lastPt;
Flat: PROC RETURNS [BOOL] ~ {
s01: REAL ~ p0.s-p1.s;
f01: REAL ~ p0.f-p1.f;
s21: REAL ~ p2.s-p1.s;
f21: REAL ~ p2.f-p1.f;
IF s01*s21 + f01*f21 > 0.0
THEN RETURN [FALSE] -- dot product indicates angle is acute
ELSE {
d: REAL ~ MAX[ABS[p2.s-p0.s], ABS[p2.f-p0.f]];
IF d < 1.0 THEN RETURN [TRUE];
IF ABS[s01*f21 - s21*f01] < area.tolerance * d THEN RETURN [TRUE];
RETURN [FALSE];
};
};
IF Flat[]
THEN {
This picks the two-line-segment approximation to the parabola that minimizes the absolute area between the approximation and the parabola, (keeping the same endpoints).
w02: REAL ~ 0.1767766953;
w1: REAL ~ 0.6464466094;
s012: REAL ~ (p0.s+p2.s)*w02 + p1.s*w1;
f012: REAL ~ (p0.f+p2.f)*w02 + p1.f*w1;
LineTo[area, [s012, f012]];
LineTo[area, p2];
}
ELSE {
p10: Pair ~ Mid[p0, p1];
p12: Pair ~ Mid[p1, p2];
p012: Pair ~ Mid[p10, p12];
ParTo[area, p10, p012];
ParTo[area, p12, p2];
};
};
CurveTo: PROC [area: Area, p1, p2, p3: Pair] ~ {
R: PROC [p, q: REAL] RETURNS [REAL] ~ INLINE { RETURN [q + Half[q-p]] };
Ext: PROC [p, q: Pair] RETURNS [Pair] ~ INLINE { RETURN [[R[p.s, q.s], R[p.f, q.f]]] };
p0: Pair ~ area.lastPt;
q1: Pair ~ Ext[p0, p1];
q2: Pair ~ Ext[p3, p2];
IF ABS[q1.s-q2.s]+ABS[q1.f-q2.f] < 1.0
THEN { ParTo[area, Mid[q1, q2], p3] }
ELSE {
p01: Pair ~ Mid[p0, p1];
p12: Pair ~ Mid[p1, p2];
p23: Pair ~ Mid[p2, p3];
p012: Pair ~ Mid[p01, p12];
p123: Pair ~ Mid[p12, p23];
p0123: Pair ~ Mid[p012, p123];
CurveTo[area, p01, p012, p0123];
CurveTo[area, p123, p23, p3];
};
};
ConicTo: PROC [area: Area, p1, p2: Pair, r: REAL] ~ {
SELECT r FROM
> 0.9999 => { LineTo[area, p1]; LineTo[area, p2] };
<= 0.0 => { LineTo[area, p2] };
ENDCASE => {
p0: Pair ~ area.lastPt;
p02: Pair ~ Mid[p0, p2];
m: Pair ~ [p1.s-p02.s, p1.f-p02.f];
IF (ABS[m.s]+ABS[m.f])*ABS[r-0.5] < 1.0
THEN { ParTo[area, p1, p2] }
ELSE {
q: Pair ~ [m.s*r+p02.s, m.f*r+p02.f];
rNew: REAL ~ 1.0/(1.0+RealFns.SqRt[2.0*(1-r)]);
ConicTo[area, [(p1.s-p0.s)*r+p0.s, (p1.f-p0.f)*r+p0.f], q, rNew];
ConicTo[area, [(p1.s-p2.s)*r+p2.s, (p1.f-p2.f)*r+p2.f], p2, rNew];
};
};
};
ScaledNatMul: PROC [s: Scaled.Value, c: NAT] RETURNS [Scaled.Value] ~ INLINE {
num: Basics.LongNumber ← [lc[Basics.LongMult[s.fraction, c]]];
num.hi ← num.hi + LOOPHOLE[s.integerPart*c, CARDINAL];
RETURN [LOOPHOLE[num]]
};
AppendSeg: PROC [area: Area, point0, point1: Pair] ~ {
incr: BOOL ~ point0.s <= point1.s;
p0: Pair ~ IF incr THEN point0 ELSE point1;
p1: Pair ~ IF incr THEN point1 ELSE point0;
sMin: INTEGER ~ Round[p0.s];
sMax: INTEGER ~ Round[p1.s];
IF sMin # sMax THEN {
Know that p1.s-p0.s is bounded away from 0, and ABS[p1.f-p0.f] <= LAST[CARDINAL], so the following divide should not trap.
slope: REAL ~ (p1.f-p0.f)/(p1.s-p0.s);
sCount: NAT ~ sMax-sMin;
fStart: REAL ~ p0.f + slope*(REAL[sMin]+0.5-p0.s);
e: EdgeRep ~ [
sMin: sMin, -- First scan line touched
sCount: sCount,
f0: Scaled.FromReal[fStart+0.5],
df: IF sCount > 1 THEN Scaled.FromReal[slope] ELSE Scaled.zero,
link: NIL
];
f0: INTEGER ~ e.f0.integerPart;
f1: INTEGER ~ (e.f0.PLUS[ScaledNatMul[e.df, sCount-1]]).integerPart;
fMin: INTEGER ~ MIN[f0, f1];
fMax: INTEGER ~ MAX[f0, f1];
new: Edges ← NIL;
area.totalCrossings ← area.totalCrossings + sCount;
IF area.tightBounds.min.f > fMin THEN area.tightBounds.min.f ← fMin;
IF area.tightBounds.max.f < fMax THEN area.tightBounds.max.f ← fMax;
IF area.tightBounds.min.s > sMin THEN area.tightBounds.min.s ← sMin;
IF area.tightBounds.max.s < sMax THEN area.tightBounds.max.s ← sMax;
IF area.freeEdges # NIL
THEN { new ← area.freeEdges; area.freeEdges ← new.link }
ELSE new ← NEW[EdgeRep];
new.sMin ← e.sMin;
new.sCount ← e.sCount;
new.f0 ← e.f0;
new.df ← e.df;
IF incr THEN { new.link ← area.increasingEdges; area.increasingEdges ← new }
ELSE { new.link ← area.decreasingEdges; area.decreasingEdges ← new };
};
};
Trouble: SIGNAL = CODE; -- raised when an error check fails; resuming may well work OK, but something isn't quite right.
Check: PROC [truth: BOOL] ~ INLINE { IF NOT truth THEN SIGNAL Trouble };
Interpolate: PROC [x0, y0, x1, y1, x: REAL] RETURNS [y: REAL] ~ {
This procedure attempts to improve the numeric stability of the result by calculating the intersection from the closer of the two endpoints. We assume x1#x0.
dx0: REAL ~ x-x0;
dx1: REAL ~ x1-x;
IF checking THEN Check[ (x IN [x0..x1] OR x IN [x1..x0]) ];
IF ABS[dx0] <= ABS[dx1]
THEN y ← y0+(y1-y0)*(dx0/(x1-x0))
ELSE y ← y1-(y1-y0)*(dx1/(x1-x0));
IF checking THEN Check[ (y IN [y0..y1] OR y IN [y1..y0]) ];
};
ClipSeg: PROC [area: Area, p0: Pair, r0: Region, p1: Pair, r1: Region] ~ {
sRegion: Region ~ [sLo: TRUE, sHi: TRUE, fLo: FALSE, fHi: FALSE];
clip: ARRAY ExternalHalfPlane OF REAL ~ [
sLo: area.realBounds.min.s,
sHi: area.realBounds.max.s,
fLo: area.realBounds.min.f,
fHi: area.realBounds.max.f
];
FOR b: ExternalHalfPlane IN ExternalHalfPlane DO
SELECT TRUE FROM
r0[b] AND r1[b] => {
IF sRegion[b]
THEN { p0.s ← p1.s ← clip[b] }
ELSE { p0.f ← p1.f ← clip[b] };
r0[b] ← FALSE;
r1[b] ← FALSE;
};
r0[b] OR r1[b] => {
cut: Pair ~ IF sRegion[b]
THEN [s: clip[b], f: Interpolate[p0.s, p0.f, p1.s, p1.f, clip[b]]]
ELSE [s: Interpolate[p0.f, p0.s, p1.f, p1.s, clip[b]], f: clip[b]];
IF r0[b]
THEN {
IF sRegion[b]
THEN AppendSeg[area, [s: cut.s, f: p0.f], cut]
ELSE AppendSeg[area, [s: p0.s, f: cut.f], cut];
p0 ← cut;
r0 ← RegionOf[area, cut];
}
ELSE {
IF sRegion[b]
THEN AppendSeg[area, cut, [s: cut.s, f: p1.f]]
ELSE AppendSeg[area, cut, [s: p1.s, f: cut.f]];
p1 ← cut;
r1 ← RegionOf[area, cut];
};
};
ENDCASE => NULL;
ENDLOOP;
IF checking THEN Check[ (Union[r0, r1] = ALL[FALSE]) ];
AppendSeg[area, p0, p1]
};
SortS: PROC [e: Edges] RETURNS [Edges] ~ INLINE {
Sort by increasing sMin
RETURN [MSort[e: e, sCompare: TRUE, terminator: NIL]];
};
MSort: PROC [e: Edges, sCompare: BOOL, terminator: Edge] RETURNS [Edges] ~ {
Does a list-merge sort on e, by either s or f; terminator is used as the list terminator, and must be reachable from e.
GT: PROC [a, b: Edge] RETURNS [BOOL] ~ INLINE {
RETURN [IF sCompare THEN (a.sMin > b.sMin) ELSE (a.f0.integerPart > b.f0.integerPart)]
};
n: INT ← 0;
x: Edges ← terminator;
y: Edges ← terminator;
new: Edges ← terminator;
tail: Edges ← terminator;
x ← tail ← e;
WHILE x # terminator DO
x ← x.link;
n ← n + 1;
IF x = terminator THEN EXIT;
x ← x.link;
n ← n + 1;
tailtail.link;
ENDLOOP;
IF n <= 10 THEN RETURN [ISort[e, sCompare, terminator]];
x ← e;
y ← tail.link;
tail.link ← terminator;
tail ← terminator;
x ← MSort[x, sCompare, terminator];
y ← MSort[y, sCompare, terminator];
Now merge the two sorted lists
new ← x;
IF GT[x, y] THEN {new ← y; y ← x; x ← new};
Start from y, which we do by swapping x and y.
DO
We first assume that we have just appended from x, but need to advance x to the next element and check for emptiness. Once this is done we try to stay within x as long as the predicate allows. By doing this we reduce the amount of RC assignments of the form "tail.link ← ...", which speeds things up considerably.
DO
tail ← x; x ← x.link;
IF x = terminator THEN {tail.link ← y; RETURN[new]};
IF GT[x, y] THEN EXIT;
ENDLOOP;
tail.link ← y;
We have just appended from y, so append to the list from y as long as reasonable.
DO
tail ← y; y ← y.link;
IF y = terminator THEN {tail.link ← x; RETURN[new]};
IF GT[y, x] THEN EXIT;
ENDLOOP;
tail.link ← x;
ENDLOOP;
};
ISort: PROC [e: Edges, sCompare: BOOL, terminator: Edge] RETURNS [Edges] ~ {
Sort the head of e (punctuated by terminator) by increasing sMin or f0
unconsumed: Edges ← e;
new: Edges ← terminator;
WHILE unconsumed # terminator DO
link: Edges ~ unconsumed.link;
current: Edges ~ unconsumed;
a: Edges ← new;
v: INTEGER ~ IF sCompare THEN current.sMin ELSE current.f0.integerPart;
p: Edges ← terminator;
IF sCompare
THEN { WHILE a#terminator AND v > a.sMin DO p ← a; a ← a.link ENDLOOP }
ELSE { WHILE a#terminator AND v > a.f0.integerPart DO p ← a; a ← a.link ENDLOOP };
IF p = terminator
THEN { current.link ← new; new ← current }
ELSE { current.link ← p.link; p.link ← current };
unconsumed ← link;
ENDLOOP;
RETURN [new];
};
SortF: PROC [e: Edges, s: INTEGER] RETURNS [Edges] ~ {
Sort the head of e (those at front of list with sMin = s) by increasing f0
n: INT ← 0;
null: Edges ← e;
WHILE null # NIL AND null.sMin = s DO null ← null.link; n ← n + 1 ENDLOOP;
IF n <= 10 THEN RETURN [ISort[e: e, sCompare: FALSE, terminator: null]];
RETURN [MSort[e: e, sCompare: FALSE, terminator: null]];
};
CountCrossings: PROC [e: Edges] RETURNS [n: INT ← 0] ~ {
WHILE e#NIL DO n ← n + e.sCount; e ← e.link ENDLOOP;
};
CheckMonotone: PROC [area: Area] ~ {
sSize: INT ← 0;
IF area.state = awaitLine THEN Close[area];
sSize ← area.tightBounds.max.s-area.tightBounds.min.s;
IF sSize <= 0 OR (area.moveCount = 1 AND area.totalCrossings = sSize+sSize)
THEN area.state ← completeMonotone
ELSE area.state ← complete;
area.increasingEdges ← SortS[area.increasingEdges];
area.decreasingEdges ← SortS[area.decreasingEdges];
IF checking AND CountCrossings[area.increasingEdges] # CountCrossings[area.decreasingEdges] THEN ERROR;
};
AdvanceTo: PROC [e: EdgeRep, s: INTEGER] RETURNS [EdgeRep] ~ {
WHILE e.sMin+e.sCount <= s AND e.link#NIL DO
e ← e.link^;
ENDLOOP;
IF e.sMin+e.sCount <= s
THEN {
e.sCount ← 0;
e.sMin ← LAST[INTEGER];
}
ELSE {
WHILE e.sMin < s DO
e.sMin ← e.sMin + 1;
e.sCount ← e.sCount - 1;
e.f0 ← e.f0.PLUS[e.df];
ENDLOOP;
};
RETURN [e];
};
CopyEdges: PROC [area: Area, src: Edges, sMin, sMax: INTEGER] RETURNS [result: Edges] ~ {
head: Edges ~ IF area.freeEdges = NIL THEN NEW[EdgeRep] ELSE area.freeEdges;
last: Edges ← head;
WHILE src # NIL DO
s0: INTEGER ← src.sMin;
s1: INTEGER ← s0+src.sCount;
IF s0 < sMin THEN s0 ← sMin;
IF s1 > sMax THEN s1 ← sMax;
IF s0 < s1 THEN {
IF last.link = NIL THEN last.link ← NEW[EdgeRep];
last ← last.link;
last.sMin ← src.sMin;
last.sCount ← src.sCount;
last.f0 ← src.f0;
last.df ← src.df;
};
src ← src.link;
ENDLOOP;
{t: Edges ~ last.link; last.link ← NIL; result ← head.link; head.link ← t; area.freeEdges ← head};
};
Convert: PROC [area: Area, boxAction: SF.BoxAction, clipBox: SF.Box ← SF.maxBox, oddWrap: BOOLFALSE] ~ {
Direction: TYPE ~ {incr, decr};
wrap: INTEGER ← 0;
needSort: BOOLTRUE;
bb: SF.Box ~ SF.Intersect[clipBox, area.tightBounds];
e: ARRAY Direction OF Edges ← [
incr: CopyEdges[area: area, src: area.increasingEdges, sMin: bb.min.s, sMax: bb.max.s],
decr: CopyEdges[area: area, src: area.decreasingEdges, sMin: bb.min.s, sMax: bb.max.s]
];
FOR dir: Direction IN Direction DO
Advance all the edges crossing the current scan line so they start at the current scan line.
p: Edges ← e[dir];
WHILE p#NIL AND p.sMin < bb.min.s DO
edge: Edge ← p;
WHILE edge.sMin < bb.min.s DO
edge.sMin ← edge.sMin + 1;
edge.sCount ← edge.sCount - 1; -- Shouldn't trap here if CopyEdges did it's job
edge.f0 ← edge.f0.PLUS[edge.df];
ENDLOOP;
p ← edge;
p ← p.link;
ENDLOOP;
ENDLOOP;
WHILE e[incr]#NIL AND e[decr]#NIL DO
s: INTEGER ~ e[incr].sMin;
f0: INTEGERLAST[INTEGER];
assert: BOOL[TRUE..TRUE] ← (s = e[decr].sMin);
g: ARRAY Direction OF Edges;
IF s >= bb.max.s THEN { e[incr] ← FreeEdges[area, e[incr]]; e[decr] ← FreeEdges[area, e[decr]]; RETURN };
IF needSort THEN { e[incr] ← SortF[e[incr], s]; e[decr] ← SortF[e[decr], s]; needSort ← FALSE };
g ← e;
DO
fi: INTEGER ~ IF g[incr] = NIL OR g[incr].sMin > s THEN LAST[INTEGER] ELSE g[incr].f0.integerPart;
fd: INTEGER ~ IF g[decr] = NIL OR g[decr].sMin > s THEN LAST[INTEGER] ELSE g[decr].f0.integerPart;
f0, f, delta: INTEGER;
IF fi < fd
THEN { f ← fi; delta ← 1; g[incr] ← g[incr].link }
ELSE {
IF fd = LAST[INTEGER] THEN EXIT;
f ← fd; delta ← -1; g[decr] ← g[decr].link
};
IF f < bb.min.f THEN f ← bb.min.f;
IF f > bb.max.f THEN f ← bb.max.f;
IF wrap = 0 OR (oddWrap AND NOT Odd[wrap]) THEN { f0 ← f };
wrap ← wrap + delta;
IF wrap = 0 OR (oddWrap AND NOT Odd[wrap]) THEN {
IF f > f0 THEN boxAction[[[s, f0], [s+1, f]]];
};
ENDLOOP;
assert ← wrap=0;
Advance to the next value of s, discarding completed segments.
FOR dir: Direction IN Direction DO
q: Edges ← e[dir];
p: Edges ← NIL;
WHILE q#NIL AND q.sMin = s DO
IF q.sCount = 1
THEN {
r: Edges ~ q.link;
IF p = NIL THEN e[dir] ← r ELSE p.link ← r;
q.link ← area.freeEdges; area.freeEdges ← q;
q ← r;
}
ELSE {
q.sMin ← q.sMin + 1;
q.sCount ← q.sCount - 1;
q.f0 ← q.f0.PLUS[q.df];
IF p # NIL AND p.f0.integerPart > q.f0.integerPart THEN needSort ← TRUE;
p ← q;
q ← q.link;
};
ENDLOOP;
IF q#NIL AND q.sMin = e[dir].sMin THEN needSort ← TRUE;
ENDLOOP;
ENDLOOP;
IF checking THEN Check[ (e[incr]=NIL AND e[decr]=NIL) ];
};
Validate: PROC [area: Area] RETURNS [nPieces: INT ← 0] ~ {
-- This is to call from the dubugger; it can be commented out for production.
nCross: PACKED ARRAY [-40..500] OF INTEGERALL[0];
s: INTINT.FIRST;
FOR e: Edges ← area.increasingEdges, e.link UNTIL e = NIL DO
FOR s: INT IN [e.sMin..e.sMin+e.sCount) DO
IF s IN [-40..500] THEN nCross[s] ← nCross[s] + 1;
ENDLOOP;
IF e.sMin < s THEN ERROR;
s ← e.sMin;
nPieces ← nPieces + 1;
ENDLOOP;
s ← INT.FIRST;
FOR e: Edges ← area.decreasingEdges, e.link UNTIL e = NIL DO
FOR s: INT IN [e.sMin..e.sMin+e.sCount) DO
IF s IN [-40..500] THEN nCross[s] ← nCross[s] - 1;
ENDLOOP;
IF e.sMin < s THEN ERROR;
s ← e.sMin;
nPieces ← nPieces + 1;
ENDLOOP;
FOR i: INT IN [-40..500] DO IF nCross[i] # 0 THEN ERROR ENDLOOP;
s ← INT.FIRST;
};
Dummy: PROC [edges: Edges] RETURNS [EdgeRep] ~ INLINE {
RETURN [[sMin: FIRST[INTEGER], sCount: 0, f0: Scaled.zero, df: Scaled.zero, link: edges]]
};
ConvertMonotone: PROC [area: Area, boxAction: SF.BoxAction, clipBox: SF.Box ← SF.maxBox] ~ {
bb: SF.Box ~ SF.Intersect[clipBox, area.tightBounds];
e: ARRAY [0..1] OF EdgeRep ← [AdvanceTo[Dummy[area.increasingEdges], bb.min.s], AdvanceTo[Dummy[area.decreasingEdges], bb.min.s]];
s: INTEGER ← e[0].sMin;
assert: BOOL[TRUE..TRUE] ← (s = e[1].sMin);
currentBox: SF.Box ← [];
s0: INTEGER ← s0;
WHILE s < bb.max.s DO
f0, f1: INTEGER;
IF e[0].f0.integerPart > e[1].f0.integerPart THEN { t: EdgeRep ← e[0]; e[0] ← e[1]; e[1] ← t };
f0 ← MAX[e[0].f0.integerPart, bb.min.f];
f1 ← MIN[e[1].f0.integerPart, bb.max.f];
IF s = currentBox.max.s AND f0 = currentBox.min.f AND f1 = currentBox.max.f
THEN {
Can just extend the current box.
IF e[0].df=Scaled.zero AND e[1].df=Scaled.zero THEN {
Both edges are parallel to s axis; skip to the end of the shorter one.
d: NAT ~ MIN[e[0].sCount, e[1].sCount, bb.max.s-s] - 1;
e[0].sCount ← e[0].sCount-d;
e[1].sCount ← e[1].sCount-d;
s ← s + d;
};
currentBox.max.s ← s + 1;
}
ELSE {
Emit the current box and start a new one.
IF SF.Nonempty[currentBox] THEN boxAction[currentBox];
currentBox ← [[s, f0], [s+1, f1]]
};
{OPEN e[0];
IF (sCount ← sCount-1) = 0
THEN { IF link = NIL THEN EXIT ELSE e[0] ← link^ }
ELSE { f0 ← f0.PLUS[df] }
};
{OPEN e[1];
IF (sCount ← sCount-1) = 0
THEN { IF link = NIL THEN EXIT ELSE e[1] ← link^ }
ELSE { f0 ← f0.PLUS[df] }
};
s ← s + 1;
ENDLOOP;
IF SF.Nonempty[currentBox] THEN boxAction[currentBox];
};
BoxesFromArea: PROC [area: Area, boxAction: SF.BoxAction, clipBox: SF.Box ← SF.maxBox, oddWrap: BOOLFALSE] ~ {
IF area.state < complete THEN CheckMonotone[area];
IF area.state = completeMonotone
THEN ConvertMonotone[area, boxAction, clipBox]
ELSE Convert[area, boxAction, clipBox, oddWrap];
};
Fill: PROC [dst: IISample.SampleMap, area: Area, oddWrap: BOOLFALSE] ~ {
boxes: SF.BoxGenerator ~ { BoxesFromArea[area, boxAction, SF.maxBox, oddWrap] };
IISample.FillBoxes[dst, boxes];
};
Public Stuff
DevicePath: TYPE ~ REF DevicePathRep;
DevicePathRep: PUBLIC TYPE ~ AreaRep;
CreatePath: PUBLIC PROC [path: II.PathProc, transformation: II.Transformation, clipBox: SF.Box, scratch: DevicePath] RETURNS [DevicePath] ~ {
devicePath: DevicePath ~ IF scratch = NIL THEN Create[] ELSE scratch;
SetPath[devicePath, path, transformation, clipBox];
RETURN [devicePath]
};
SetPath: PUBLIC PROC [devicePath: DevicePath, path: II.PathProc, transformation: II.Transformation ← NIL, clipBox: SF.Box] ~ {
area: Area ~ devicePath;
T: PROC [p: II.VEC] RETURNS [Pair] ~ INLINE { RETURN [[s: p.x, f: p.y]] };
moveTo: IIPath.MoveToProc ~ { MoveTo[area, T[p]] };
lineTo: IIPath.LineToProc ~ { LineTo[area, T[p1]] };
curveTo: IIPath.CurveToProc ~ { CurveTo[area, T[p1], T[p2], T[p3]] };
conicTo: IIPath.ConicToProc ~ { ConicTo[area, T[p1], T[p2], r] };
SetBounds[area, clipBox];
IIPath.Transform[path: path, m: transformation, moveTo: moveTo, lineTo: lineTo, curveTo: curveTo, conicTo: conicTo];
};
ObjectsFromPath: PUBLIC PROC [path: II.PathProc, clipBox: SF.Box, objectProc: PROC [box: SF.Box, boxGenerator: SF.BoxGenerator], devicePath: DevicePath] ~ {
area: Area ~ devicePath;
T: PROC [p: II.VEC] RETURNS [Pair] ~ INLINE { RETURN [[s: p.x, f: p.y]] };
boxGenerator: SF.BoxGenerator ~ { BoxesFromArea[area, boxAction, clipBox, FALSE] };
moveTo: IIPath.MoveToProc ~ {
Close[area];
IF SF.Nonempty[area.tightBounds] THEN {
objectProc[area.tightBounds, boxGenerator];
SetBounds[area, clipBox];
};
MoveTo[area, T[p]];
};
lineTo: IIPath.LineToProc ~ { LineTo[area, T[p1]] };
curveTo: IIPath.CurveToProc ~ { CurveTo[area, T[p1], T[p2], T[p3]] };
conicTo: IIPath.ConicToProc ~ { ConicTo[area, T[p1], T[p2], r] };
SetBounds[area, clipBox];
path[moveTo: moveTo, lineTo: lineTo, curveTo: curveTo, conicTo: conicTo, arcTo: NIL];
Close[area];
IF SF.Nonempty[area.tightBounds] THEN {
objectProc[area.tightBounds, boxGenerator];
SetBounds[area, clipBox];
};
};
BoundingBox: PUBLIC PROC [devicePath: DevicePath, clipBox: SF.Box] RETURNS [SF.Box] ~ {
IF devicePath.state < complete THEN CheckMonotone[devicePath];
RETURN [SF.Intersect[devicePath.tightBounds, clipBox]]
};
Monotone: PUBLIC PROC [devicePath: DevicePath] RETURNS [BOOL] ~ {
IF devicePath.state < complete THEN CheckMonotone[devicePath];
RETURN [devicePath.state = completeMonotone]
};
GenerateEdges: PUBLIC PROC [devicePath: DevicePath, edgeAction: IISample.EdgeAction] ~ {
IF devicePath.state < complete THEN CheckMonotone[devicePath];
{
e: ARRAY [0..1] OF Edge ← [devicePath.increasingEdges, devicePath.decreasingEdges];
s0: INTEGERIF e[0] # NIL THEN e[0].sMin ELSE LAST[INTEGER];
s1: INTEGERIF e[1] # NIL THEN e[1].sMin ELSE LAST[INTEGER];
UNTIL e[0] = NIL AND e[1] = NIL DO
IF s0 <= s1
THEN {
edgeAction[which: 0, sMin: e[0].sMin, sCount: e[0].sCount, f0: e[0].f0, df: e[0].df];
e[0] ← e[0].link;
s0 ← IF e[0] # NIL THEN e[0].sMin ELSE LAST[INTEGER];
}
ELSE {
edgeAction[which: 1, sMin: e[1].sMin, sCount: e[1].sCount, f0: e[1].f0, df: e[1].df];
e[1] ← e[1].link;
s1 ← IF e[1] # NIL THEN e[1].sMin ELSE LAST[INTEGER];
};
ENDLOOP;
};
};
NumberOfBoxes: PUBLIC PROC [devicePath: DevicePath] RETURNS [INT] ~ {
RETURN [devicePath.totalCrossings/2]
};
ConvertToBoxes: PUBLIC PROC [devicePath: DevicePath, oddWrap: BOOL,
clipBox: SF.Box, boxAction: SF.BoxAction] ~ {
BoxesFromArea[devicePath, boxAction, clipBox, oddWrap];
};
ConvertToManhattanPolygon: PUBLIC PROC [devicePath: DevicePath, oddWrap: BOOL, clipBox: SF.Box] RETURNS [LIST OF SF.Box] ~ {
boxGenerator: SF.BoxGenerator ~ {BoxesFromArea[devicePath, boxAction, clipBox, oddWrap]};
RETURN [IIManhattan.CreateFromBoxes[boxGenerator]]
};
END.
ColorDisplay on 1 640x480
Run IISampleImpl
Run IIScanCvImpl
← &b ← IISample.MapFromFrameBuffer[Terminal.GetColorFrameBufferA[Terminal.Current[]]]
← IISample.Clear[&b]
← &a ← IIScanCvImpl.Create[]
← IIScanCvImpl.SetBounds[&a, &b.box]
← IIScanCvImpl.MoveTo[&a, [1, 20]]
← IIScanCvImpl.LineTo[&a, [99, 18]]
← IIScanCvImpl.LineTo[&a, [50, 600]]
← IIScanCvImpl.Fill[&b, &a]
← IIScanCvImpl.SetBounds[&a, &b.box]
← IIScanCvImpl.MoveTo[&a, [1, 20]]
← IIScanCvImpl.ParTo[&a, [950, 300], [1, 580]]
← IIScanCvImpl.Fill[&b, &a]
{ DO &p ← Terminal.GetMousePosition[Terminal.Current[]]; IIScanCvImpl.SetBounds[&a, &b.box]; IISample.Clear[&b]; IIScanCvImpl.MoveTo[&a, [1, 20]]; IIScanCvImpl.LineTo[&a, [50, 600]]; IIScanCvImpl.LineTo[&a, [&p.y, &p.x]]; IIScanCvImpl.Fill[&b, &a] ENDLOOP }
{ DO IIScanCvImpl.SetBounds[&a, &b.box]; IIScanCvImpl.MoveTo[&a, [1, 20]]; FOR i: NAT IN [0..3) DO IIScanCvImpl.LineTo[&a, [Random.ChooseInt[min: -40, max: 1000]*0.5, Random.ChooseInt[min: -40, max: 1300]*0.5]]; ENDLOOP; IISample.Clear[&b]; IIScanCvImpl.Fill[&b, &a] ENDLOOP }
{ DO &p ← Terminal.GetMousePosition[Terminal.Current[]]; IIScanCvImpl.SetBounds[&a, &b.box]; IIScanCvImpl.MoveTo[&a, [4, 299.5]]; IIScanCvImpl.LineTo[&a, [4, 300.5]]; IIScanCvImpl.LineTo[&a, [&p.y, &p.x+0.5]]; IIScanCvImpl.LineTo[&a, [&p.y, &p.x-0.5]]; IF Terminal.GetKeys[Terminal.Current[]][Red]=down THEN IISample.Clear[&b]; IIScanCvImpl.Fill[&b, &a] ENDLOOP }