-- 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 xintxmax THEN { IF worryX THEN SIGNAL IntersectionOutOfBounds; xint _ xmax }; }; -- Compute y of intersection yint _ (edge.a*last.c - last.a*edge.c)/d; IF yintynext 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]]; }; }.