-- wiresSeg2.mesa
-- reject wires
-- ties to middles and to ends
-- alternate paths
-- follow around nil ends

DIRECTORY SystemDefs:FROM"SystemDefs",
WiresDefs:FROM"WiresDefs",
IODefs:FROM"IODefs";
WiresSegs:PROGRAM IMPORTS SystemDefs, IODefs, WiresDefs
EXPORTS WiresDefs=BEGIN OPEN WiresDefs;

Error:SIGNAL=CODE;

--/////// START SEGS ///////

SegArray:TYPE=ARRAY [0..maxSeg] OF Seg;
segments:POINTER TO SegArray←NIL;
topSeg:INTEGER;
maxSeg:INTEGER=200;

InitSegs:PUBLIC PROCEDURE=BEGIN
topSeg←0;
EnumerateGridPlusTwo[ClearOrientation];
FixCorners[];
END;

EnumerateSegs:PUBLIC PROCEDURE[start:SegPtr,call:PROCEDURE[SegPtr]]=BEGIN
s:SegPtr;
IF start=NIL OR start.w=l OR start.w=d THEN RETURN;
FOR s←start.next,s.next UNTIL s.dummy DO IF s=NIL THEN Error; call[s]; ENDLOOP;
END;

EnumerateAllSegs:PROCEDURE[start:SegPtr,call:PROCEDURE[SegPtr]]=BEGIN
a:SegPtr←start.across;
IF start=NIL THEN RETURN;
EnumerateSegs[start,call];
IF ~a.dummy THEN call[a]; EnumerateSegs[a,call];
END;

FindXYFromSeg:PROCEDURE[s:SegPtr] RETURNS[INTEGER,INTEGER,Way]=BEGIN
RETURN[s.xy.x,s.xy.y,IF s.xy.h THEN u ELSE r]; END;

PrintCvt:ARRAY Way OF CHARACTER←[’l,’r,’u,’d,’n];

PrintSegs:PUBLIC PROCEDURE=BEGIN
i:INTEGER; FOR i IN [0..topSeg)
DO PrintOneSeg[@segments[i]]; IODefs.WriteChar[CR]; ENDLOOP;
END;

ShowSeg:PUBLIC PROCEDURE[s:SegPtr] RETURNS[INTEGER]=BEGIN
RETURN[SELECT TRUE FROM s=NIL=>55, s.dummy=>99,
ENDCASE=>(s-@segments[0])/SIZE[Seg]];
END;

PrintOneSeg:PUBLIC PROCEDURE[s:SegPtr]=BEGIN OPEN IODefs;
x,y:INTEGER; w:Way;
[x,y,w]←FindXYFromSeg[s];
WriteChar[’[];
WriteNumber[x,[10,FALSE,TRUE,2]];
WriteChar[’,];
WriteNumber[y,[10,FALSE,TRUE,2]];
WriteChar[’ ];
WriteChar[PrintCvt[w]];
WriteChar[’ ];
WriteChar[IF s.xy.l THEN ’B ELSE ’ ];
WriteChar[’ ];
WriteChar[IF s.first=NIL THEN ’x ELSE ’ ];
WriteChar[IF s.second=NIL THEN ’x ELSE ’ ];
WriteNumber[s.circuit,[10,FALSE,TRUE,4]];
WriteChar[’]];
END;

ValidateSegs:PROCEDURE=BEGIN
Temp:PROCEDURE[i,j:INTEGER]=BEGIN
EnumerateAllSegs[@orientation[i][j].upSeg,ValidateSeg];
EnumerateAllSegs[@orientation[i][j].rightSeg,ValidateSeg];
END;
EnumerateGrid[Temp];
END;

ValidateSeg:PROCEDURE[s:SegPtr]=BEGIN
loop:INTEGER; v:SegPtr;
loop←0;
FOR v←s,v.next UNTIL v.dummy
DO IF (loop←loop+1)>100 OR v=NIL THEN BEGIN Error; EXIT; END; ENDLOOP;
IF v.w#l AND v.w#d THEN Error;
loop←0;
FOR v←s,v.back UNTIL v.dummy
DO IF (loop←loop+1)>100 OR v=NIL THEN BEGIN Error; EXIT; END; ENDLOOP;
IF v.w#r AND v.w#u THEN Error;
IF NOT( s.dummy AND (s.w=l OR s.w=d)) THEN BEGIN
IF s.next.back#s AND (~s.xy.l OR ~s.next.dummy) THEN Error;
IF s.next.xy.x#s.xy.x THEN Error;
IF s.next.xy.y#s.xy.y THEN Error;
IF s.next.xy.h#s.xy.h THEN Error;
IF s.next.xy.l#s.xy.l AND (~s.xy.l OR ~s.next.dummy) THEN Error;
END;
IF NOT( s.dummy AND (s.w=r OR s.w=u)) THEN BEGIN
IF s.back.next#s AND (~s.xy.l OR ~s.back.dummy) THEN Error;
IF s.back.xy.x#s.xy.x THEN Error;
IF s.back.xy.y#s.xy.y THEN Error;
IF s.back.xy.h#s.xy.h THEN Error;
IF s.back.xy.l#s.xy.l AND (~s.xy.l OR ~s.back.dummy) THEN Error;
END;

END;

SetSeg:PUBLIC PROCEDURE[from:NodePtr,col:Color,circuit: INTEGER,
old:SegPtr,tieN,tieB:BOOLEAN]
RETURNS[SegPtr]=BEGIN
this:SegPtr←AddToSeg[];
back:SegPtr←from.s;
next:SegPtr;
myLevel:BOOLEAN←from.l;
backAcross,nextAcross,tieBack:BOOLEAN;
IF from=NIL THEN Error;
IF IllegalSeg[back] THEN Error;
this.c←col;
this.circuit←circuit;
this.xy←back.xy;
backAcross←back.xy.l#myLevel;
IF backAcross AND ~back.dummy THEN Error;
IF backAcross THEN next←back.across ELSE next←back.next;
IF backAcross THEN back.across←this ELSE back.next←this;
this.next←next; IF next=NIL THEN Error;
this.back←back; IF back=NIL THEN Error;
this.xy.l←myLevel;
nextAcross←next.xy.l#myLevel;
IF old#NIL THEN BEGIN
IF old.xy.l=myLevel THEN
BEGIN old.second←this;
this.first←old;
IF this.xy=old.xy THEN Error;
END ELSE IF ~old.dummy THEN BEGIN
old.across←this;
this.across←old;
END;
END;
tieBack←IF backAcross THEN back.ac ELSE back.nc;
IF tieBack OR tieN THEN
BEGIN this.nc←TRUE; IF nextAcross THEN next.ac←TRUE ELSE next.bc←TRUE; END;
IF tieBack OR tieB THEN
BEGIN this.bc←TRUE; IF backAcross THEN back.ac←TRUE ELSE back.nc←TRUE; END;
IF nextAcross AND ~next.dummy THEN Error;
IF nextAcross THEN next.across←this ELSE next.back←this;
RETURN[this];
END;


IllegalSeg:PUBLIC PROCEDURE[s:SegPtr] RETURNS[BOOLEAN]=BEGIN
foo1:CARDINAL←LOOPHOLE[s];
foo2:CARDINAL←LOOPHOLE[@segments[0]];
foo3:CARDINAL←LOOPHOLE[@segments[maxSeg]];
foo4:CARDINAL←LOOPHOLE[@orientation[0][0]];
foo5:CARDINAL←LOOPHOLE[@orientation[maxSide-1][maxSide-1]];
RETURN[s#NIL AND foo1 NOT IN [foo2..foo3] AND foo1 NOT IN [foo4..foo5]];
END;

AddToSeg:PROCEDURE RETURNS[ret:SegPtr]=BEGIN
ret←@segments[topSeg];
ret↑←[c:none,circuit:0,nc:FALSE, bc:FALSE, ac:FALSE, dummy:FALSE,
w:none,xy:[FALSE,FALSE,0,0],
next:NIL, back:NIL, across:NIL, first:NIL, second:NIL, stick:NIL];
topSeg←topSeg+1;
IF topSeg=maxSeg THEN Error;
END;

RealWay: TYPE = Way[l..d];
SetTabA:ARRAY Contact OF ARRAY RealWay OF OrientState =
[[aLeft,cLeft,cDown,aDown]
,[gVert,gVert,gHorr,gHorr]
,[cLeft,aLeft,aDown,cDown]];

ConstrainOrState: PROCEDURE[con: Contact, nub: Way, oldState: OrientState]
RETURNS[success: BOOLEAN,newState: OrientState]=
BEGIN
success←TRUE;
IF nub=none THEN BEGIN Error; RETURN[TRUE,oldState] END;
newState ← SetTabA[con][nub];
IF oldState=newState THEN RETURN;
SELECT oldState FROM
none,unkn => RETURN;
gHorr => IF newState IN [gHorr..cLeft] THEN RETURN;
aLeft,cLeft=> IF newState=gHorr THEN RETURN[TRUE,oldState];
gVert => IF newState IN [gVert..cDown] THEN RETURN;
aDown,cDown=> IF newState=gVert THEN RETURN[TRUE,oldState];
ENDCASE;
RETURN[FALSE,oldState];
END;

pullupTie: ARRAY BOOLEAN OF Contact = [chanA,chanB];

NewOrState: PROCEDURE[nub: Way, l: Location]= BEGIN
newState: OrientState;
test: BOOLEAN;
or:OrientDataPtr←@orientation[l.i][l.j];
IF ~or.pullup OR l.contact=pullupTie[~or.pullupToC] THEN
BEGIN
[test,newState]←ConstrainOrState[l.contact,nub,or.state];
IF test THEN or.state←newState ELSE Error;
END
ELSE BEGIN -- assert pullup and l.contact in {gate,pullupTie[pullupToC]}
[test,newState]←ConstrainOrState[gate,nub,or.state];
IF test THEN or.state←newState
ELSE BEGIN
[test,newState]←
ConstrainOrState[pullupTie[or.pullupToC],nub,or.state];
IF test THEN or.state←newState ELSE Error;
END;
END;
END;


SetInitialSegment:PUBLIC PROCEDURE[l:Location,n:NodePtr,circuit: INTEGER]
RETURNS[BOOLEAN,BOOLEAN]=BEGIN
s:SegPtr←n.s;
or:OrientDataPtr←@orientation[l.i][l.j];
nub: Way;
IF l.i NOT IN [0..side+1] OR l.j NOT IN [0..side+1] THEN Error;
s.circuit←circuit;
SELECT s FROM
@or.upSeg=>nub←u;
@or.rightSeg=>nub←r;
or.leftSeg.back=>nub←l;
or.downSeg.back=>nub←d;
ENDCASE=>RETURN[n.normal,TRUE];
NewOrState[nub,l];
RETURN[SELECT nub FROM r,u=>TRUE, ENDCASE=>FALSE, FALSE];
END;

SetFinalSegment:PUBLIC PROCEDURE[l:Location,s:SegPtr,n:NodePtr,
circuit: INTEGER]=BEGIN
or:OrientDataPtr←@orientation[l.i][l.j];
nub: Way;
IF l.i NOT IN [0..side+1] OR l.j NOT IN [0..side+1] THEN Error;
s.circuit←circuit;
SELECT s FROM
or.upSeg.next=>BEGIN nub←u; or.upSeg.nc←s.bc←TRUE; END;
or.rightSeg.next=>BEGIN nub←r; or.rightSeg.nc←s.bc←TRUE; END;
or.leftSeg.back=>BEGIN nub←l; or.leftSeg.bc←s.nc←TRUE; END;
or.downSeg.back=>BEGIN nub←d; or.downSeg.bc←s.nc←TRUE; END;
ENDCASE=>BEGIN IF n.normal THEN s.back.nc←s.bc←TRUE
ELSE s.nc←s.next.bc←TRUE;
RETURN; END;
NewOrState[nub,l];
END;

--/////// START ORIENT ///////

orientationArray:TYPE=ARRAY [0..maxSide) OF ARRAY[0..maxSide) OF OrientData;
orientation:POINTER TO orientationArray←NIL;

OrientTable1:ARRAY OrientState OF ARRAY Contact OF INTEGER←
[[9,9,9],[1,1,1],[6,3,6],[8,3,7],[7,3,8],[3,6,3],[4,6,5],[5,6,4]];

OrientTable2:ARRAY [0..9] OF INTEGER←[0,2,3,4,9,9,7,9,9,0];
OrientTable3:ARRAY [0..9] OF Way←[none,l,r,u,d,u,l,r,l,none];

EnumerateOrient:PUBLIC PROCEDURE[l:Location,call:PROCEDURE[SegPtr, Contact] RETURNS[BOOLEAN]] RETURNS[BOOLEAN]=
BEGIN
or:OrientDataPtr←@orientation[l.i][l.j];
k:INTEGER;
con: Contact;
FOR k←OrientTable1[or.state][l.contact],OrientTable2[k] UNTIL k=9 DO
IF call[SELECT OrientTable3[k] FROM
l=>or.leftSeg.back,
r=>@or.rightSeg,
u=>@or.upSeg,
d=>or.downSeg.back,
ENDCASE=>ERROR, l.contact] THEN RETURN[TRUE];
ENDLOOP;
IF ~or.pullup THEN RETURN[FALSE];-- done except for pullups
IF or.pullupToC THEN
IF l.contact=chanA THEN RETURN[FALSE]
ELSE con←IF l.contact=gate THEN chanB ELSE gate
ELSE IF l.contact=chanB THEN RETURN[FALSE]
ELSE con←IF l.contact=gate THEN chanA ELSE gate;
FOR k←OrientTable1[or.state]
[con],OrientTable2[k]
UNTIL k=9 DO
IF call[SELECT OrientTable3[k] FROM
l=>or.leftSeg.back,
r=>@or.rightSeg,
u=>@or.upSeg,
d=>or.downSeg.back,
ENDCASE=>ERROR, con] THEN RETURN[TRUE];
ENDLOOP;
RETURN[FALSE];
END;

FixCorners:PROCEDURE=BEGIN
orientation[0][1].rightSeg.second←@orientation[1][0].upSeg;
orientation[1][0].upSeg.first ←@orientation[0][1].rightSeg;
orientation[0][side].rightSeg.first ←@orientation[1][side+1].downSeg;
orientation[1][side+1].downSeg.first ←@orientation[0][side].rightSeg;
orientation[side+1][1].leftSeg.second←@orientation[side][0].upSeg;
orientation[side][0].upSeg.second←@orientation[side+1][1].leftSeg;
orientation[side+1][side].leftSeg.first ←@orientation[side][side+1].downSeg;
orientation[side][side+1].downSeg.second←@orientation[side+1][side].leftSeg;
END;

SetPullup:PUBLIC PROCEDURE[l:Location]=
BEGIN orientation[l.i][l.j].pullup←TRUE; END;

ClearOrientation:PROCEDURE[i,j:INTEGER]=BEGIN
or:OrientDataPtr←@orientation[i][j];
or.num←0;
or.pullup←(or.pullupToC←grid[i][j].b=grid[i][j].c)
OR (grid[i][j].b=grid[i][j].a);
or.state←IF grid[i][j]=nullTransistor THEN none ELSE unkn;
or.leftSeg←[c:none,circuit:nullCircuit,nc:FALSE,bc:FALSE,ac:FALSE,dummy:TRUE,w:l,
next:NIL,
xy:[FALSE,FALSE,i-1,j],
back:@orientation[i-1][j].rightSeg,
across:@orientation[i-1][j].rightSeg,
first:@or.upSeg,second:@or.downSeg,stick:NIL];
or.rightSeg←[c:none,circuit:nullCircuit,nc:FALSE,bc:FALSE,ac:FALSE,dummy:TRUE,w:r,
next:@orientation[i+1][j].leftSeg,
xy:[FALSE,FALSE,i,j],
back:NIL,
across:@orientation[i+1][j].leftSeg,
first:@or.upSeg,second:@or.downSeg,stick:NIL];
or.upSeg←[c:none,circuit:nullCircuit,nc:FALSE,bc:FALSE,ac:FALSE,dummy:TRUE,w:u,
next:@orientation[i][j+1].downSeg,
xy:[TRUE,FALSE,i,j],
back:NIL,
across:@orientation[i][j+1].downSeg,
first:@or.leftSeg,second:@or.rightSeg,stick:NIL];
or.downSeg←[c:none,circuit:nullCircuit,nc:FALSE,bc:FALSE,ac:FALSE,dummy:TRUE,w:d,
next:NIL,
xy:[TRUE,FALSE,i,j-1],
back:@orientation[i][j-1].upSeg,
across:@orientation[i][j-1].upSeg,
first:@or.leftSeg,second:@or.rightSeg,stick:NIL];
IF i=0 THEN BEGIN
or.rightSeg.first←@orientation[i][j+1].rightSeg;
or.rightSeg.second←@orientation[i][j-1].rightSeg;
END;
IF i=side+1 THEN BEGIN
or.leftSeg.first←@orientation[i][j+1].leftSeg;
or.leftSeg.second←@orientation[i][j-1].leftSeg;
END;
IF j=0 THEN BEGIN
or.upSeg.first←@orientation[i-1][j].upSeg;
or.upSeg.second←@orientation[i+1][j].upSeg;
END;
IF j=side+1 THEN BEGIN
or.downSeg.first←@orientation[i-1][j].downSeg;
or.downSeg.second←@orientation[i+1][j].downSeg;
END;
END;

--/////////////START STICKS//////////////

StkArray:TYPE=ARRAY [0..maxStk] OF Stk;
stks:POINTER TO StkArray←NIL;
topStk:INTEGER;
maxStk:INTEGER=200;
dummyStk:INTEGER;
lineH:ARRAY [0..maxSide] OF INTEGER;--contains y position of row j
lineV:ARRAY [0..maxSide] OF INTEGER;--contains x position of col i
maxC,minC:INTEGER;
first:BOOLEAN;
dd:Direction;
jj,zz:INTEGER;

TurnToStks:PUBLIC PROCEDURE[print:BOOLEAN]
RETURNS[limitX,limitY:INTEGER]=BEGIN
ValidateSegs[];
topStk←0;
EnumerateSidePlusTwo[MakeDummies];
dummyStk←topStk;
EnumerateGridPlusOne[MakeStks];
maxC←0; dd←h; EnumerateSidePlusOne[MakeRowOfMajors];
EnumerateGridPlusOne[MakeMinors];
maxC←0; dd←v; EnumerateSidePlusOne[MakeRowOfMajors];
EnumerateGridPlusOne[MakeMinors];
IF print THEN BEGIN debugPrint←TRUE; PrintStks[]; debugPrint←FALSE; END;
limitX←4*lineV[side]+5; -- Set up the global limits.
limitY←4*lineH[side]+5;
BEGIN OPEN IODefs;
WriteString["limitX="]; WriteNumber[limitX,[10,FALSE,TRUE,6]];
WriteString[" limitY="];WriteNumber[limitY,[10,FALSE,TRUE,6]];
WriteLine[""];
END;
END;

MakeDummies:PROCEDURE[i:INTEGER]=BEGIN
MakeAllDummy:PROCEDURE[i:INTEGER]=BEGIN
orientation[i][j].upSeg.stick←thisU;
orientation[j][i].rightSeg.stick←thisR;
orientation[i][j].downSeg.stick←thisD;
orientation[j][i].leftSeg.stick←thisL;
END;
j:INTEGER←i;
thisU:StkPtr←AddToStk[h,none,nullCircuit];
thisD:StkPtr←AddToStk[v,none,nullCircuit];
thisL:StkPtr←AddToStk[h,none,nullCircuit];
thisR:StkPtr←AddToStk[v,none,nullCircuit];
EnumerateSidePlusTwo[MakeAllDummy];
END;

MakeStks:PROCEDURE[i,j:INTEGER]=BEGIN
or:OrientDataPtr←@orientation[i][j];
d:Direction;
MakeAStick:PROCEDURE[s:SegPtr]=BEGIN
sf:SegPtr←s.first; ss:SegPtr←s.second;
stkf:StkPtr←sf.stick; stks:StkPtr←ss.stick;
bf:BOOLEAN←sf#NIL AND stkf#NIL AND stkf.dir=d;
bs:BOOLEAN←ss#NIL AND stks#NIL AND stks.dir=d;
IF s=NIL OR s.stick#NIL THEN RETURN;
IF bf AND bs THEN Error;
s.stick←SELECT TRUE FROM bf=>sf.stick, bs=>ss.stick,
ENDCASE=>AddToStk[d,IF s.xy.l THEN b ELSE s.c,s.circuit];
END;
d←h; EnumerateAllSegs[@or.upSeg,MakeAStick];
d←v; EnumerateAllSegs[@or.rightSeg,MakeAStick];
END;

MakeRowOfMajors:PROCEDURE[i:INTEGER]=BEGIN
jj←i;
IF dd=h THEN orientation[1][i].downSeg.stick.major←maxC+1
ELSE orientation[i][1].leftSeg.stick.major←maxC+1;
IF dd=h THEN lineH[i]←maxC+2 ELSE lineV[i]←maxC+2;
maxC←minC←maxC+3;
IF dd=h THEN orientation[1][i].upSeg.stick.major←maxC
ELSE orientation[i][1].rightSeg.stick.major←maxC;
EnumerateSide[MakeMajors];
END;

MakeMajors:PROCEDURE[i:INTEGER]= BEGIN
s:SegPtr←IF dd=h THEN @orientation[i][jj].upSeg
ELSE @orientation[jj][i].rightSeg;
EnumerateAllSegs[s,StartProcessStk];
END;

MakeMinors:PROCEDURE[i,j:INTEGER]=BEGIN
zz←IF dd=h THEN lineH[j] ELSE lineV[i];
EnumerateAllSegs[IF dd=h THEN @orientation[i][j].rightSeg
ELSE @orientation[i][j].upSeg,SetMinors];
END;

SetMinors:PROCEDURE[s:SegPtr]=BEGIN
stk:StkPtr←s.stick;
sf:SegPtr←s.first; ss:SegPtr←s.second;
stkf:StkPtr←sf.stick; stks:StkPtr←ss.stick;
stk.minor1←SELECT TRUE FROM
sf=NIL =>zz, stkf.dir=dd=>stkf.major, ENDCASE=>stk.minor1;
stk.minor2←SELECT TRUE FROM
ss=NIL =>zz, stks.dir=dd=>stks.major, ENDCASE=>stk.minor2;
END;

StkState:TYPE={unknown,first,second,across};
loop:INTEGER;

StartProcessStk:PROCEDURE[s:SegPtr]=BEGIN loop←0; []←ProcessStk[s,unknown] END;

ProcessStk:PROCEDURE[s:SegPtr,k:StkState] RETURNS[g:INTEGER]=BEGIN
q:StkPtr←s.stick; l:SegPtr;
back:INTEGER←s.back.stick.major;
IF q.dir#dd THEN RETURN[0];
IF q.major>0 THEN RETURN[q.major];
IF s.dummy THEN RETURN[q.major←IF s.w=l OR s.w=d THEN maxC ELSE minC];
loop←loop+1; IF loop>30 THEN BEGIN Error;RETURN[0] END;
IF back=0 THEN back←ProcessStk[s.back,unknown];
g←MAX[IF s.bc THEN back ELSE back+1,DoAnEnd[s,first,k],DoAnEnd[s,second,k],
IF k=across THEN 0 ELSE ProcessStk[s.across,across]];
FOR l←s,l.back UNTIL l.w=r OR l.w=u DO ENDLOOP;
FOR l←IF s.xy.l THEN l.next ELSE l.across,l.next UNTIL l.dummy
DO IF l.stick.major=g AND s.across#l THEN g←g+1; ENDLOOP;
s.stick.major←g;
maxC←MAX[maxC,g];
loop←loop-1;
IF g>1000 THEN Error;
END;

DoAnEnd:PROCEDURE[s:SegPtr,w,k:StkState] RETURNS[g:INTEGER]=BEGIN
up,a:SegPtr;
b:SegPtr←IF w=first THEN s.first ELSE s.second;
g←0;
SELECT TRUE FROM
b=NIL=>NULL;
k#unknown AND k#w =>NULL;
b.stick=s.stick=>g←MAX[g,ProcessStk[b,w]];
dd#v=>NULL;
(up←Up[s,b])=NIL=>NULL;
ENDCASE=>FOR a←up,a.next UNTIL a.dummy
DO IF Overlap[a,s] THEN g←MAX[g,ProcessStk[a,unknown]+1];
ENDLOOP;
END;

Up:PROCEDURE[base,s:SegPtr] RETURNS[t:SegPtr]=BEGIN
x:INTEGER←base.xy.x; dx:INTEGER←s.xy.x-x;
y:INTEGER←base.xy.y; dy:INTEGER←s.xy.y-y;
IF dx#1 AND dy#1 THEN RETURN[NIL];
t←IF base.xy.h THEN @orientation[x+2*dx+1][y].upSeg
ELSE @orientation[x][y+2*dy+1].rightSeg;
RETURN[IF base.xy.l THEN t.across ELSE t.next];
END;

Overlap:PROCEDURE[m,n:SegPtr] RETURNS[BOOLEAN]=BEGIN
a:INTEGER←m.stick.minor1;
b:INTEGER←m.stick.minor2;
IF a>b THEN BEGIN t:INTEGER←a; a←b; b←t; END;
RETURN[n.stick.minor1 IN [a..b] OR n.stick.minor2 IN [a..b]];
END;

AddToStk:PROCEDURE[d:Direction,color:Color,circuit: INTEGER]
RETURNS[s:StkPtr]=BEGIN
s←@stks[topStk];
s↑←[dir:d,major:0,minor1:0,minor2:0,c:color,circuit: circuit];
topStk←topStk+1;
IF topStk>=maxStk THEN Error;
END;

-- //// Sticks Display Code //// --

PrintStks:PUBLIC PROCEDURE=BEGIN
i:INTEGER; FOR i IN [dummyStk..topStk) DO BEGIN
stk:StkPtr←@stks[i];
a:INTEGER←4*stk.minor1;
b:INTEGER←4*stk.minor2;
c:INTEGER←4*stk.major;
hue:Color←IF stk.c=none THEN r ELSE stk.c;
IF a>b THEN BEGIN t:INTEGER←a; a←b; b←t; END;
IF stk.dir=h THEN PutBox[hue,a,c,b+1-a,1] ELSE PutBox[hue,c,a,1,b-a];
END; ENDLOOP;
IF debugPrint THEN BEGIN
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Orientations --"];
END;
first←TRUE; EnumerateGrid[PrintOrientations];
IF debugPrint THEN BEGIN
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Horizontal Lines --"];
END;
dd←h; EnumerateSidePlusOne[PrintLines];
IF debugPrint THEN BEGIN
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Vertical Lines --"];
END;
dd←v; EnumerateSidePlusOne[PrintLines];
END;

PrintLines:OnI=BEGIN
IF i=0 THEN IODefs.WriteChar[CR];
IODefs.WriteNumber[IF dd=h THEN lineV[i] ELSE lineH[i],[10,FALSE,TRUE,4]];
END;

stateStrings: ARRAY OrientState OF STRING=
[" none"," unkn"," gHorr"," aLeft"," cLeft"," gVert"," aDown"," cDown"];

PrintOrientations: PUBLIC PROCEDURE[i,j:INTEGER]=BEGIN
s,ss:SegPtr; major:INTEGER;
row:INTEGER←4*lineH[j];
col:INTEGER←4*lineV[i];
or:OrientData←orientation[i][j];
xTop:INTEGER←4*FindStubEnd[@or.rightSeg];
xBot:INTEGER←4*FindStubEnd[@or.leftSeg];
yTop:INTEGER←4*FindStubEnd[@or.upSeg];
yBot:INTEGER←4*FindStubEnd[@or.downSeg];
c:Color;

-- BEGIN A SLEAZY HACK TO GET AROUND THE FACT THAT THE DUMMIES MAJOR
-- COORDINATES ARE NOT CORRECTLY INITIALIZED. WILL, I HOPE YOU CAN
-- FIND THE CORRECT METHOD FOR DEALING WITH THIS. ROB.

-- IF xTop<=xBot THEN xTop← col+ABS[col-xBot];
-- IF yTop<=yBot THEN yTop← row+ABS[row-yBot];

IF debugPrint THEN BEGIN OPEN IODefs;
-- print complete orientation record
WriteString["O:"];
WriteNumber[i,[10,FALSE,TRUE,4]];
WriteNumber[j,[10,FALSE,TRUE,4]];
WriteString[stateStrings[or.state]];
WriteChar[’ ];
WriteChar[IF or.pullup THEN ’T ELSE ’F];
PrintOneSeg[@or.rightSeg];
PrintOneSeg[@or.leftSeg];
PrintOneSeg[@or.upSeg];
PrintOneSeg[@or.downSeg];
WriteLine[""];
END ELSE BEGIN
SELECT or.state FROM
none=> BEGIN RETURN END; -- no transistor at this location
unkn=>BEGIN IF first THEN Error; first←FALSE; RETURN; END;
gHorr,aLeft,cLeft=>c←g;
gVert,aDown,cDown=>c←r;
ENDCASE=>Error;
PutBox[c,xBot,row,xTop+1-xBot,1];
PutBox[IF c=g THEN r ELSE g,col,yBot,1,yTop-yBot];
ss←@or.rightSeg;
FOR s←ss,s.next UNTIL s.w=l DO
major←s.stick.major;
IF s.across#NIL AND (s.w#r OR s.ac) THEN
PutBox[b,major,row,s.across.stick.major+1-major,1];
IF s.nc AND major>xTop THEN
PutBox[s.c,major,row,s.next.stick.major+1-major,1];
ENDLOOP;
FOR s←ss.across,s.next UNTIL s.w=l DO
major←s.stick.major;
IF s.nc AND major>xTop THEN
PutBox[s.c,major,row,s.next.stick.major-major+1,1];
ENDLOOP;
ss←@or.upSeg;
FOR s←ss,s.next UNTIL s.w=d DO
major←s.stick.major;
IF s.across#NIL AND (s.w#u OR s.ac) THEN
PutBox[b,col,major,1,s.across.stick.major-major];
IF s.nc AND major>xTop THEN
PutBox[s.c,col,major,1,s.next.stick.major-major];
ENDLOOP;
FOR s←ss.across,s.next UNTIL s.w=d DO
major←s.stick.major;
IF s.nc AND major>xTop THEN
PutBox[s.c,col,major,1,s.next.stick.major-major];
ENDLOOP;
IF or.pullup THEN -- There has to be a more elegant way !!!
IF or.pullupToC THEN SELECT or.state FROM
aLeft,cDown=>
BEGIN PutBox[r,col,row-4,4,1]; PutBox[r,col+4,row-4,1,5]; END;
cLeft,aDown=>
BEGIN PutBox[r,col-4,row+4,5,1]; PutBox[r,col-4,row,1,4]; END;
ENDCASE=>Error
ELSE SELECT or.state FROM
aLeft,cDown=>
BEGIN PutBox[r,col-4,row+4,5,1]; PutBox[r,col-4,row,1,4]; END;
cLeft,aDown=>
BEGIN PutBox[r,col,row-4,4,1]; PutBox[r,col+4,row-4,1,5]; END;
ENDCASE=>Error
END;
END;

FindStubEnd:PROCEDURE[s:SegPtr] RETURNS[m:INTEGER]=BEGIN
ss:SegPtr;
IF s.w=u OR s.w=r THEN FOR ss←s,ss.next UNTIL ~ss.nc
DO IF ss=NIL THEN Error; ENDLOOP
ELSE FOR ss←s,ss.back UNTIL ~ss.bc
DO IF ss=NIL THEN Error; ENDLOOP;
IF ss.w=u OR ss.w=r THEN ss←s;--new stuff
RETURN[ss.stick.major];
END;

--/////// END STICKS ///////

--//////////////CONTROL///////////////

AllocateStuffForSeg:PUBLIC PROCEDURE=BEGIN OPEN SystemDefs;
segments←AllocateSegment[SIZE[SegArray]];
orientation←AllocateSegment[SIZE[orientationArray]];
stks←AllocateSegment[SIZE[StkArray]];
END;

END..