-- 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]=’[
THENBEGIN
AppendString[localName,localFileBufferName];
WriteString["...buffered on "];
WriteLine[localFileBufferName];
END
ELSEAppendString[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]=’[
THENBEGIN
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.