-- File CIFExtScan.mesa
-- Written by Dan Fitzpatrick and Martin Newell, June 1980
-- Last updated: November 13, 1980  2:41 AM
DIRECTORY

CIFDevicesDefs: FROM "CIFDevicesDefs" USING [MaxLENGTHLayerArray],
CIFExtNMOSDefs: FROM "CIFExtNMOSDefs" USING [InitSwath, StartTrap, EndTrap],
CIFExtScanDefs: FROM "CIFExtScanDefs" USING [Edge, EdgeRecord],
RealFns: FROM "RealFns" USING [SqRt],
IntDefs: FROM "IntDefs" USING [IBoundBox],
IODefs: FROM "IODefs" USING [SP, CR, WriteString, WriteLine, WriteChar,
	WriteDecimal],
Real: FROM "Real" USING [AppendReal],
StringDefs: FROM "StringDefs" USING [AppendLongDecimal],
XFSPDefs: FROM "XFSPDefs" USING[XAllocateHeapNode];

CIFExtScan: PROGRAM
IMPORTS CIFExtNMOSDefs, IntDefs, IODefs, Real, RealFns, StringDefs, XFSPDefs
EXPORTS CIFExtScanDefs =

BEGIN OPEN CIFDevicesDefs, CIFExtNMOSDefs, CIFExtScanDefs, IntDefs, IODefs, Real, RealFns, StringDefs, XFSPDefs;


InitExtScan: PUBLIC PROCEDURE =
	BEGIN
	l,r,b,t: LONG INTEGER;
	EdgeList _ EdgeListEl _ ActiveList _ NIL;
	[l,r,b,t] _ IBoundBox[];
	YNext _ YCurr _ YPrev _ b; --i.e.not set
	END;

ExtractorMakeEdge: PUBLIC PROCEDURE [layer: CARDINAL, xstart,ystart,xend,yend: REAL, up: BOOLEAN]
		RETURNS[edge: Edge] =
	BEGIN
--make edge of appropriate type
	dx: REAL;
	dy: REAL _ yend-ystart;
	IF dy<=0 THEN BEGIN
			WriteLine["MakeEdge returns NIL"];
			RETURN[NIL];
			END;
	dx _ xend-xstart;
	IF dx=0 THEN
		BEGIN --make vertical edge
		edge _ AllocateVerticalEdge[];
		edge^ _ [
			next: ,
			xstart: xstart,
			ystart: ystart,
			yend: yend,
			layer: layer,
			mate: NIL,
			up: up,
			vert: TRUE,
			var: vertical[]
			];
		END
	ELSE
		BEGIN --make oblique edge
		edge _ AllocateObliqueEdge[];
		edge^ _ [
			next: ,
			xstart: xstart,
			ystart: ystart,
			yend: yend,
			layer: layer,
			mate: NIL,
			up: up,
			vert: FALSE,
			var: oblique[
				xend: xend,
				slope: dx/dy
				]
			];
		END;
	RETURN[edge];
	END;

ExtractorScanConvert: PUBLIC PROCEDURE [upto: REAL] =
-- Run the scan converter up to y=upto
	BEGIN
	edge: Edge;
	prevedge: Edge;
	--**** prevedge: ARRAY [0..MaxLENGTHLayerArray) OF Edge;
	edgetype: EdgeType;
	newActiveList,pendingFreeEdges,nextedge: Edge;
	ptrnewActiveList: LONG POINTER TO Edge;
	layer: CARDINAL;
	UpdateYNextNewALAndprevedge: PROCEDURE[edge: Edge] =
	--Update YNext, newActiveList, and prevedge
		BEGIN
	--YNext:
		YNext _ CheckIntersection[prevedge,edge,YCurr,MIN[YNext,edge.yend]];
	--*** YNext _ CheckIntersection[prevedge[layer],edge,YCurr,MIN[YNext,edge.yend]];
	--newActiveList:
		edge.next _ NIL;
		ptrnewActiveList^ _ edge;
		ptrnewActiveList _ @edge.next;
	--and prevedge:
		prevedge _ edge;
		--*** prevedge[layer] _ edge;
		END;
	QueueForFreeEdge: PROCEDURE[edge: Edge] =
		BEGIN
		edge.next _ pendingFreeEdges;
		pendingFreeEdges _ edge;
		END;
	UNTIL YNext>=upto OR (ActiveList=NIL AND EdgeList=NIL)
		DO
--in one pass through the ActiveList:
--	deal with trapezoids in previous swath (propogate node number segments)
--	remove terminating edges from previous swath,
--	introduce newly entering ones,
--	and find lowest upper y in YNext
		adepth _ ALL[0];
		[edge,edgetype] _ GetEdge[];
		prevedge _ NIL;
		--*** prevedge _ ALL[NIL];
		YNext _ upto;
		pendingFreeEdges _ NIL;
		newActiveList _ EdgeListQueue _ NIL;
		ptrnewActiveList _ @newActiveList;
		IF YCurr=YPrev THEN
			BEGIN --scan only to find YNext  (and therefore to do intersections)
			UNTIL edge=NIL DO
				layer _ edge.layer;
				SELECT edgetype FROM
				aterminatingUp,aterminatingDown => QueueForFreeEdge[edge];
				acontinuingUp,acontinuingDown,estartingUp,estartingDown =>
					UpdateYNextNewALAndprevedge[edge];
				ENDCASE;
				[edge,edgetype] _ GetEdge[];
			ENDLOOP;
			END
		ELSE
			BEGIN --normal case
			InitSwath[YPrev,YCurr];
			UNTIL edge=NIL DO
				layer _ edge.layer;
				SELECT edgetype FROM
				aterminatingUp =>
					BEGIN
					IF adepth[layer]=0 THEN StartTrap[edge,layer];
					adepth[layer] _ adepth[layer]+1;
					QueueForFreeEdge[edge];
					END;
				aterminatingDown =>
					BEGIN
					adepth[layer] _ adepth[layer]-1;
					IF adepth[layer]=0 THEN EndTrap[edge,layer];
					QueueForFreeEdge[edge];
					END;
				acontinuingUp =>
					BEGIN
					UpdateYNextNewALAndprevedge[edge];
					IF adepth[layer]=0 THEN StartTrap[edge,layer];
					adepth[layer] _ adepth[layer]+1;
					END;
				acontinuingDown =>
					BEGIN
					UpdateYNextNewALAndprevedge[edge];
					adepth[layer] _ adepth[layer]-1;
					IF adepth[layer]=0 THEN EndTrap[edge,layer];
					END;
				estartingUp,estartingDown => UpdateYNextNewALAndprevedge[edge];
				ENDCASE;
				[edge,edgetype] _ GetEdge[];
			ENDLOOP;
			END;
		ActiveList _ newActiveList;
		FOR edge _ pendingFreeEdges,nextedge UNTIL edge=NIL DO
			nextedge _ edge.next;
			FreeEdge[edge];
		ENDLOOP;
		FOR edge _ EdgeListQueue,nextedge UNTIL edge=NIL DO
			nextedge _ edge.next;
			AddToEdgeList[edge];
		ENDLOOP;
		IF EdgeList#NIL THEN YNext _ MIN[YNext,EdgeList.ystart];
		YPrev _ YCurr;
		YCurr _ YNext;
	ENDLOOP; --UNTIL (...
	--because next entry requires re-finding YNext
	YCurr _ YPrev;
	END;

GetEdge: PROCEDURE RETURNS[edge: Edge, edgeType: EdgeType] =
	--Get next edge for new active list - filter out zero height edges
	BEGIN
	DO
		[edge,edgeType] _ GetEdge1[];
		IF edge=NIL OR edge.yend>edge.ystart THEN EXIT;
		FreeEdge[edge]; --exists and zero height
	ENDLOOP;
	END;

GetEdge1: PROCEDURE RETURNS[edge: Edge, edgeType: EdgeType] =
	--Get next edge for new active list
	BEGIN
	peekAtEdgeList: Edge _ PeekAtEdgeList[];
	TakeFromActiveList: PROCEDURE =
		BEGIN
		edge _ ActiveList;
		ActiveList _ ActiveList.next;
		edgeType _	IF edge.yend<=YCurr
						THEN IF edge.up THEN aterminatingUp ELSE aterminatingDown
						ELSE IF edge.up THEN acontinuingUp ELSE acontinuingDown;
		END;
	TakeFromEdgeList: PROCEDURE =
		BEGIN
		edge _ GetFromEdgeList[];
		edgeType _ IF edge.up THEN estartingUp ELSE estartingDown;
	--tidy it up
		edge.mate _ NIL;
		END;

	SELECT TRUE FROM
	ActiveList=NIL	=>
		BEGIN --take it from EdgeList provided starting at YCurr
		IF peekAtEdgeList#NIL AND peekAtEdgeList.ystart <= YCurr THEN
			TakeFromEdgeList[]
		ELSE
			BEGIN
			edge _ NIL;
			edgeType _ null;
			END;
		END;
	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[];
	END;

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
	BEGIN
	IF e1#NIL AND XatY[e1,yhigh]>XatY[e2,yhigh] THEN
		BEGIN
		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
			BEGIN
			e1upper: Edge _ ExtractorMakeEdge[e1.layer,xint,yint,Xend[e1],e1.yend,e1.up];
 		--mustn't put it back on edgeList yet in case yint=ylow
			QueueForEdgeList[e1upper];
			END;
		IF yint<e2.yend THEN
			BEGIN
			e2upper: Edge _ ExtractorMakeEdge[e2.layer,xint,yint,Xend[e2],e2.yend,e2.up];
			QueueForEdgeList[e2upper];
			END;
		--cut back e1 and e2
		WITH e:e1 SELECT IF e1.vert THEN vertical ELSE oblique FROM
		oblique => e.xend _ xint;
		ENDCASE;
		e1.yend _ yint;
		WITH e:e2 SELECT IF e2.vert THEN vertical ELSE oblique FROM
		oblique => e.xend _ xint;
		ENDCASE;
		e2.yend _ yint;
		RETURN[yint];
		END
	ELSE RETURN[yhigh];
	END;

QueueForEdgeList: PROCEDURE[e: Edge] =
	BEGIN
	e.next _ EdgeListQueue;
	EdgeListQueue _ e;
	END;

In: PUBLIC PROCEDURE [layer: CARDINAL] RETURNS[BOOLEAN] =
	BEGIN
	RETURN[adepth[layer] # 0];
	END;

XatY: PUBLIC PROCEDURE[edge: Edge, y: REAL] RETURNS[x: REAL] =
	BEGIN
	RETURN[
		WITH e:edge SELECT IF edge.vert THEN vertical ELSE oblique 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
	];
	END;

Xend: PROCEDURE[edge: Edge] RETURNS[xend: REAL] = INLINE
	BEGIN
	RETURN[WITH e:edge SELECT IF edge.vert THEN vertical ELSE oblique FROM
			oblique => e.xend,
			ENDCASE => edge.xstart --i.e.vertical
	];
	END;

EdgeLength: PUBLIC PROCEDURE[edge: Edge, from, to: REAL] RETURNS[x: REAL] =
	BEGIN
	RETURN[WITH e:edge SELECT IF edge.vert THEN vertical ELSE oblique FROM
			oblique => SqRt[(XatY[edge,from]-XatY[edge,to])*(XatY[edge,from]-XatY[edge,to]) + (from-to)*(from-to)],
			--oblique => from - to,
			ENDCASE => from - to --i.e.vertical
			];
	END;

Slope: PROCEDURE[edge: Edge] RETURNS[slope: REAL] = INLINE
	BEGIN
	RETURN[WITH e:edge SELECT IF edge.vert THEN vertical ELSE oblique FROM
			oblique => e.slope,
			ENDCASE => 0 --i.e.vertical
			];
	END;

AllocateVerticalEdge: PROCEDURE RETURNS[e: Edge] =
	BEGIN
	IF FreeVerticalEdges#NIL THEN
	{	e _ FreeVerticalEdges;
		FreeVerticalEdges _ FreeVerticalEdges.next;
	}
	ELSE e _ XAllocateHeapNode[SIZE[vertical EdgeRecord]];
	END;

AllocateObliqueEdge: PROCEDURE RETURNS[e: Edge] =
	BEGIN
	IF FreeObliqueEdges#NIL THEN
	{	e _ FreeObliqueEdges;
		FreeObliqueEdges _ FreeObliqueEdges.next;
	}
	ELSE e _ XAllocateHeapNode[SIZE[oblique EdgeRecord]];
	END;

FreeEdge: PROCEDURE[edge: Edge] =
	BEGIN
	WITH e:edge SELECT IF edge.vert THEN vertical ELSE oblique FROM
	vertical	=> { edge.next _ FreeVerticalEdges; FreeVerticalEdges _ edge; };
	oblique	=> { edge.next _ FreeObliqueEdges; FreeObliqueEdges _ edge; };
	ENDCASE;
	END;

--	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: 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: PUBLIC PROCEDURE[edge: Edge] =
	BEGIN
	e,save,start: Edge;
	y: REAL _ edge.ystart;
	start _ EdgeListEl;
	EdgeListEl _ edge;
	IF EdgeList=NIL THEN
		BEGIN
		edge.next _ NIL;
		edge.mate _ NIL;
		EdgeList _ edge;
		RETURN;
		END;
	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 =>
			BEGIN --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 =>
					BEGIN --append edge to e
					edge.next _ e.next;
					edge.mate _ e;
					e.next.mate _ edge;
					e.next _ edge;
					RETURN;
					END;
			ENDLOOP;
		--reached begin of list - insert edge before 1st element
			edge.next _ EdgeList;
			edge.mate _ NIL;
			EdgeList.mate _ edge;
			EdgeList _ edge;
			RETURN;
			END;
	ENDLOOP;
--reached end of list - append edge to save
	edge.next _ NIL;
	edge.mate _ save;
	save.next _ edge;
	END;

PeekAtEdgeList: PROCEDURE RETURNS[edge: Edge] =
--Returns next edge from EdgeList without removing it from EdgeList
	BEGIN
	edge _ EdgeList;
	END;

GetFromEdgeList: PROCEDURE RETURNS[edge: Edge] =
--Returns next edge from EdgeList having removed it from EdgeList
	BEGIN
	edge _ EdgeList;
	IF edge#NIL THEN
		BEGIN
		EdgeList _ edge.next;
		IF edge.next # NIL THEN edge.next.mate _ NIL;
		EdgeListEl _ edge.next;
		edge.mate _ NIL; --clean up
		END;
	END;

--

EdgeLessThan: PROCEDURE[e1,e2: Edge, y: REAL] RETURNS[BOOLEAN] =
	BEGIN
--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)))];
	END;

--for debugging:

PrintList: PUBLIC PROCEDURE[list: Edge, layer: CARDINAL] =
	BEGIN
	e: Edge;
	WriteString["YPrev,YCurr,YNext["]; WriteDecimal[layer]; WriteString["]: "];
	WriteFloat[YPrev]; WriteChar[',];
	WriteFloat[YCurr]; WriteChar[',];
	WriteFloat[YNext]; WriteChar[CR];
	SELECT list FROM
	ActiveList => WriteLine["ActiveList"];
	EdgeList => WriteLine["EdgeList"];
	ENDCASE;
	WriteLongDecimal[list]; WriteChar[CR];
	FOR e _ list, e.next UNTIL e=NIL DO
		WriteString["next:"]; WriteLongDecimal[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["mate:"]; WriteLongDecimal[e.mate]; WriteChar[SP];
		WriteString["XatYCurr: "]; WriteFloat[XatY[e,YCurr]]; WriteChar[CR];
		WriteChar[CR];
	ENDLOOP;
	END;

WriteFloat: PROCEDURE[r: REAL] =
	BEGIN
	s: STRING _ [50];
	AppendReal[s,r];
	WriteString[s];
	END;

WriteLongDecimal: PROCEDURE[n: LONG UNSPECIFIED] =
	BEGIN
	nn: LONG INTEGER _ n;
	s: STRING _ [50];
	AppendLongDecimal[s,nn];
	WriteString[s];
	END;

adepth: ARRAY [0..MaxLENGTHLayerArray] OF INTEGER;
EdgeList,EdgeListEl,ActiveList: Edge;
EdgeListQueue: Edge; --isolates edges being thrown back onto edge list
EdgeType: TYPE = {acontinuingUp, acontinuingDown, aterminatingUp, aterminatingDown,
	estartingUp, estartingDown, null};
YNext,YCurr,YPrev: REAL;
FreeVerticalEdges: Edge _ NIL;
FreeObliqueEdges: Edge _ NIL;

END.
e12(635)\127b9B527b10B228b11B170b17B813b20B297b27B417b16B2375b7B275b8B141b18B243b16B668b17B1252b16B82b2B98b4B374b4B206b10B268v4V21v4V34b5B200b20B207b19B202b8B558b13B310b13B9v9V1062b14B134b15B297b12B260b9B1143b10B91b16B

(1792)