-- File CIFVersatecControl.mesa
-- Written by Martin Newell, June 1980
-- Last updated: April 23, 1981  3:33 PM

DIRECTORY

CIFControlDefs: FROM "CIFControlDefs" USING [DrawCIF],
CIFDevicesDefs: FROM "CIFDevicesDefs" USING [DeviceDescriptor, DeviceDescriptorRecord,
	RegisterDevice, MaxLENGTHLayerArray, LENGTHLayerArray,
	GetCIFOutDevice],
CIFOutputDefs: FROM "CIFOutputDefs" USING [SetSorting],
CIFUtilitiesDefs: FROM "CIFUtilitiesDefs" USING [Rectangle,
	SetClipRectangle, GetClipRectangle, SetUniformView, DrawClipRectangle,
	SetDisplayContext, GetDisplayContext, MoveTo, DrawTo, ScreenParams,
	MapRectangle],
FileOpDefs: FROM "FileOpDefs" USING[SetUserAndPassword, StoreFile,
	FileOpFailed],
Graphics: FROM "Graphics" USING [DisplayContext, NewContext, PushContext, PopContext, CopyContext, Scale],
InlineDefs: FROM "InlineDefs" USING[LongCOPY],
IntDefs: FROM "IntDefs" USING[ILastBB],
IODefs: FROM "IODefs" USING [SP, CR, WriteString, WriteLine, WriteOctal,
	WriteChar, WriteDecimal],
JaMFnsDefs: FROM "JaMFnsDefs" USING [Register, PopInteger, PopBoolean,
	PopString],
Mopcodes: FROM "Mopcodes" USING [zWBL],
OsStaticDefs: FROM "OsStaticDefs" USING [OsStatics],
Real: FROM "Real" USING [Fix, FixC, WriteReal],
SegmentDefs: FROM "SegmentDefs" USING[NewDataSegment, DefaultXMBase,
	LongDataSegmentAddress],
StringDefs: FROM "StringDefs" USING[AppendChar, AppendString, AppendDecimal,
	BcplToMesaString],
SystemDefs: FROM "SystemDefs" USING[AllocateHeapNode, FreeHeapNode],
TrapezoidDefs: FROM "TrapezoidDefs" USING[TrapezoidBlock, TrapezoidBlt],
VersatecDefs: FROM "VersatecDefs" USING [StartVersatecPlot, EndVersatecPlot,
	WriteVersatecLine];

CIFVersatecControl: PROGRAM
IMPORTS CIFControlDefs, CIFDevicesDefs, CIFOutputDefs, CIFUtilitiesDefs, FileOpDefs, Graphics, InlineDefs, IntDefs, IODefs, JaMFnsDefs, Real, SegmentDefs, StringDefs, SystemDefs, TrapezoidDefs, VersatecDefs =

BEGIN OPEN CIFControlDefs, CIFDevicesDefs, CIFOutputDefs, CIFUtilitiesDefs, FileOpDefs, Graphics, InlineDefs, IntDefs, IODefs, JaMFnsDefs, Mopcodes, OsStaticDefs, Real, SegmentDefs, StringDefs, SystemDefs, TrapezoidDefs, VersatecDefs;


-- Versatec procedures

VersatecDeviceRecord: DeviceDescriptorRecord _ [
	next:					NIL,
	name:					"versatec",
	deviceSelect: 		VersatecSelect,
	deviceDrawFrame: 	VersatecDrawFrame,
	deviceSetScale: 		VersatecSetScale,
	deviceSetClipRegion: VersatecSetClipRegion,
	deviceOutput: 		VersatecOutput,
	deviceLayer: 			VersatecLayer,
	deviceLoadLayer: 	VersatecLoadLayer,
	deviceRectangle: 	VersatecRectangle,
	deviceStartPoly: 	VersatecStartPoly,
	devicePolyVertex: 	VersatecPolyVertex,
	deviceEndPoly: 		VersatecEndPoly,
--	deviceTrapezoid: 	VersatecTrapezoid,
	deviceText: 			VersatecText
];

VersatecSelect: PROCEDURE RETURNS[BOOLEAN] =
	BEGIN --expects <nstrips> (INTEGER)
	NStrips _ PopInteger[];
	VersatecSetClipRegion[GetClipRectangle[]];
	RETURN[TRUE];
	END;

VersatecDrawFrame: PROCEDURE =
	BEGIN
	r: Rectangle _ GetClipRectangle[];
	DrawClipRectangle[];
	BEGIN OPEN r; --show pages
		width: REAL _ (urx-llx)/NStrips;
		x: REAL _ llx;
		THROUGH [1..NStrips) DO
			x _ x + width;
			MoveTo[x,lly];
			DrawTo[x,ury];
		ENDLOOP;
	END;
	END;

VersatecSetScale: PROCEDURE [factor: REAL] =
	BEGIN
	dc: DisplayContext _ GetDisplayContext[];
	PopContext[dc];
	PushContext[dc];
	Scale[dc, [factor,factor]];
	END;

VersatecSetClipRegion: PROCEDURE [rt: Rectangle] =
	BEGIN
	SetClipRectangle[rt];
	END;

VersatecOutput: PROCEDURE =
--expects <first last fileName>
-- Generate strips [first..last]
	BEGIN
	fileName: STRING _ [100];
	i,first,last: CARDINAL;
	PopString[fileName];
	last _ PopInteger[];
	first _ PopInteger[];
	FOR i IN [MinMax[1,first,NStrips]..MinMax[1,last,NStrips]] DO
		OutVersatecStrip[fileName,i];
	ENDLOOP;
	END;

OutVersatecStrip: PROCEDURE[fileName: STRING, strip: CARDINAL] =
-- Generate single strip
	BEGIN
	width,x,vtop: REAL;
	saveContext: DisplayContext _ GetDisplayContext[];
	r,ru,vr: Rectangle;
	pageName: STRING _ [50];

	r _ GetClipRectangle[]; --whole region in CIF units
	width _ (r.urx-r.llx)/NStrips; --width of single strip
	x _ r.llx + width*(strip - 1); --x coord of left of strip
-- draw strip [x,r.lly, x+width,r.ury]
	ru _ [llx: x, lly: r.lly, urx: x+width, ury: r.ury];
	PushContext[versatecContext];
		SetDisplayContext[versatecContext];
		vr _ versatecClipRectangle;
	-- adjust lly to give correct shape
		vr.lly _ vr.ury - (vr.urx-vr.llx)*(r.ury-r.lly)/width;
		SetClipRectangle[vr];
		SetUniformView[ru,vr];
		vtop _ MapRectangle[ru,versatecContext,identityContext].ury;
		pageName.length _ 0;
		AppendString[pageName,fileName];
		AppendChar[pageName,'-];
		AppendDecimal[pageName,strip];
		AppendString[pageName,".press"];
		VersatecStart[pageName, strip, VStripeWidth, FixC[vtop+1]];
		DrawCIF[Fix[ru.llx],Fix[ru.urx],Fix[ru.lly],Fix[ru.ury]];
		VersatecEnd[pageName, vtop];
		SetDisplayContext[saveContext];
	PopContext[versatecContext];
	SetClipRectangle[r];
	END;

VersatecStart: PROCEDURE[pageName: STRING, strip, width, height: CARDINAL] =
	BEGIN
	WriteString["Strip "];
	WriteDecimal[strip];
	WriteString[". Press File: "];
	WriteLine[pageName];
	localName.length _ 0;
	IF pageName[0]='[
	THEN	BEGIN
			AppendString[localName,localFileBufferName];
			WriteString["...buffered on "];
			WriteLine[localFileBufferName];
			END
	ELSE	AppendString[localName,pageName];
	IF AtVersatec THEN StartVersatecPlot[localName, width, height];
	SetSorting[decy];
	VersatecCurrentLayer _ 7; --i.e. not set
--Initialize EdgeList and ActiveList
	EdgeList _ EdgeListEl _ ActiveList _ ALL[NIL];
	YNext _ YCurr _ YPrev _ ALL[0]; --i.e.not set
	IF VStripeLongAddress=NIL THEN VersatecAllocateStripe[];
	VersatecClearStripe[FALSE]; --clear overlap line
	VStripeBottom _ 0;
	VStripeTop _ VStripeHeight;
	END;

localName: STRING _ [50]; --in global frame since press shares it

VersatecEnd: PROCEDURE [pageName: STRING, ymax: REAL] =
	BEGIN
	UNTIL VStripeBottom>ymax+1 DO --1+ is kludge to make sure it all gets out
		VersatecNextStripe[];
	ENDLOOP;
	VersatecOutStripe[]; --go slow past developer
	VersatecOutStripe[];
	IF AtVersatec THEN EndVersatecPlot[];
--check if need to write it to a file server
	IF pageName[0]='[
	THEN	BEGIN
			ENABLE FileOpFailed =>
				BEGIN
				WriteString[" ---Store failed: "];
				WriteLine[reason];
				CONTINUE;
				END;
			user: STRING _ [40];
			password: STRING _ [40];
			WriteString["Transferring "];
			WriteString[localFileBufferName];
			WriteString[" to "];
			WriteLine[pageName];
			BcplToMesaString[OsStatics^.UserName,user];
			BcplToMesaString[OsStatics^.UserPassword,password];
			SetUserAndPassword[user,password];
			StoreFile[localFileBufferName,pageName,binary];
			END;
	END;

VersatecLayer: PROCEDURE [layer: CARDINAL] =
--used to trigger scan conversion up to bottom of object about to be received
	BEGIN
	l,r,b,t: LONG INTEGER;
	bottom: REAL;
	rec: Rectangle;
	[l,r,b,t] _ ILastBB[]; --in chip coordinates
--kludge - need bottom of current object in Versatec coords
	rec _ MapRectangle[[l,b,r,t], versatecContext, identityContext];
	bottom _ MIN[rec.lly,rec.ury]-1; -- -1 to be on safe side
	WHILE bottom>=VStripeTop DO VersatecNextStripe[]; ENDLOOP;
	VersatecScanConvert[bottom, FALSE];
	VersatecCurrentLayer _ layer;
	END;

VersatecLoadLayer: PROCEDURE[layer:CARDINAL, v0,v1,v2,v3: CARDINAL] =
	BEGIN
	Stipple[layer] _ [v0,v1,v2,v3];
	END;

VersatecText: PROCEDURE[text: STRING, x,y: REAL] =
	BEGIN
--***ignored for now***
	END;


--Private procedures--

VersatecRectangle: PROCEDURE [r: Rectangle] =
--make two edges of appropriate types
	BEGIN
	edge: Edge;
	edge _ VersatecMakeEdge[r.llx,r.lly, r.llx,r.ury, TRUE];
	IF edge#NIL THEN AddToEdgeList[VersatecCurrentLayer,
								edge];
	edge _ VersatecMakeEdge[r.urx,r.lly, r.urx,r.ury, FALSE];
	IF edge#NIL THEN AddToEdgeList[VersatecCurrentLayer,
								edge];
	END;

x0,y0: REAL;
xs,ys: REAL;

VersatecStartPoly: PROCEDURE [x,y: REAL] =
	BEGIN
	x0 _ xs _ x;
	y0 _ ys _ y;
	END;

VersatecPolyVertex: PROCEDURE [x,y: REAL] =
	BEGIN
	edge: Edge _ NIL;
	SELECT TRUE FROM
	y>ys	=> edge _ VersatecMakeEdge[xs,ys, x,y,FALSE];
	y<ys	=> edge _ VersatecMakeEdge[x,y, xs,ys,TRUE];
	ENDCASE;
	IF edge#NIL THEN AddToEdgeList[VersatecCurrentLayer,
															edge];
	xs _ x;
	ys _ y;
	END;

VersatecEndPoly: PROCEDURE =
	BEGIN
	VersatecPolyVertex[x0,y0];
	END;


VersatecNextStripe: PROCEDURE =
	BEGIN --finish off and output current stripe, and step to next
	VersatecScanConvert[VStripeTop, FALSE];
	VersatecScanConvert[VStripeTop, TRUE];
	VersatecOutStripe[];
	VersatecClearStripe[TRUE];
	VStripeBottom _ VStripeTop;
	VStripeTop _ VStripeTop + VStripeHeight;
	END;

VersatecMakeEdge: PROCEDURE [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 RETURN[NIL];
	dx _ xend-xstart;
	IF dx=0 THEN
		BEGIN --make vertical edge
		edge _ AllocateVerticalEdge[];
		edge^ _ [
			next: ,
			xstart: xstart,
			ystart: ystart,
			yend: yend,
			lastouty: ystart,
			mate: NIL,
			up: up,
			flagout: FALSE,
			vert: TRUE,
			var: vertical[]
			];
		END
	ELSE
		BEGIN --make oblique edge
		edge _ AllocateObliqueEdge[];
		edge^ _ [
			next: ,
			xstart: xstart,
			ystart: ystart,
			yend: yend,
			lastouty: ystart,
			mate: NIL,
			up: up,
			flagout: FALSE,
			vert: FALSE,
			var: oblique[
				xend: xend,
				slope: dx/dy
				]
			];
		END;
	RETURN[edge];
	END;

VersatecAllocateStripe: PROCEDURE =
	BEGIN
--allocate space for VStripeHeight+1 lines (last one never output, but copied to 1st after buffer output to provide overlap)
	vPages: CARDINAL;
	[DisplayLongAddress, DisplayWidthWords, ] _ ScreenParams[];
	VStripeWidthWords _ (VStripeWidth+15)/16;
	VStripeWidthBytes _ VStripeWidthWords*2;
	VStripeWords _ VStripeWidthWords*(VStripeHeight+1);
	vPages _ (VStripeWords+255)/256;
	VStripeLongAddress _ LongDataSegmentAddress[NewDataSegment[DefaultXMBase,vPages]];
	END;

MakeLongPointer: PROCEDURE[low,high: UNSPECIFIED]
		RETURNS[LONG POINTER] = MACHINE CODE
	BEGIN --nothing to do-- END;

BreakLongPointer: PROCEDURE[lptr: LONG POINTER]
		RETURNS[low,high: UNSPECIFIED] = MACHINE CODE
	BEGIN --nothing to do-- END;


VersatecOutStripe: PROCEDURE =
	BEGIN
--***copy part to screen for testing
	versatecAddress: LONG POINTER _ VStripeLongAddress;
	displayAddress: LONG POINTER _ DisplayLongAddress;
	offset: CARDINAL _ MAX[0,DisplayOffset];
	offset _ MIN[VStripeWidthWords-DisplayWidthWords,offset];
	THROUGH [1..VStripeHeight] DO
		LongCOPY[versatecAddress+offset,DisplayWidthWords,displayAddress];
		IF AtVersatec THEN WriteVersatecLine[versatecAddress, VStripeWidthBytes];
		versatecAddress _ versatecAddress + VStripeWidthWords;
		displayAddress _ displayAddress + DisplayWidthWords;
	ENDLOOP;
	END;

VersatecClearStripe: PROCEDURE[overlap: BOOLEAN] =
--If overlap then copy line number VStripeHeight to line number 0 and
-- clear lines 1..VStripeHeight inclusive, otherwise
-- clear lines 0..VStripeHeight inclusive
	BEGIN
	first: CARDINAL;
	IF overlap THEN
		BEGIN
	--copy line number VStripeHeight to line number 0
		LongCOPY[VStripeLongAddress + VStripeWords - VStripeWidthWords,
					VStripeWidthWords, VStripeLongAddress];
		first _ VStripeWidthWords;
		END
	ELSE first _ 0;
--clear lines first..VStripeHeight inclusive
	LongStore[0,VStripeLongAddress + first]; --zero in 1st word
	LongCOPY[VStripeLongAddress + first, VStripeWords - first - 1,
				VStripeLongAddress + first + 1]; --copy it to all others
	END;

LongStore: PROCEDURE[v: UNSPECIFIED, address: LONG POINTER] = MACHINE CODE
	BEGIN zWBL,0; END;

VersatecScanConvert: PROCEDURE [upto: REAL, forceOutput: BOOLEAN] =
-- Run the scan converter up to y=upto
-- forceOutput forces output up to and including upto
	BEGIN
	edge,prevedge: Edge;
	edgetype: EdgeType;
	newActiveList,pendingFreeEdges,nextedge: Edge;
	ptrnewActiveList: POINTER TO Edge;
	i,layer: CARDINAL;
	segleft,trapleft: Edge;
	adepth,edepth: INTEGER;
	StartSegment: PROCEDURE[e: Edge] = BEGIN segleft _ e; END;
	EndSegment: PROCEDURE[e: Edge] =
		BEGIN
		HorLine[XatY[segleft,YCurr[layer]], XatY[e,YCurr[layer]], YCurr[layer]];
		END;
	StartTrap: PROCEDURE[e: Edge] =
		BEGIN
		trapleft _ e;
		END;
	EndTrap: PROCEDURE[right: Edge] =
		BEGIN
		left: Edge _ trapleft;
		IF left.mate#right THEN
			BEGIN --pairing changed or NIL
			OutTrap[left,YPrev[layer]];
			OutTrap[right,YPrev[layer]];
			left.mate _ right;
			right.mate _ left;
			END;
		IF left.flagout OR right.flagout OR forceOutput THEN
			BEGIN
			OutTrap[left,YCurr[layer]];
			left.flagout _ right.flagout _ FALSE; --mustn't do this in OutTrap because of other calls to it
			END;
		END;
	OutTrap: PROCEDURE[e1: Edge, ytop: REAL] =
		BEGIN
		e2: Edge _ e1.mate;
		IF e2#NIL THEN
			BEGIN
			DrawTrap[e1,e1.lastouty,e2,ytop,layer];
			e1.lastouty _ e2.lastouty _ ytop;
			e1.mate _ e2.mate _ NIL;
			END;
		END;
	UpdateYNextNewALAndprevedge: PROCEDURE[edge: Edge] =
	--Update YNext, newActiveList, and prevedge
		BEGIN
	--YNext:
		YNext[layer] _
			CheckIntersection[prevedge,edge,YCurr[layer],MIN[YNext[layer],edge.yend]];
	--newActiveList:
		edge.next _ NIL;
		ptrnewActiveList^ _ edge;
		ptrnewActiveList _ @edge.next;
	--and prevedge:
		prevedge _ edge;
		END;
	QueueForFreeEdge: PROCEDURE[edge: Edge] =
		BEGIN
		edge.next _ pendingFreeEdges;
		pendingFreeEdges _ edge;
		END;
	FOR layer IN [0..LENGTHLayerArray) DO
	UNTIL (forceOutput AND YPrev[layer]>=upto) OR
			(~forceOutput AND YNext[layer]>=upto) OR
			(ActiveList[layer]=NIL AND EdgeList[layer]=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
		adepth _ edepth _ 0;
		[edge,edgetype] _ GetEdge[layer];
		prevedge _ NIL;
		YNext[layer] _ upto;
		pendingFreeEdges _ NIL;
		newActiveList _ EdgeListQueue _ NIL;
		ptrnewActiveList _ @newActiveList;
		IF YCurr[layer]=YPrev[layer] THEN
			BEGIN --scan only to find YNext[layer]  (and therefore to do intersections)
			UNTIL edge=NIL DO
				SELECT edgetype FROM
				aterminatingUp,aterminatingDown => QueueForFreeEdge[edge];
				acontinuingUp,acontinuingDown,estartingUp,estartingDown =>
					UpdateYNextNewALAndprevedge[edge];
				ENDCASE;
				[edge,edgetype] _ GetEdge[layer];
			ENDLOOP;
			END
		ELSE
			BEGIN --normal case
			UNTIL edge=NIL DO
				SELECT edgetype FROM
				aterminatingUp =>
					BEGIN
					IF adepth=0 THEN
						BEGIN
						edge.flagout _ TRUE;
						StartTrap[edge];
						IF edepth#0
						THEN EndSegment[edge]
						ELSE StartSegment[edge];
						END;
					adepth _ adepth+1;
					QueueForFreeEdge[edge];
					END;
				aterminatingDown =>
					BEGIN
					adepth _ adepth-1;
					IF adepth=0 THEN
						BEGIN
						edge.flagout _ TRUE;
						EndTrap[edge];
						IF edepth=0
						THEN EndSegment[edge]
						ELSE StartSegment[edge];
						END;
					QueueForFreeEdge[edge];
					END;
				acontinuingUp =>
					BEGIN
					UpdateYNextNewALAndprevedge[edge]; --must do this first incase intersection set .flagout
					IF adepth=0 THEN
						BEGIN
						IF edepth#0 THEN
							BEGIN
							edge.flagout _ TRUE;
							EndSegment[edge];
							END;
						StartTrap[edge];
						END
					ELSE
						BEGIN
						IF edepth=0 THEN
							BEGIN
							edge.lastouty _ YCurr[layer];
							EndSegment[edge];
							END;
						END;
					adepth _ adepth+1;
					edepth _ edepth+1;
					END;
				acontinuingDown =>
					BEGIN
					UpdateYNextNewALAndprevedge[edge];
					adepth _ adepth-1;
					edepth _ edepth-1;
					IF adepth=0 THEN
						BEGIN
						IF edepth#0 THEN
							BEGIN
							edge.flagout _ TRUE;
							StartSegment[edge];
							END;
						EndTrap[edge];
						END
					ELSE
						BEGIN
						IF edepth=0 THEN
							BEGIN
							edge.lastouty _ YCurr[layer];
							StartSegment[edge];
							END;
						END;
					END;
				estartingUp =>
					BEGIN
					UpdateYNextNewALAndprevedge[edge];
					IF edepth=0 THEN
						IF adepth#0
						THEN EndSegment[edge]
						ELSE StartSegment[edge];
					edepth _ edepth+1;
					END;
				estartingDown =>
					BEGIN
					UpdateYNextNewALAndprevedge[edge];
					edepth _ edepth-1;
					IF edepth=0 THEN
						IF adepth=0
						THEN EndSegment[edge]
						ELSE StartSegment[edge];
					END;
				ENDCASE;
				[edge,edgetype] _ GetEdge[layer];
			ENDLOOP;
			END;
		ActiveList[layer] _ 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[layer,edge];
		ENDLOOP;
		IF EdgeList[layer]#NIL THEN YNext[layer] _ MIN[YNext[layer],EdgeList[layer].ystart];
		YPrev[layer] _ YCurr[layer];
		YCurr[layer] _ YNext[layer];
	ENDLOOP; --UNTIL (...
	ENDLOOP; --FOR layer ...
	FOR i IN [0..LENGTHLayerArray) DO --because next entry requires re-finding YNext[layer]
		YCurr[layer] _ YPrev[layer];
	ENDLOOP;
	END;

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

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

	SELECT TRUE FROM
	ActiveList[layer]=NIL	=>
		BEGIN --take it from EdgeList provided starting at YCurr
		IF peekAtEdgeList#NIL AND peekAtEdgeList.ystart <= YCurr[layer] 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[layer] AND
			EdgeLessThan[peekAtEdgeList,ActiveList[layer], YCurr[layer]]
		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 _ VersatecMakeEdge[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 _ VersatecMakeEdge[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;
		IF yint=ylow THEN e1.flagout _ e2.flagout _ TRUE;
		RETURN[yint];
		END
	ELSE RETURN[yhigh];
	END;

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

XatY: 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;

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;

black: ARRAY [0..4) OF CARDINAL _ [177777B,177777B,177777B,177777B];

HorLine: PROCEDURE[xleft,xright,y: REAL] =
	BEGIN
	t: TrapezoidBlock;
	IF xleft=xright THEN RETURN;
	t _ [
		ystart: y - VStripeBottom,
		yend: y - VStripeBottom,
		xsleft: xleft,
		xsright: xright,
		xeleft: xleft,
		xeright: xright,
		function: paint,
		xbase: VStripeLongAddress,
		xwords: VStripeWidthWords,
		texture: @black
		];
	TrapezoidBlt[@t];
	END;

DrawTrap: PROCEDURE[left: Edge, ystart: REAL, right: Edge, yend: REAL, layer: CARDINAL] =
	BEGIN --draw left and right edges
--left edge
	t: TrapezoidBlock _ [
		ystart: ystart - VStripeBottom,
		yend: yend - VStripeBottom,
		xsleft: XatY[left,ystart],
		xsright: ,
		xeleft: XatY[left,yend],
		xeright: ,
		function: paint,
		xbase: VStripeLongAddress,
		xwords: VStripeWidthWords,
		texture: @black
		];
	t.xsright _ t.xsleft;
	t.xeright _ t.xeleft;
	TrapezoidBlt[@t];
--stipple
	t.xsright _ XatY[right,ystart];
	t.xeright _ XatY[right,yend];
	t.texture _ @Stipple[layer];
	TrapezoidBlt[@t];
--right edge
	t.xsleft _ t.xsright;
	t.xeleft _ t.xeright;
	t.texture _ @black;
	TrapezoidBlt[@t];
	END;

AllocateVerticalEdge: PROCEDURE RETURNS[Edge] =
	BEGIN
	RETURN[AllocateHeapNode[SIZE[vertical EdgeRecord]]];
	END;

AllocateObliqueEdge: PROCEDURE RETURNS[Edge] =
	BEGIN
	RETURN[AllocateHeapNode[SIZE[oblique EdgeRecord]]];
	END;

FreeEdge: PROCEDURE[edge: Edge] =
	BEGIN
	FreeHeapNode[edge];
	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: PROCEDURE[layer: CARDINAL, edge: Edge] =
	BEGIN
	e,save,start: Edge;
	y: REAL _ edge.ystart;
	start _ EdgeListEl[layer];
	EdgeListEl[layer] _ edge;
	IF EdgeList[layer]=NIL THEN
		BEGIN
		edge.next _ NIL;
		edge.mate _ NIL;
		EdgeList[layer] _ edge;
		RETURN;
		END;
	IF start=NIL THEN start _ EdgeList[layer];
--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[layer];
			edge.mate _ NIL;
			EdgeList[layer].mate _ edge;
			EdgeList[layer] _ edge;
			RETURN;
			END;
	ENDLOOP;
--reached end of list - append edge to save
	edge.next _ NIL;
	edge.mate _ save;
	save.next _ edge;
	END;

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

GetFromEdgeList: PROCEDURE[layer: CARDINAL] RETURNS[edge: Edge] =
--Returns next edge from EdgeList having removed it from EdgeList
	BEGIN
	edge _ EdgeList[layer];
	IF edge#NIL THEN
		BEGIN
		EdgeList[layer] _ edge.next;
		IF edge.next#NIL THEN edge.next.mate _ NIL; --***IF new
		EdgeListEl[layer] _ 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;

MinMax: PROCEDURE[lower,value,upper: CARDINAL] RETURNS[CARDINAL] =
	BEGIN
	RETURN[MIN[MAX[lower,value],upper]];
	END;

--for debugging:

SetAtVersatec: PROCEDURE =
--expects <boolean>
	BEGIN
	AtVersatec _ PopBoolean[];
	END;

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

WriteFloat: PROCEDURE[r: REAL] =
	BEGIN
	WriteReal[WriteChar,r];
	END;

Edge: TYPE = 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};
EdgeList,EdgeListEl,ActiveList: ARRAY [0..MaxLENGTHLayerArray) OF Edge;
EdgeListQueue: Edge; --isolates edges being thrown back onto edge list
EdgeType: TYPE = {acontinuingUp, acontinuingDown, aterminatingUp, aterminatingDown,
	estartingUp, estartingDown, null};

--Versatec parameters
NStrips: CARDINAL _ 1;
AtVersatec: BOOLEAN _ TRUE; --set this to FALSE for debugging away from versatec Alto
 --testing: versatecClipRectangle: Rectangle _ [llx: 0, lly: 1, urx: 500, ury: 500];
versatecClipRectangle: Rectangle _ [llx: 10, lly: -10, urx: 3472-10, ury: -10];
									--height will be modified when used
identityContext: DisplayContext _
	NewContext[GetCIFOutDevice[]];
versatecContext: DisplayContext _ CopyContext[identityContext];

VersatecCurrentLayer: CARDINAL;
YNext,YCurr,YPrev: ARRAY [0..MaxLENGTHLayerArray) OF REAL;
VStripeBottom,VStripeTop: REAL; --limits to be mapped onto current stripe
VStripeWidth: CARDINAL _ 3472; --***should be wired to required buffer width
VStripeHeight: CARDINAL _ 128; --this MUST be a multiple of 4 for stipple phase to work
--***should be wired to required buffer height
VStripeWidthWords: CARDINAL; --required buffer width in words
VStripeWidthBytes: CARDINAL; --required buffer width in bytes
VStripeWords: CARDINAL;			--required buffer size in words
VStripeLongAddress: LONG POINTER _ NIL; --full address of versatec bitmap buffer
DisplayLongAddress: LONG POINTER; --full address of display bitmap buffer
DisplayWidthWords: CARDINAL;
DisplayOffset: INTEGER _ 0; --in words - controls what part of VStripe is copied to screen. Set in debugger
localFileBufferName: STRING _ "CIF.press$";

Stipple: ARRAY [0..MaxLENGTHLayerArray) OF ARRAY [0..4) OF CARDINAL _
	ALL[[177777B,177777B,177777B,177777B]];	--undef

--set up context
Scale[versatecContext, [1,-1]]; --to make y increase on sort

--Set up default stipples
Stipple[0] _ [      0,      0,010421B,      0];	--implant
Stipple[1] _ [042104B,010421B,042104B,010421B];	--diffusion
Stipple[2] _ [010421B,104210B,042104B,021042B];	--poly
Stipple[3] _ [167356B,135673B,114631B,073567B];	--contact
Stipple[4] _ [      0,      0,021042B,104210B];	--metal
Stipple[5] _ [      0,021042B,042104B,104210B];	--buried
Stipple[6] _ [      0,021042B,052525B,021042B];	--glass
Stipple[7] _ [177777B,177777B,177777B,177777B];	--undef

RegisterDevice[@VersatecDeviceRecord];

-- for debugging
Register["atversatec",SetAtVersatec];

END.
(635)\113b9B1527b18B1049b14B159b17B263b16B150b21B67b14B317b16B1167b13B879b11B842b13B539b17B100b12B102b17B376b17B68b18B284b15B57b18B287b16B780b22B489b15B105b16B112b17B569b19B699b9B87b19B347b12B48b10B114b9B55b7B445b7B216b27B326b16B3756b7B297b8B163b18B271b16B763b17B1284b16B82b4B367b4B206b5B270b7B354b8B692b20B96b19B95b8B357b13B310b13B1146b14B158b15B345b12B242b6B131b13B76b9B1317b10B