-- CGReducerImpl.mesa
-- Last changed by Doug Wyatt, September 1, 1982 11:37 am
-- Last changed by Paul Rovner, June 8, 1983 10:51 pm
-- Last changed by Christian Jacobi, June 5, 1985 10:47:10 am PDT
-- McCreight, July 17, 1985 5:38:57 pm PDT
-- Based on Polygon.mesa by Martin Newell, May 1980
DIRECTORY
Basics USING [BITAND],
CGArea,
CGReducer,
CGStorage USING [pZone, qZone],
GraphicsBasic,
Real USING [CompareREAL];
CGReducerImpl: CEDAR PROGRAM
IMPORTS Basics, CGArea, CGStorage, Real
EXPORTS CGReducer = {
OPEN Area: CGArea, CGReducer, GraphicsBasic;
debug: BOOLEAN ← TRUE;
worry: BOOLEAN = FALSE;
worryX: BOOLEAN = FALSE;
worryY: BOOLEAN = FALSE;
repZone: ZONE = CGStorage.qZone;
edgesZone: ZONE = CGStorage.pZone;
queueZone: ZONE = CGStorage.pZone;
edgeZone: ZONE = CGStorage.qZone;
nullEdge: EdgeRep = [this: nil, next: nil,
up: FALSE, vert: FALSE, line: FALSE, lastR: FALSE, tag: 0,
xbot: 0, ybot: 0, xtop: 0, ytop: 0,
a: 0, b: 0, c: 0, slope: 0, yemit: 0];
clipper: Tag = 0;
figure: Tag = 1;
Error: PUBLIC ERROR[type: ErrorType] = CODE;
FalseAssertion: SIGNAL = CODE;
IntersectionOutOfBounds: SIGNAL = CODE;
Assert: PROC[pred: BOOLEAN] = INLINE { IF pred THEN NULL ELSE SIGNAL FalseAssertion };
New: PUBLIC PROC[size: NAT] RETURNS[Ref] = {
self: Ref ← repZone.NEW[Rep ← [size: 0, edges: NIL, queue: NIL,
qsize: 0, save: [0,0], first: [0,0], closed: TRUE, free: nil]];
IF size>0 THEN Grow[self,size];
RETURN[self];
};
Bump: PROC[size: NAT] RETURNS[NAT] = INLINE { RETURN[
IF size=0 THEN 8 ELSE IF size<512 THEN size+size ELSE size+512] };
Grow: PROC[self: Ref, size: NAT ← 0] = {
oldsize: NAT ← self.size;
newsize: NAT ← MAX[size,Bump[oldsize]];
space: NAT ← newsize+1;
oldedges: Edges ← self.edges;
oldqueue: Queue ← self.queue;
newedges: Edges ← edgesZone.NEW[EdgesRep[space]];
newqueue: Queue ← queueZone.NEW[QueueRep[space]];
free: EdgeIndex ← self.free;
FOR i: NAT IN[1..oldsize] DO
newedges[i] ← oldedges[i];
newqueue[i] ← oldqueue[i];
ENDLOOP;
TRUSTED { edgesZone.FREE[@oldedges]; queueZone.FREE[@oldqueue] };
-- The following loop is DECREASING so that the most frequently used
-- edges will tend to be clustered near the beginning of the edges array
FOR i: NAT DECREASING IN(oldsize..newsize] DO
edge: Edge ← edgeZone.NEW[EdgeRep ← nullEdge];
edge.this ← i; newedges[i] ← edge;
edge.next ← free; free ← i;
ENDLOOP;
self.size ← newsize;
self.edges ← newedges;
self.queue ← newqueue;
self.free ← free;
};
Vertex: PUBLIC PROC[self: Ref, v: Vec] = {
-- Add vertex to polygon
-- edge list is built in sort in increasing lower y
IF self.closed THEN { self.first ← v; self.closed ← FALSE }
ELSE {
u: Vec ← self.save;
SELECT Real.CompareREAL[u.y,v.y] FROM
less => InsertNewEdge[self,u.x,u.y,v.x,v.y,TRUE];
greater => InsertNewEdge[self,v.x,v.y,u.x,u.y,FALSE];
ENDCASE;
};
self.save ← v;
};
Close: PUBLIC PROC[self: Ref] = {
-- Terminate old boundary and start a new one within same polygon
-- No need to call this if only one boundary in polygon
Vertex[self,self.first]; self.closed ← TRUE;
};
Rectangle: PUBLIC PROC[self: Ref, q: Vec] = {
p: Vec ← self.save;
SELECT Real.CompareREAL[p.y,q.y] FROM
less => InsertNewRect[self,p.x,q.x,p.y,q.y,TRUE];
greater => InsertNewRect[self,p.x,q.x,q.y,p.y,FALSE];
ENDCASE => RETURN;
};
-- (continuing) (starting) (terminating)
-- / |
-- aboveL / aboveR aboveL | aboveR aboveL = aboveR
-- / |
-- ycurr: ~~~~~~~~~/~~~~~~~~~~~~~~~~~~~~~~~+~~~~~~~~~~~~~~~~~~~~~~+~~~~~~
-- / |
-- belowL / belowR belowL = belowR belowL | belowR
-- / |
--
-- | |xxxx xxxx| xxxx|xxxx | |xxxx xxxx| xxxx|xxxx
-- | |xxxx xxxx| xxxx|xxxx | |xxxx xxxx| xxxx|xxxx
-- ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~
-- | | | | |xxxx |xxxx |xxxx |xxxx
-- | | | | |xxxx |xxxx |xxxx |xxxx
--
-- 0 0 0 0 0 0 0 1 0 0 1 0 0 0 1 1 0 1 0 0 0 1 0 1 0 1 1 0 0 1 1 1
--
--
-- | |xxxx xxxx| xxxx|xxxx | |xxxx xxxx| xxxx|xxxx
-- | |xxxx xxxx| xxxx|xxxx | |xxxx xxxx| xxxx|xxxx
-- ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~ ~~~~|~~~~
-- xxxx| xxxx| xxxx| xxxx| xxxx|xxxx xxxx|xxxx xxxx|xxxx xxxx|xxxx
-- xxxx| xxxx| xxxx| xxxx| xxxx|xxxx xxxx|xxxx xxxx|xxxx xxxx|xxxx
--
-- 1 0 0 0 1 0 0 1 1 0 1 0 1 0 1 1 1 1 0 0 1 1 0 1 1 1 1 0 1 1 1 1
Generate: PUBLIC PROC[self: Ref, area: Area.Ref,
exclude: BOOLEAN, oddwrap: BOOLEAN] = {
-- Generate the intersection of the previously defined clipper and figure
-- exclude => produce portion of clipper OUTSIDE the figure
-- oddwrap => only odd wrap number is inside the figure
ycurr,ynext: REAL ← 0; -- bottom and top of current swath
oldI,newI: EdgeIndex ← nil; -- index of next old edge and next new edge
peekOld,peekNew: Edge ← NIL; -- next old edge and next new edge (or NIL)
moreNew: BOOLEAN ← FALSE; -- if TRUE, there are more new edges for current swath
xnew: REAL ← 0; -- starting x value of next new edge (if moreNew=TRUE)
wrap: ARRAY Tag OF INTEGER ← ALL[0]; -- current wrap counts
mask: INTEGER ← IF oddwrap THEN 1 ELSE -1;
aboveL,aboveR,belowL,belowR: BOOLEAN ← FALSE; -- "inside" flags
oblique: NAT ← 0; -- number of oblique edges in active list
IF ~self.closed THEN Close[self]; -- close last boundary
newI ← BestEdge[self]; -- get index of first new edge
-- * The Reducer Loop * --
DO
Inside: PROC RETURNS[BOOLEAN] = INLINE {
IF wrap[clipper]=0 THEN RETURN[FALSE]
ELSE TRUSTED { RETURN[(Basics.BITAND[
LOOPHOLE[wrap[figure]], LOOPHOLE[mask]]=0)=exclude] } };
Emit: PROC[edgeL,edgeR: Edge, ybot,ytop: REAL] = {
trap: Trap; trap.ybot ← ybot; trap.ytop ← ytop;
IF edgeL.vert THEN { trap.xbotL ← trap.xtopL ← edgeL.xbot }
ELSE { trap.xbotL ← XofY[edgeL,ybot]; trap.xtopL ← XofY[edgeL,ytop] };
IF edgeR.vert THEN { trap.xbotR ← trap.xtopR ← edgeR.xbot }
ELSE { trap.xbotR ← XofY[edgeR,ybot]; trap.xtopR ← XofY[edgeR,ytop] };
trap.rectangle ← edgeL.vert AND edgeR.vert;
trap.line ← FALSE;
Area.Insert[area,trap];
IF debug THEN Assert[ybot<=ytop
AND trap.xbotL<=trap.xbotR AND trap.xtopL<=trap.xtopR];
};
nextI: EdgeIndex ← nil; -- head of new active list
last: Edge ← NIL; -- last edge in new active list
freeI: EdgeIndex ← nil; -- head of terminated edge list
freeTail: Edge ← NIL; -- last edge in terminated edge list
pendI: EdgeIndex ← nil; -- list of pending edges to be inserted into queue
left: Edge ← NIL; -- current left edge seeking a mate below ycurr
yprev: REAL ← 0; -- bottom of trapezoid to emit
flag: BOOLEAN ← FALSE; -- if TRUE, must emit trapezoid in this pass
-- Determine bottom of next swath
IF newI=nil THEN {
IF oldI=nil THEN EXIT -- no more edges
ELSE ycurr ← ynext; -- start at top of previous swath
}
ELSE {
peekNew ← self.edges[newI]; ycurr ← peekNew.ybot; -- peek at next new edge
IF oldI=nil OR ycurr<=ynext THEN { moreNew ← TRUE; xnew ← peekNew.xbot }
ELSE { peekNew ← NIL; ycurr ← ynext }; -- new edge starts above this swath
};
-- In one pass through each Active list:
-- introduce newly entering edges,
-- remove terminating edges from previous swath,
-- emit visible edges terminating at ycurr,
-- mark visible edges starting at ycurr,
-- and find lowest upper y in ynext.
DO
edgeI: EdgeIndex ← nil;
edge: Edge ← NIL;
belowL ← belowR; aboveL ← aboveR; -- move over to next transition
-- Get next edge
{ IF oldI=nil THEN { IF moreNew THEN GOTO New ELSE EXIT };
-- If we get to here, then peekOld is a candidate
-- If peekNew is a candidate too, decide which comes first
IF moreNew THEN SELECT Real.CompareREAL[xnew,XofY[peekOld,ycurr]] FROM
less => GOTO New; greater => GOTO Old;
equal => SELECT Real.CompareREAL[peekNew.slope,peekOld.slope] FROM
less => GOTO New; greater => GOTO Old;
equal => IF peekNew.up THEN GOTO New;
ENDCASE => ERROR;
ENDCASE => ERROR;
GOTO Old; -- if old edge was the winner or the only candidate
EXITS
New => {
edgeI ← newI; edge ← peekNew; newI ← RemoveEdge[self];
IF newI=nil THEN { peekNew ← NIL; moreNew ← FALSE }
ELSE { peekNew ← self.edges[newI];
-- stop considering new edges if next one starts above ycurr
IF peekNew.ybot>ycurr THEN { peekNew ← NIL; moreNew ← FALSE }
ELSE xnew ← peekNew.xbot;
};
IF NOT edge.vert THEN oblique ← oblique + 1; -- count incoming oblique edges
};
Old => {
edgeI ← oldI; edge ← peekOld; oldI ← edge.next; edge.next ← nil;
IF oldI=nil THEN peekOld ← NIL ELSE peekOld ← self.edges[oldI];
belowR ← edge.lastR; -- this was aboveR the last time
};
};
-- If edge is New, no transition below ycurr (belowR = belowL)
-- If edge is Old, edge.lastL is result of previous transition
-- If this edge continues above ycurr, include it in this swath.
IF edge.ytop>ycurr THEN {
-- Update the appropriate wrap number.
tag: Tag ← edge.tag;
IF edge.up THEN wrap[tag] ← wrap[tag] + 1 ELSE wrap[tag] ← wrap[tag] - 1;
aboveR ← Inside[]; -- Test whether inside after passing this edge
edge.lastR ← aboveR; -- Remember for next pass
-- Add to new active list and update ynext
IF nextI=nil THEN {
nextI ← edgeI; -- begin new active list
ynext ← edge.ytop; -- initialize ynext
}
ELSE {
last.next ← edgeI; -- append to new active list
ynext ← MIN[ynext,edge.ytop]; -- update ynext
-- Test whether last edge crosses this edge between ycurr and ynext
IF oblique>0 AND XofY[last,ynext]>XofY[edge,ynext] THEN {
-- Deal with intersection of last and edge between ycurr and ynext.
-- Assumes edges are in order at ycurr. Sets ynext to y of intersection.
xint,yint,d: REAL;
QueueUpperFragment: PROC[e: Edge] = INLINE {
pend: Edge ← MakeFragment[self,e,xint,yint];
pend.next ← pendI; pendI ← pend.this;
};
--
-- Take care to cope with artifacts of discrete arithmetic!
--
d ← last.a*edge.b - edge.a*last.b;
IF d=0 THEN GOTO Ignore; -- shouldn't happen if lines really intersect
IF debug THEN Assert[last.tag=figure OR edge.tag=figure];
-- Compute x of intersection; use fixed x of a vertical edge if possible.
IF last.vert THEN xint ← last.xbot
ELSE IF edge.vert THEN xint ← edge.xbot
ELSE {
-- Do it the hard way, and test for reasonableness
xmin: REAL ← MIN[last.xbot,last.xtop];
xmax: REAL ← MAX[last.xbot,last.xtop];
xint ← (edge.c*last.b - last.c*edge.b)/d;
IF xint<xmin THEN { IF worryX THEN SIGNAL IntersectionOutOfBounds; xint ← xmin };
IF xint>xmax THEN { IF worryX THEN SIGNAL IntersectionOutOfBounds; xint ← xmax };
};
-- Compute y of intersection
yint ← (edge.a*last.c - last.a*edge.c)/d;
IF yint<ycurr THEN { IF worryY THEN SIGNAL IntersectionOutOfBounds; yint ← ycurr };
IF yint>ynext THEN { IF worryY THEN SIGNAL IntersectionOutOfBounds; yint ← ynext };
-- Queue upper fragments to be put back onto edgeList.
-- Mustn't put them back into edgeList yet in case yint=ycurr.
IF last.ytop>yint THEN QueueUpperFragment[last];
IF edge.ytop>yint THEN QueueUpperFragment[edge];
-- Cut back last and edge
last.xtop ← edge.xtop ← xint;
last.ytop ← edge.ytop ← yint;
-- And adjust ynext.
ynext ← yint;
EXITS Ignore => NULL;
};
};
IF worry THEN Assert[last=NIL OR XofY[last,ynext]<=XofY[edge,ynext]];
last ← edge } -- edge is now last in new active list
ELSE {
-- edge terminates at ycurr; append to list of edges to be freed
IF freeI=nil THEN freeI ← edgeI ELSE freeTail.next ← edgeI;
freeTail ← edge; IF oblique>0 AND NOT edge.vert THEN oblique ← oblique - 1 };
IF belowL#belowR THEN {
IF belowR THEN { -- transition from out to in
left ← edge; yprev ← edge.yemit; flag ← FALSE; -- remember left edge
IF aboveL OR NOT aboveR THEN flag ← TRUE; -- must emit
}
ELSE { -- transition from in to out
IF aboveR OR NOT aboveL THEN flag ← TRUE; -- must emit
IF flag THEN { Emit[left,edge,yprev,ycurr]; left.yemit ← edge.yemit ← ycurr };
left ← NIL;
};
}
ELSE IF aboveL#aboveR THEN { edge.yemit ← ycurr; flag ← TRUE };
ENDLOOP;
-- Check assertions
IF debug THEN {
Assert[aboveR=FALSE AND belowR=FALSE];
Assert[wrap[clipper]=0 AND wrap[figure]=0];
Assert[nextI=nil OR ynext>=ycurr];
Assert[oldI=nil AND peekOld=NIL];
};
-- Update active list
IF nextI#nil THEN { oldI ← nextI; peekOld ← self.edges[oldI] };
-- Return terminated edges to free list
IF freeI#nil THEN { freeTail.next ← self.free; self.free ← freeI };
-- Insert pending fragments
IF pendI#nil THEN {
UNTIL pendI=nil DO
temp: Edge ← self.edges[pendI];
pendI ← temp.next; temp.next ← nil; -- don't forget to unlink it!
InsertEdge[self,temp];
ENDLOOP;
newI ← BestEdge[self]; -- one of the inserted edges may now be best
};
ENDLOOP;
IF debug THEN Assert[oblique=0];
};
-- Private procedures
NewEdge: PROC[self: Ref] RETURNS[Edge] = INLINE {
edge: Edge ← NIL; i: EdgeIndex ← self.free;
IF i=nil THEN { Grow[self]; i ← self.free };
edge ← self.edges[i]; self.free ← edge.next; edge.next ← nil;
RETURN[edge] };
MakeFragment: PROC[self: Ref, from: Edge, xint,yint: REAL] RETURNS[Edge] = {
edge: Edge ← NewEdge[self];
vert: BOOLEAN ← from.vert;
Assert[from.ytop>yint];
edge.xbot ← xint; edge.ybot ← yint;
edge.xtop ← from.xtop; edge.ytop ← from.ytop;
edge.a ← from.a; edge.b ← from.b; edge.c ← from.c;
edge.slope ← from.slope;
edge.up ← from.up;
edge.vert ← vert;
edge.tag ← from.tag;
RETURN[edge];
};
InsertNewEdge: PROC[self: Ref, x0,y0,x1,y1: REAL, up: BOOLEAN] = {
edge: Edge ← NewEdge[self];
dx: REAL ← x1-x0;
dy: REAL ← y1-y0;
vert: BOOLEAN ← (dx=0);
Assert[dy>0];
edge.xbot ← x0; edge.ybot ← y0;
edge.xtop ← x1; edge.ytop ← y1;
edge.a ← dy; edge.b ← -dx; edge.c ← y0*dx-x0*dy;
edge.slope ← IF vert THEN 0 ELSE dx/dy;
edge.up ← up;
edge.vert ← vert;
edge.tag ← figure;
InsertEdge[self, edge];
};
InsertNewRect: PROC[self: Ref, x0,x1,y0,y1: REAL, up: BOOLEAN] = {
edge1: Edge ← NewEdge[self];
edge2: Edge ← NewEdge[self];
dy: REAL ← y1-y0;
Assert[dy>0];
edge1.ybot ← edge2.ybot ← y0;
edge1.ytop ← edge2.ytop ← y1;
edge1.xbot ← edge1.xtop ← x0;
edge2.xbot ← edge2.xtop ← x1;
edge1.a ← edge2.a ← -1;
edge1.b ← edge2.b ← 0;
edge1.c ← x0; edge2.c ← x1;
edge1.slope ← edge2.slope ← 0;
edge1.vert ← edge2.vert ← TRUE;
edge1.tag ← edge2.tag ← figure;
edge1.up ← up; edge2.up ← NOT up;
InsertEdge[self,edge1]; InsertEdge[self,edge2];
};
Clip: PUBLIC PROC[self: Ref, edgeL,edgeR: Edge] = {
-- Note that this assumes edges come in ordered.
edge1: Edge ← NewEdge[self];
edge2: Edge ← NewEdge[self];
i1: NAT ← self.qsize + 1;
i2: NAT ← i1 + 1;
a: Queue ← self.queue; -- Caution: calls on NewEdge may change self.queue!
this1: EdgeIndex ← edge1.this;
this2: EdgeIndex ← edge2.this;
edge1^ ← edgeL^; edge1.this ← this1;
edge2^ ← edgeR^; edge2.this ← this2;
IF worry THEN {
Assert[Real.CompareREAL[edge1.xtop,edge1.xbot]=
Real.CompareREAL[edge1.slope,0]];
Assert[Real.CompareREAL[edge2.xtop,edge2.xbot]=
Real.CompareREAL[edge2.slope,0]];
Assert[edge1.xbot<=edge2.xbot];
Assert[edge1.xtop<=edge2.xtop];
};
a[i1] ← this1; a[i2] ← this2;
self.qsize ← i2;
};
XofY: PROC[edge: Edge, y: REAL] RETURNS[REAL] = INLINE { RETURN[
IF edge.vert OR y=edge.ybot THEN edge.xbot
ELSE IF y=edge.ytop THEN edge.xtop
ELSE -(edge.b*y + edge.c)/edge.a -- must compute consistently!
] };
-- Sorting predicate for edges: orders up/down within slope within x within ybot
LessThan: PROC[e1,e2: Edge] RETURNS[BOOLEAN] = INLINE {
RETURN[SELECT Real.CompareREAL[e1.ybot,e2.ybot] FROM
less => TRUE,
equal => (SELECT Real.CompareREAL[e1.xbot,e2.xbot] FROM
less => TRUE,
equal => (SELECT Real.CompareREAL[e1.slope,e2.slope] FROM
less => TRUE,
equal => e1.up,
greater => FALSE,
ENDCASE => ERROR),
greater => FALSE,
ENDCASE => ERROR),
greater => FALSE,
ENDCASE => ERROR]
};
InsertEdge: PROC[self: Ref, edge: Edge] = {
-- insert a new edge into the queue
edges: Edges ← self.edges;
size: NAT ← self.qsize + 1; -- figure out new size
a: Queue ← self.queue; -- grab the descriptor
-- Note that the edges and queue arrays grow together,
-- so there should be no need to test for enough room here.
-- Insert item by shuffling items down until invariant holds
-- (assuming that a[son] will hold item).
{ son: NAT ← size;
dad: NAT ← son/2;
WHILE dad > 0 AND LessThan[edge, edges[a[dad]]] DO
-- edge is better than a[dad], so shuffle a[dad] down
a[son] ← a[dad]; son ← dad; dad ← son/2;
ENDLOOP;
a[son] ← edge.this; -- finally insert the new edge
self.qsize ← size; -- also update the size
};
IF debug THEN Assert[edge.next=nil];
edge.lastR ← FALSE; edge.yemit ← 0; -- just to be tidy
};
BestEdge: PROC[self: Ref] RETURNS[EdgeIndex] = INLINE { RETURN[self.queue[1]] };
RemoveEdge: PROC[self: Ref] RETURNS[EdgeIndex] = {
-- remove the "best" edge from the queue
-- return the index of the next best edge
edges: Edges ← self.edges;
size: NAT ← self.qsize; -- current size of queue
a: Queue ← self.queue; -- descriptor for edges
item: EdgeIndex ← nil; -- index of moving item
IF size = 0 THEN ERROR Error[bug];
-- Remove top item from the array and prepare to move bottom item
item ← a[size]; -- get moving item
a[size] ← nil;
size ← size - 1; -- new size of queue
self.qsize ← size; -- also update size in self
IF size > 0 THEN {
-- Restore the invariant by moving the item down
-- (better items move up)
dad: NAT ← 1; -- current index for moving item
maxdad: NAT ← size / 2; -- highest index for father item
edge: Edge ← edges[item]; -- edge for moving item
WHILE dad <= maxdad DO
-- determine if son replaces dad
son: NAT ← dad + dad;
sonItem: EdgeIndex ← a[son];
sonEdge: Edge ← edges[sonItem];
IF son < size THEN {
-- must find better of the two sons
nson: NAT ← son + 1;
nsonItem: EdgeIndex ← a[nson];
nsonEdge: Edge ← edges[nsonItem];
IF LessThan[nsonEdge, sonEdge] THEN {
son ← nson; sonItem ← nsonItem; sonEdge ← nsonEdge };
};
IF LessThan[edge, sonEdge] THEN EXIT;
a[dad] ← sonItem;
dad ← son;
ENDLOOP;
a[dad] ← item;
};
RETURN[a[1]];
};
}.