-- 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[PrintCvt[w]];
WriteChar[SELECT s.c FROM none =>’-, r=>’r, g=>’g, b=>’b, ENDCASE=>ERROR];
WriteChar[IF s.xy.l THEN ’B ELSE ’ ];
WriteChar[IF s.nc THEN ’n ELSE ’-];
WriteChar[IF s.bc THEN ’b ELSE ’-];
WriteChar[IF s.first#NIL THEN ’F ELSE ’-];
WriteChar[IF s.second#NIL THEN ’S ELSE ’-];
WriteChar[IF s.across#NIL THEN ’A ELSE ’-];
WriteNumber[s.circuit,[10,FALSE,TRUE,4]];
IF s.stick#NIL THEN WriteNumber[s.stick.major,[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: Circuit,
old:SegPtr,tieN,tieB:BOOLEAN]
RETURNS[SegPtr]=BEGIN
this:SegPtr←AddToSeg[];
back:SegPtr←from.s;
t,extra,next:SegPtr;
forward: BOOLEAN;
myLevel:BOOLEAN←from.l;
backAcross,nextAcross, tieExists :BOOLEAN;
IF from=NIL THEN Error;
IF IllegalSeg[back] THEN Error;
this.c←IF myLevel THEN b ELSE col;
this.circuit←circuit;
this.xy←back.xy;
this.xy.l←myLevel;
-- set the next and back pointers
IF (backAcross←back.xy.l#myLevel) THEN BEGIN
IF ~back.dummy THEN Error;-- should be true only if back is a dummy
next←back.across;
back.across←this;
END ELSE BEGIN
next←back.next;
back.next←this;
END;
this.next←next; IF next=NIL THEN Error; -- remove these traps soon
this.back←back; IF back=NIL THEN Error;
IF (nextAcross←next.xy.l#myLevel) THEN next.across←this
ELSE next.back←this;
-- Now decide who’s electrically connected.
tieExists←IF backAcross THEN back.ac ELSE back.nc;
IF tieExists OR tieN THEN BEGIN
this.nc←TRUE;
IF nextAcross THEN next.ac←TRUE
ELSE next.bc←TRUE;
END;
IF ~nextAcross AND this.circuit=next.circuit
THEN this.nc←next.bc←TRUE;
IF tieExists OR tieB THEN BEGIN
this.bc←TRUE;
IF backAcross THEN back.ac←TRUE
ELSE back.nc←TRUE;
END;
IF ~backAcross AND this.circuit=this.back.circuit
THEN this.bc←this.back.nc←TRUE;
-- Finally handle the across and first/second connections
IF old#NIL THEN BEGIN
IF old.xy.l=myLevel THEN BEGIN -- just hook up first and second
old.second←this;
this.first←old;
IF this.xy=old.xy THEN Error;
END
ELSE IF ~old.dummy THEN BEGIN -- change levels
IF old.across#NIL THEN BEGIN -- old already crosses once
extra←AddToSeg[];-- so add an extra segment
extra.xy←old.xy;
extra.c←old.c;
extra.circuit←old.circuit;
-- decide which side it belongs on
forward←TRUE;
FOR t←this.next,t.next UNTIL t.dummy DO
IF old.across=t THEN BEGIN
forward←FALSE; EXIT; END;
ENDLOOP;
IF forward THEN BEGIN -- add extra on the next side of old
extra.next←old.next;
IF old.next.xy.l#old.xy.l THEN
old.next.across←extra
ELSE old.next.back←extra;
extra.back←old;
old.next←extra;
extra.bc←old.nc←TRUE;
END ELSE BEGIN -- add extra on the back side of old
extra.back←old.back;
IF old.back.xy.l#old.xy.l THEN
old.back.across←extra
ELSE old.back.next←extra;
extra.next←old;
old.back←extra;
extra.nc←old.bc←TRUE;
END;
old←extra;
END;
old.across←this;
this.across←old;
END;
END;
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: Circuit]
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;
IF n.contact=none THEN RETURN[n.normal,TRUE];
-- The connection to a transistor must be made.
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];
SELECT nub FROM
u,r => s.circuit←circuit;
l,d => s.next.circuit←circuit;
ENDCASE;
NewOrState[nub,l];
RETURN[SELECT nub FROM r,u=>TRUE, ENDCASE=>FALSE, FALSE];
END;

SetFinalSegment:PUBLIC PROCEDURE[l:Location,s:SegPtr,n:NodePtr,
circuit: Circuit]=BEGIN
or:OrientDataPtr←@orientation[l.i][l.j];
nub: Way;

HookIt: PROCEDURE=
BEGIN -- these connections across levels are inappropriate
IF s.circuit=s.next.circuit THEN
IF s.xy.l=s.next.xy.l THEN s.nc←s.next.bc←TRUE;
IF s.circuit=s.back.circuit THEN
IF s.xy.l=s.back.xy.l THEN s.bc←s.back.nc←TRUE;
RETURN;
END;

IF l.i NOT IN [0..side+1] OR l.j NOT IN [0..side+1] THEN Error;
IF n.contact=none THEN BEGIN HookIt[]; RETURN; END;
SELECT s FROM
or.upSeg.next=>BEGIN nub←u; or.upSeg.nc←s.bc←TRUE;
or.upSeg.circuit←circuit; END;
or.rightSeg.next=>BEGIN nub←r; or.rightSeg.nc←s.bc←TRUE;
or.rightSeg.circuit←circuit; END;
or.leftSeg.back=>BEGIN nub←l; or.leftSeg.bc←s.nc←TRUE;
or.leftSeg.circuit←circuit; END;
or.downSeg.back=>BEGIN nub←d; or.downSeg.bc←s.nc←TRUE;
or.downSeg.circuit←circuit; END;
ENDCASE=> BEGIN HookIt[]; RETURN; END;
NewOrState[nub,l];
END;

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

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

-- Orientstates are: none,unkn,gHorr,aLeft,cLeft,gVert,aDown,cDown
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
i: INTEGER;
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];
FOR i IN [0..topSeg) DO AdjustMinors[@segments[i]]; ENDLOOP;
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;

AdjustMinors: PROCEDURE[s: SegPtr]= BEGIN
m1,m2: INTEGER;
IF ~(s.nc AND s.next.circuit#s.circuit) -- Are we at a level change between
OR ~(s.bc AND s.back.circuit#s.circuit) -- next/back connected segs. of
OR s.across=NIL THEN RETURN; -- another circuit?
-- We have to adjust either minor1 or minor2
m1←s.stick.minor1; m2←s.stick.minor2;
IF s.first=NIL THEN -- shorten s, lengthen s.across
IF s.second#NIL THEN s.stick.minor1←s.across.stick.minor2←
m1 + (IF m1<m2 THEN 1 ELSE -1)
ELSE Error -- both are NIL!
ELSE IF s.second=NIL THEN s.stick.minor2←s.across.stick.minor1←
m2 + (IF m1>m2 THEN 1 ELSE -1)
ELSE Error; -- neither is NIL!
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+4;
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,0]
END;

ProcessStk:PROCEDURE[s:SegPtr,k:StkState,bestSoFar: INTEGER]
RETURNS[g:INTEGER]=BEGIN
q:StkPtr←s.stick; l:SegPtr;
back:INTEGER←s.back.stick.major;
IF s=NIL THEN Error;
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,0];
g←MAX[bestSoFar, IF s.bc AND s.circuit=s.back.circuit THEN back
ELSE back+1,DoAnEnd[s,first,k],DoAnEnd[s,second,k]];
g←MAX[g, IF k=across OR s.across=NIL THEN 0
ELSE ProcessStk[s.across,across,g]];
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
THEN IF s.circuit#l.circuit THEN g←g+1 ELSE EXIT;
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;
IF b=NIL OR (k=first AND w=second OR w=first AND k=second) THEN RETURN;
IF b.stick=s.stick THEN BEGIN
g←MAX[g,ProcessStk[b,w,0]];
RETURN;
END;
IF (up←Up[s,b])=NIL THEN RETURN
ELSE IF dd=v THEN -- On second pass use geometry!
FOR a←up,a.next UNTIL a.dummy DO
IF Overlap[a,s] THEN g←MAX[g,ProcessStk[a,unknown,0]+1];
ENDLOOP
ELSE BEGIN -- on horizontal pass use topology.
FOR a←up,a.next UNTIL a.dummy DO ENDLOOP; -- get across
-- a is now the dummy on the "high" side.
FOR a←IF s.xy.l THEN a.across ELSE a.back,a.back UNTIL a.dummy DO
BEGIN
IF a.first#NIL THEN IF TurnsDown[s,a.first] THEN BEGIN
g←MAX[g,ProcessStk[a,unknown,0]+1];
RETURN;
END;
IF a.second#NIL THEN IF TurnsDown[s,a.second] THEN BEGIN
g←MAX[g,ProcessStk[a,unknown,0]+1];
RETURN;
END;
END;
ENDLOOP;
END;
END;

TurnsDown:PROCEDURE[base,s:SegPtr] RETURNS[BOOLEAN]=BEGIN
-- Based loosely on Up (below) this routine returns TRUE iff
-- s is adjacent to base (TowardHome in WiresPlace) and is at right angles
-- either downward or to the left.
dx:INTEGER←s.xy.x-base.xy.x;
dy:INTEGER←s.xy.y-base.xy.y;
IF base.xy.h=s.xy.h THEN RETURN[FALSE]; -- it has to turn
RETURN[ IF base.xy.h THEN IF dy=0 AND (dx=0 OR dx=-1) THEN TRUE ELSE FALSE
ELSE IF dx=0 AND (dy=0 OR dy=-1) THEN TRUE ELSE FALSE];
END;

Up:PROCEDURE[base,s:SegPtr] RETURNS[t:SegPtr]=BEGIN
-- This particularly baroque piece of code first decides whether
-- s is at right angles to base in the "up" ("right") direction and
-- if so it returns a pointer to (dummy seg).(next or across) in the
-- same row (column) as base on the side nearest to s. Some trick, eh?
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
-- this guy returns true if m and n are in different circuits and
-- their sticks overlap in the minors. (Note that it doesn’t check
-- the major coordinates !)
a:INTEGER←m.stick.minor1;
b:INTEGER←m.stick.minor2;
IF m.circuit=n.circuit THEN RETURN[FALSE];
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; EnumerateGridPlusOne[PrintOrientations];
IF debugPrint THEN BEGIN
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Horizontal Lines --"];
dd←h; EnumerateSidePlusOne[PrintLines];
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Vertical Lines --"];
dd←v; EnumerateSidePlusOne[PrintLines];
END;
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;
gateColor: Color;
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;

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.leftSeg];
PrintOneSeg[@or.rightSeg];
PrintOneSeg[@or.upSeg];
PrintOneSeg[@or.downSeg];
WriteLine[""];
END;
IF or.state#none THEN BEGIN -- If there’s a transistor here then do it.
gateColor← IF or.pullup THEN y ELSE r;
SELECT or.state FROM
unkn=>BEGIN IF first THEN Error; first←FALSE; RETURN; END;
gHorr,aLeft,cLeft=>c←g;
gVert,aDown,cDown=>c←gateColor;
ENDCASE=>Error;
PutBox[c,xBot,row,xTop+1-xBot,1];
PutBox[IF c=g THEN gateColor ELSE g,col,yBot,1,yTop-yBot];
END;
-- tie bundles to the right
ss←@or.rightSeg;
FOR s←ss,s.next UNTIL s.w=l DO -- i.e. until running into a left dummy
major←s.stick.major;
IF s.across#NIL AND (s.w#r OR s.ac) THEN
PutBox[b,4*MIN[major,s.across.stick.major],row,
4*ABS[s.across.stick.major-major]+1,1];
IF s.nc AND major>xTop THEN
PutBox[s.c,4*major,row,4*(s.next.stick.major-major)+1,1];
ENDLOOP;
FOR s←ss.across,s.next UNTIL s.w=l DO
major←s.stick.major;
IF s.nc THEN
PutBox[s.c,4*major,row,4*(s.next.stick.major-major)+1,1];
ENDLOOP;
-- tie bundles upward
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,4*MIN[major,s.across.stick.major],1,
4*ABS[s.across.stick.major-major]];
IF s.nc AND major>yTop THEN
PutBox[s.c,col,4*major,1,4*(s.next.stick.major-major)];
ENDLOOP;
FOR s←ss.across,s.next UNTIL s.w=d DO
major←s.stick.major;
IF s.nc THEN
PutBox[s.c,col,4*major,1,4*(s.next.stick.major-major)];
ENDLOOP;
-- Put in the pullup stubs.
IF or.state#none AND or.pullup THEN -- Put in the pullup stubs.
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;

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;

PrintStubs: PUBLIC PROCEDURE[i,j: INTEGER]= BEGIN OPEN IODefs;
ss: SegPtr;
WriteString[" ######### Chains for:"];
WriteNumber[i,[10,FALSE,TRUE,3]];
WriteNumber[j,[10,FALSE,TRUE,3]];
WriteLine[" ##########"];

WriteLine["---- UP !! ----"];
FOR ss←@orientation[i][j].upSeg,ss.next DO
PrintOneSeg[ss]; IF ss.w=d THEN EXIT; ENDLOOP;
WriteChar[CR];
WriteString[" ACROSS "];
FOR ss←orientation[i][j].upSeg.across,ss.next DO
PrintOneSeg[ss]; IF ss.w=d THEN EXIT; ENDLOOP;
WriteChar[CR];
WriteLine["---- RIGHT !! ----"];
FOR ss←@orientation[i][j].rightSeg,ss.next DO
PrintOneSeg[ss]; IF ss.w=l THEN EXIT; ENDLOOP;
WriteChar[CR];
WriteString[" ACROSS "];
FOR ss←orientation[i][j].rightSeg.across,ss.next DO
PrintOneSeg[ss]; IF ss.w=l THEN EXIT; ENDLOOP;
WriteChar[CR];
END;

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

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

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

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, (k=first AND w=second OR w=first AND k=second)=>NULL;
-- b.stick=s.stick=>g←MAX[g,ProcessStk[b,w,0]];
-- dd#v=>NULL; -- don’t worry about overlaps if on horizontal pass
-- (up←Up[s,b])=NIL=>NULL; -- if funny condition doesn’t hold quit
-- ENDCASE=>FOR a←up,a.next UNTIL a.dummy DO
-- IF Overlap[a,s] THEN g←MAX[g,ProcessStk[a,unknown,0]+1];
-- ENDLOOP;
-- END;