-- ReducerImpl.mesa
-- Last changed by Doug Wyatt, September 22, 1980  5:33 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 [NewZone];
	-- For debugging, also: IODefs, Real

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

zone: UNCOUNTED ZONE = Memory.NewZone["ReducerImpl"];

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;

}.(635)