-- ReducerImpl.mesa
-- Last changed by Doug Wyatt, September 15, 1980 4:42 PM

-- This is an object-style version of M. Newell’s Polygon.mesa:
-- Written by Martin Newell, May 1980
-- Last updated by MN: May 29, 1980 11:58 AM

DIRECTORY
Reducer,
Vector USING [Vec],
Poly USING [Handle, New, Put, NewArea, Free, NewRec],
Pipe USING [Handle, Put, Free],
Memory USING [zone];
-- For debugging, also: IODefs, Real

ReducerImpl: PROGRAM
IMPORTS Memory,Poly,Pipe
EXPORTS Reducer SHARES Reducer = {
OPEN Reducer;

zone: UNCOUNTED ZONE = Memory.zone;

debug: BOOLEAN=FALSE;
ReducerError: PUBLIC SIGNAL = CODE;

Vec: TYPE = Vector.Vec;

Edge: TYPE = LONG POINTER TO EdgeRecord;
EdgeRecord: TYPE = RECORD [
next: Edge,
xstart: REAL,
ystart: REAL,
yend: REAL,
lastouty: REAL,--y value where edge of deferred trapezoid was last output
mate: Edge,--other edge making up a deferred trapezoid
up: BOOLEAN,--TRUE if edge defined in increasing y
flagout: BOOLEAN,--TRUE if edge will need to be output at ycurr
vert: BOOLEAN,--TRUE if edge vertical - used to SELECT variant
var:SELECT COMPUTED EdgeAngle FROM --use COMPUTED to save the whole WORD
-- that Mesa otherwise allocates for the tag
oblique => [xend: REAL, slope: REAL],
vertical => NULL,
ENDCASE
];
EdgeAngle: TYPE = {oblique,vertical};

EdgeTag: PROCEDURE[edge: Edge] RETURNS[EdgeAngle] =
INLINE { RETURN[IF edge.vert THEN vertical ELSE oblique] };

PolygonDescriptor: TYPE = LONG POINTER TO PolygonBlock;

PolygonBlock: TYPE = RECORD [
edgeList: Edge,--unprocessed edges
edgeListEl: Edge,--last edge added to EdgeList
activeList: Edge,--edges being processed
save: Vec,--previous vertex
first: Vec,--of current boundary
firstVertex: BOOLEAN, --TRUE if no vertices yet received for current boundary
pairing: Pairing--nonzero-wind or odd-wind pairing of edges
];

Data: PUBLIC TYPE = PolygonBlock;

liveprocs: LONG POINTER TO READONLY Procs = zone.NEW[Procs = [
Vertex: CVertex,
NewBoundary: CNewBoundary,
Generate: CGenerate,
Free: CFree
]];

deadprocs: LONG POINTER TO READONLY Procs = zone.NEW[Procs = [
Vertex: DeadVertex,
NewBoundary: DeadNewBoundary,
Generate: DeadGenerate,
Free: CFree
]];

EdgeType: TYPE = {continuing, terminating, starting, null};

NewReducer: PUBLIC PROCEDURE[pairing: Pairing] RETURNS[Handle] = {
d: PolygonDescriptor = zone.NEW[PolygonBlock ← [
edgeList: NIL, edgeListEl: NIL, activeList: NIL,
save: [0,0], first: [0,0], firstVertex: TRUE,
pairing: pairing]];
RETURN[zone.NEW[Object ← [procs: liveprocs, data: d]]];
};


CVertex: PROCEDURE[self: Handle, v: POINTER TO Vector.Vec] = {
polygon: PolygonDescriptor=self.data;
-- Add vertex to polygon
-- edge list is built in sort in increasing lower.y
{ OPEN polygon;
IF firstVertex THEN { first ← v↑; firstVertex ← FALSE }
ELSE {
IF v.y#save.y THEN { --make an edge and bubble it into edgeList
edge: Edge ← IF v.y>save.y
THEN MakeEdge[save.x,save.y,v.x,v.y,TRUE]
ELSE MakeEdge[v.x,v.y,save.x,save.y,FALSE];
IF edge#NIL THEN AddToEdgeList[polygon, edge];
};
};
save ← v↑;
};
};

DeadVertex: PROCEDURE[self: Handle, v: POINTER TO Vector.Vec] = {
IF debug THEN SIGNAL ReducerError;
};

CNewBoundary: PROCEDURE[self: Handle] = {
polygon: PolygonDescriptor=self.data;
-- Terminate old boundary and start a new one within same polygon
-- No need to call this if only one boundary in polygon
{ OPEN polygon;
IF NOT firstVertex THEN { --Close last edge of current boundary
v: Vec←first; CVertex[self,@v]; firstVertex ← TRUE
};
};
};

DeadNewBoundary: PROCEDURE[self: Handle] = {
IF debug THEN SIGNAL ReducerError;
};

CGenerate: PROCEDURE[self: Handle, pipe: Pipe.Handle] = {
polygon: PolygonDescriptor=self.data;
-- Generate the polygon defined up to last PolyVertex
{ OPEN polygon;
ynext,ycurr,yprev: REAL;
edgeListQueue: Edge; --isolates edges being thrown back onto edge list
edge,prevedge: Edge;
edgetype: EdgeType;
pendingFreeEdges,nextedge: Edge;
newActiveList,ptrnewActiveList: Edge;
trapleft: Edge;
adepth,edepth: INTEGER;
inc: INTEGER;
StartTrap: PROCEDURE[e: Edge] = { trapleft ← e };
EndTrap: PROCEDURE[right: Edge] = {
left: Edge ← trapleft;
IF left.mate#right THEN { --pairing changed or NIL
OutTrap[left,yprev];
OutTrap[right,yprev];
left.mate ← right;
right.mate ← left;
};
IF left.flagout OR right.flagout THEN {
OutTrap[left,ycurr];
left.flagout ← right.flagout ← FALSE; --mustn’t do this in OutTrap because of other calls to it
};
};
OutTrap: PROCEDURE[e1: Edge, ytop: REAL] = {
e2: Edge ← e1.mate;
IF e2#NIL THEN {
ybot: REAL ← e1.lastouty;
x1: REAL←XatY[e1,ybot];
x2: REAL←XatY[e2,ybot];
IF e1.vert AND e2.vert THEN
Pipe.Put[pipe,Poly.NewRec[[[x1,ybot],[x2,ytop]]]]
ELSE {
poly: Poly.Handle←Poly.New[];
Poly.Put[poly,[x1,ybot]];
IF x2>x1 THEN Poly.Put[poly,[x2,ybot]];
x1←XatY[e1,ytop]; x2←XatY[e2,ytop];
Poly.Put[poly,[x2,ytop]];
IF x1<x2 THEN Poly.Put[poly,[x1,ytop]];
Pipe.Put[pipe,Poly.NewArea[poly]]; Poly.Free[@poly];
};
e1.lastouty ← e2.lastouty ← ytop;
e1.mate ← e2.mate ← NIL;
};
};
UpdateynextNewALAndprevedge: PROCEDURE[edge: Edge] = {
--Update ynext, newActiveList, and prevedge
--ynext:
ynext ← CheckIntersection[prevedge,edge,ycurr,MIN[ynext,edge.yend]];
--newActiveList:
edge.next ← NIL;
IF ptrnewActiveList=NIL THEN newActiveList←edge
ELSE ptrnewActiveList.next←edge;
ptrnewActiveList ← edge;
--and prevedge:
prevedge ← edge;
};
CheckIntersection: PROCEDURE[e1,e2: Edge, ylow,yhigh: REAL]
RETURNS[y: REAL] = {
--check for and deal with intersection of e1 and e2 between ylow and yhigh
--Returns either yhigh or y of intersection
--assumes edges are in order at ylow
IF e1#NIL AND XatY[e1,yhigh]>XatY[e2,yhigh] THEN {
xint,yint: REAL;
s1: REAL ← Slope[e1];
s2: REAL ← Slope[e2];
yint ← IF s1#s2 THEN
MAX[ylow, MIN[yhigh,
((e2.ystart*s2 - e1.ystart*s1)-(e2.xstart - e1.xstart))/(s2 - s1)]]
ELSE yhigh;
xint ← XatY[IF e1.vert THEN e1 ELSE e2,yint];
--put upper fragments back onto edgeList
IF yint<e1.yend THEN {
e1upper: Edge ← MakeEdge[xint,yint,Xend[e1],e1.yend,e1.up];
--mustn’t put it back on edgeList yet in case yint=ylow
QueueForEdgeList[e1upper];
};
IF yint<e2.yend THEN {
e2upper: Edge ← MakeEdge[xint,yint,Xend[e2],e2.yend,e2.up];
QueueForEdgeList[e2upper];
};
--cut back e1 and e2
WITH e:e1 SELECT EdgeTag[e1] FROM
oblique => e.xend ← xint;
ENDCASE;
e1.yend ← yint;
WITH e:e2 SELECT EdgeTag[e2] FROM
oblique => e.xend ← xint;
ENDCASE;
e2.yend ← yint;
IF yint=ylow THEN e1.flagout ← e2.flagout ← TRUE;
RETURN[yint];
}
ELSE RETURN[yhigh];
};

QueueForFreeEdge: PROCEDURE[edge: Edge] = {
edge.next ← pendingFreeEdges;
pendingFreeEdges ← edge;
};
QueueForEdgeList: PROCEDURE[edge: Edge] = {
edge.next ← edgeListQueue;
edgeListQueue ← edge;
};

--CGenerate starts here

--Close last edge
IF ~firstVertex THEN { v: Vec←first; CVertex[self,@v] };

UNTIL activeList=NIL AND edgeList=NIL DO
--in one pass through each ActiveList:
--output trapezoids in previous swath
--remove terminating edges from previous swath,
--introduce newly entering ones,
--drawing capping lines as necessary,
--and find lowest upper y in ynext
IF activeList=NIL THEN {
ycurr ← yprev ← edgeList.ystart;
ynext ← edgeList.yend;
}
ELSE ynext ← activeList.yend;
adepth ← edepth ← 0;
[edge,edgetype] ← GetEdge[polygon,ycurr];
prevedge ← NIL;
pendingFreeEdges ← NIL;
newActiveList ← edgeListQueue ← NIL;
ptrnewActiveList ← NIL;
IF ycurr=yprev THEN {
--scan only to find ynext (and therefore to do intersections)
UNTIL edge=NIL DO
SELECT edgetype FROM
terminating => QueueForFreeEdge[edge];
continuing,starting => UpdateynextNewALAndprevedge[edge];
ENDCASE;
[edge,edgetype] ← GetEdge[polygon,ycurr];
ENDLOOP;
}
ELSE { --normal case
UNTIL edge=NIL DO
inc ← IF edge.up THEN 1 ELSE -1;
SELECT edgetype FROM
terminating => {
IF adepth=0 THEN {
edge.flagout ← TRUE;
StartTrap[edge];
};
SELECT pairing FROM
nonzero => adepth ← adepth+inc;
odd => adepth ← 1-adepth;
ENDCASE => ERROR;
IF adepth=0 THEN {
edge.flagout ← TRUE;
EndTrap[edge];
};
QueueForFreeEdge[edge];
};
continuing => {
Case: TYPE = RECORD[le,la,re,ra: {o,i}];
case: Case ← [o,o,o,o];
UpdateynextNewALAndprevedge[edge]; --must do this first incase intersection set .flagout
IF edepth#0 THEN case.le←i;
IF adepth#0 THEN case.la←i;
SELECT pairing FROM
nonzero => { adepth←adepth+inc; edepth←edepth+inc };
odd => { adepth←1-adepth; edepth←1-edepth };
ENDCASE => ERROR;
IF edepth#0 THEN case.re←i;
IF adepth#0 THEN case.ra←i;
SELECT case FROM
[o,o,i,i] => StartTrap[edge];
[o,i,i,o],[i,i,i,o] => { edge.flagout←TRUE; EndTrap[edge] };
[o,i,i,i],[i,i,o,i] => edge.lastouty ← ycurr;
[i,o,o,i],[i,o,i,i]=> { edge.flagout←TRUE; StartTrap[edge] };
[i,i,o,o] => EndTrap[edge];
ENDCASE;
};
starting => {
UpdateynextNewALAndprevedge[edge];
SELECT pairing FROM
nonzero => edepth ← edepth+inc;
odd => edepth ← 1-edepth;
ENDCASE => ERROR;
};
ENDCASE;
[edge,edgetype] ← GetEdge[polygon,ycurr];
ENDLOOP;
};
activeList ← newActiveList;
FOR edge ← pendingFreeEdges,nextedge UNTIL edge=NIL DO
nextedge ← edge.next; zone.FREE[@edge];
ENDLOOP;
FOR edge ← edgeListQueue,nextedge UNTIL edge=NIL DO
nextedge ← edge.next;
AddToEdgeList[polygon,edge];
ENDLOOP;
IF edgeList#NIL THEN ynext ← MIN[ynext,edgeList.ystart];
yprev ← ycurr;
ycurr ← ynext;
ENDLOOP; --UNTIL (...
};
Pipe.Free[@pipe];
};

DeadGenerate: PROCEDURE[self: Handle, pipe: Pipe.Handle] = {
IF debug THEN SIGNAL ReducerError;
Pipe.Free[@pipe];
};

CFree: PROCEDURE[selfPtr: LONG POINTER TO Handle] = {
self: Handle←selfPtr↑;
polygon: PolygonDescriptor←self.data;
selfPtr↑←NIL;
-- Destroy polygon
{ OPEN polygon;
e,next: Edge;
FOR e ← edgeList, next UNTIL e=NIL DO
next ← e.next; zone.FREE[@e] ENDLOOP;
FOR e ← activeList, next UNTIL e=NIL DO
next ← e.next; zone.FREE[@e] ENDLOOP;
};
zone.FREE[@polygon];
zone.FREE[@self];
};


-- Private procedures

MakeEdge: PROCEDURE [xstart,ystart,xend,yend: REAL, up: BOOLEAN]
RETURNS[Edge] = {
--make edge of appropriate type
dx: REAL;
dy: REAL ← yend-ystart;
IF dy<=0 THEN RETURN[NIL];
dx ← xend-xstart;
IF dx=0 THEN { --make vertical edge
edge: Edge = zone.NEW[vertical EdgeRecord ← [
next: ,
xstart: xstart,
ystart: ystart,
yend: yend,
lastouty: ystart,
mate: NIL,
up: up,
flagout: FALSE,
vert: TRUE,
var: vertical[]
]];
RETURN[edge];
}
ELSE { --make oblique edge
edge: Edge = zone.NEW[oblique EdgeRecord ← [
next: ,
xstart: xstart,
ystart: ystart,
yend: yend,
lastouty: ystart,
mate: NIL,
up: up,
flagout: FALSE,
vert: FALSE,
var: oblique[
xend: xend,
slope: dx/dy
]
]];
RETURN[edge];
};
};

GetEdge: PROCEDURE[polygon: PolygonDescriptor, ycurr: REAL]
RETURNS[edge: Edge, edgeType: EdgeType] = {
--Get next edge for new active list - filter out zero height edges
DO [edge,edgeType] ← GetEdge1[polygon,ycurr];
IF edge=NIL OR edge.yend>edge.ystart THEN EXIT;
zone.FREE[@edge]; --exists and zero height
ENDLOOP;
};

GetEdge1: PROCEDURE[polygon: PolygonDescriptor, ycurr: REAL]
RETURNS[edge: Edge, edgeType: EdgeType] = {
OPEN polygon;
--Get next edge for new active list
peekAtEdgeList: Edge ← PeekAtEdgeList[polygon];
TakeFromActiveList: PROCEDURE = {
edge ← activeList;
activeList ← activeList.next;
edgeType ←IF edge.yend<=ycurr THEN terminating ELSE continuing;
};
TakeFromEdgeList: PROCEDURE = {
edge ← GetFromEdgeList[polygon];
edgeType ← starting;
--tidy it up
edge.flagout ← FALSE;
edge.lastouty ← edge.ystart;
edge.mate ← NIL;
};

SELECT TRUE FROM
activeList=NIL=> {
--take it from EdgeList provided starting at ycurr
IF peekAtEdgeList#NIL AND peekAtEdgeList.ystart <= ycurr THEN
TakeFromEdgeList[]
ELSE { edge ← NIL; edgeType ← null };
};
peekAtEdgeList=NIL => TakeFromActiveList[]; -- must be non-NIL if get here
ENDCASE => --both lists are candidates
IF peekAtEdgeList.ystart <= ycurr AND
EdgeLessThan[peekAtEdgeList,activeList, ycurr]
THEN TakeFromEdgeList[]
ELSE TakeFromActiveList[];
};

XatY: PROCEDURE[edge: Edge, y: REAL] RETURNS[x: REAL] = {
RETURN[
WITH e:edge SELECT EdgeTag[edge] FROM
oblique => --i.e. oblique
SELECT TRUE FROM
y=e.ystart => e.xstart,
y=e.yend => e.xend,
ENDCASE => e.xstart + (y-e.ystart)*e.slope, --must compute from consistent end!
ENDCASE => edge.xstart --i.e. vertical
];
};

Xend: PROCEDURE[edge: Edge] RETURNS[xend: REAL] = INLINE {
RETURN[WITH e:edge SELECT EdgeTag[edge] FROM
oblique => e.xend,
ENDCASE => edge.xstart --i.e.vertical
];
};

Slope: PROCEDURE[edge: Edge] RETURNS[slope: REAL] = INLINE {
RETURN[WITH e:edge SELECT EdgeTag[edge] FROM
oblique => e.slope,
ENDCASE => 0 --i.e.vertical
];
};

--The next 3 procedures (AddToEdgeList, PeekAtEdgeList, GetFromEdgeList)
-- implement the EdgeList and are subject to replacement.

-- In this version the EdgeList is kept doubly linked and search for
--insertion place is started at last-inserted Edge
--Back pointers use the .mate field

--AddToEdgeList: PROCEDURE[layer: CARDINAL, edge: Edge] =
--BEGIN
--eptr: LONG POINTER TO Edge;
--y: REAL ← edge.ystart;
--FOR eptr ← @EdgeList[layer], @eptr.next UNTIL eptr↑=NIL DO
--IF y<eptr.ystart OR (y=eptr.ystart AND EdgeLessThan[edge, eptr↑, y]) THEN EXIT;
--ENDLOOP;
--edge.next ← eptr↑;
--eptr↑ ← edge;
--END;

AddToEdgeList: PROCEDURE[polygon: PolygonDescriptor, edge: Edge] = { OPEN polygon;
e,save,start: Edge;
y: REAL ← edge.ystart;
start ← edgeListEl;
edgeListEl ← edge;
IF edgeList=NIL THEN {
edge.next ← NIL;
edge.mate ← NIL;
edgeList ← edge;
RETURN;
};
IF start=NIL THEN start ← edgeList;
--search forward
save ← NIL;
FOR e ← start, e.next UNTIL e=NIL DO
IF y<e.ystart OR (y=e.ystart AND EdgeLessThan[edge, e, y])
THEN GOTO searchbackwards;
save ← e;
REPEAT
searchbackwards => { --edge "<" e
FOR e ← e.mate, e.mate UNTIL e=NIL DO
IF e.ystart<y OR (e.ystart=y AND EdgeLessThan[e, edge, y])
THEN GOTO append;
REPEAT
append => { --append edge to e
edge.next ← e.next;
edge.mate ← e;
e.next.mate ← edge;
e.next ← edge;
RETURN;
};
ENDLOOP;
--reached begin of list - insert edge before 1st element
edge.next ← edgeList;
edge.mate ← NIL;
edgeList.mate ← edge;
edgeList ← edge;
RETURN;
};
ENDLOOP;
--reached end of list - append edge to save
edge.next ← NIL;
edge.mate ← save;
save.next ← edge;
};

PeekAtEdgeList: PROCEDURE[polygon: PolygonDescriptor]
RETURNS[edge: Edge] = {
OPEN polygon;
--Returns next edge from EdgeList without removing it from EdgeList
edge ← edgeList;
};

GetFromEdgeList: PROCEDURE[polygon: PolygonDescriptor]
RETURNS[edge: Edge] = {
OPEN polygon;
--Returns next edge from EdgeList having removed it from EdgeList
edge ← edgeList;
IF edge#NIL THEN {
edgeList ← edge.next;
IF edgeList#NIL THEN edgeList.mate ← NIL;
edgeListEl ← edgeList;
edge.mate ← NIL; --clean up
};
};

--

EdgeLessThan: PROCEDURE[e1,e2: Edge, y: REAL] RETURNS[BOOLEAN] = {
--orders up/down within slope within x
x1: REAL ← XatY[e1,y];
x2: REAL ← XatY[e2,y];
RETURN[x1<x2 OR (x1=x2 AND (Slope[e1]<Slope[e2] OR (Slope[e1]=Slope[e2] AND e1.up)))];
};

--for debugging:

--PrintList: PUBLIC PROCEDURE[polygon: PolygonDescriptor, list: Edge] =
--BEGIN OPEN polygon;
--e: Edge;
--SELECT list FROM
--activeList => WriteLine["ActiveList"];
--edgeList => WriteLine["EdgeList"];
--ENDCASE;
--WriteOctal[list]; WriteChar[CR];
--FOR e ← list, e.next UNTIL e=NIL DO
--WriteString["next:"]; WriteOctal[e.next]; WriteChar[SP];
--WriteString["xstart:"]; WriteFloat[e.xstart]; WriteChar[SP];
--WriteString["ystart:"]; WriteFloat[e.ystart]; WriteChar[SP];
--WriteString["xend:"]; WriteFloat[Xend[e]]; WriteChar[SP];
--WriteString["yend:"]; WriteFloat[e.yend]; WriteChar[SP];
--WriteString["slope:"]; WriteFloat[Slope[e]]; WriteChar[SP];
--WriteString["slant:"];
--WriteString[IF e.vert THEN "vertical" ELSE "oblique"]; WriteChar[SP];
--WriteString["up:"]; WriteChar[IF e.up THEN ’T ELSE ’F]; WriteChar[SP];
--WriteString["flagout:"]; WriteChar[IF e.flagout THEN ’T ELSE ’F]; WriteChar[SP];
--WriteString["lastouty:"]; WriteFloat[e.lastouty]; WriteChar[SP];
--WriteString["mate:"]; WriteOctal[e.mate]; WriteChar[CR];
--WriteChar[CR];
--ENDLOOP;
--END;

}.