-- 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=6*maxSide*maxSide;

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];

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]];
WriteChar[’,];
WriteNumber[s.major,[10,FALSE,TRUE,4]];
WriteNumber[s.minorF,[10,FALSE,TRUE,4]];
WriteNumber[s.minorS,[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;

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: PUBLIC 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,
dogF:FALSE, dogS:FALSE, major:0, minorF:0, minorS:0];
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.state←IF i=0 OR j=0 OR i=maxSide OR j=maxSide OR
grid[i][j]=nullTransistor THEN none ELSE unkn;
or.pullup←IF or.state=none THEN FALSE ELSE
(or.pullupToC←grid[i][j].b=grid[i][j].c) OR(grid[i][j].b=grid[i][j].a);
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,
dogF:FALSE, dogS: FALSE, major:0, minorF:0, minorS:0];
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,
dogF:FALSE, dogS: FALSE, major:0, minorF:0, minorS:0];
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,
dogF:FALSE, dogS: FALSE, major:0, minorF:0, minorS:0];
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,
dogF:FALSE, dogS: FALSE, major:0, minorF:0, minorS:0];
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 replacement for sticks code ////////

dd:Direction;
tWidth: INTEGER=2;
SegEnd: TYPE= BOOLEAN; down: SegEnd = FALSE; up: SegEnd= TRUE;
Angle: TYPE= {down,thru,up};
MatRec: TYPE= RECORD[processed: BOOLEAN,
thickness: INTEGER, -- thickness of this section
m: ARRAY BOOLEAN OF ARRAY SegEnd OF -- TRUE=BLUE!
RECORD[downWidth, -- offset of last downturning wire
numThru: INTEGER] --offset of first upturning
];
MatRecPtr: TYPE = POINTER TO MatRec;
MatArray: TYPE= ARRAY [0..maxSide] OF ARRAY[0..maxSide] OF
ARRAY Direction OF MatRec;
mats: POINTER TO MatArray ← NIL;

DumpMats: PROCEDURE = BEGIN
EnumerateGridPlusOne[PrintOneMat];
END;

PrintOneMat: PROCEDURE[i,j: INTEGER] = BEGIN OPEN IODefs;
d: Direction;
l: BOOLEAN;
e: SegEnd;
here: MatRecPtr;
WriteNumber[i,[10,FALSE,TRUE,3] ];
WriteNumber[j,[10,FALSE,TRUE,3] ];
FOR d IN Direction DO
here← @mats[i][j][d];
WriteChar[’ ];
WriteChar[ IF here.processed THEN ’P ELSE ’ ];
WriteNumber[here.thickness,[10,FALSE,TRUE,3] ];
WriteChar[’ ];
FOR l IN BOOLEAN DO
WriteChar[IF l THEN ’B ELSE ’R ];
FOR e IN SegEnd DO
WriteChar[’(];
WriteNumber[here.m[l][e].downWidth,[10,FALSE,TRUE,3] ];
WriteNumber[here.m[l][e].numThru,[10,FALSE,TRUE,3] ];
WriteChar[’)];
ENDLOOP;
WriteChar[’ ];
ENDLOOP;
ENDLOOP;
WriteLine[""];
END;

matsPass2: BOOLEAN;

GenerateCoordinates: PUBLIC PROCEDURE RETURNS[limitX, limitY: INTEGER]=
BEGIN
ValidateSegs[];
InitializeMats[InitMatsOneCell];
CountThru[];
matsPass2←FALSE; MakeMats[]; -- first time through approximates ths solution
InitializeMats[TurnOffProcessedOneCell];
matsPass2←TRUE; MakeMats[]; -- second uses correct values for downwidths
SetMajors[];
SetMinors[];
AdjustMinors[];
RETURN[4*tLines[v][side+1], 4*tLines[h][side+1]];
END;

InitializeMats: PROCEDURE[zap: PROCEDURE[i,j: INTEGER]]= BEGIN
i,j: INTEGER;
EnumerateGridPlusTwo[zap];
FOR j IN [0..side+1] DO mats[0][j][h].processed←
mats[side+1][j][h].processed←TRUE;
ENDLOOP;
FOR i IN [0..side+1] DO mats[i][0][v].processed←
mats[i][side+1][v].processed←TRUE;
ENDLOOP;
END;

InitMatsOneCell: PROCEDURE[i,j: INTEGER]= BEGIN -- Initialize the mats.
d: Direction;
l: BOOLEAN;
e: SegEnd;
FOR d IN Direction DO
BEGIN OPEN here: mats[i][j][d];
here.thickness←0;
here.processed←FALSE;
FOR l IN BOOLEAN DO FOR e IN SegEnd DO
here.m[l][e].downWidth← here.m[l][e].numThru← 0;
ENDLOOP ENDLOOP;
END
ENDLOOP
END;

TurnOffProcessedOneCell: PROCEDURE[i,j: INTEGER]= BEGIN
d: Direction;
FOR d IN Direction DO
mats[i][j][d].processed←FALSE;
ENDLOOP
END;

CountThru: PROCEDURE = BEGIN
EnumerateGridPlusOne[CountThruOnePair];
END;

CountThruOnePair: PROCEDURE[i,j: INTEGER] = BEGIN
here: MatRecPtr;
s,start: SegPtr;
l: BOOLEAN;
d: Direction;
side: SegEnd;
angle: Angle;

AddEnd: PROCEDURE[ s,t: SegPtr]= BEGIN
[side,angle] ← Turns[s, t];
IF angle=thru THEN here.m[l][side].numThru← here.m[l][side].numThru+1;
END;

FOR d IN Direction DO
start← IF d=h THEN @orientation[i][j].upSeg
ELSE @orientation[i][j].rightSeg;
here ← @mats[i][j][d];
FOR l IN BOOLEAN DO
FOR s← IF l THEN start.across ELSE start.next, s.next UNTIL s.dummy DO
IF s.first#NIL THEN AddEnd[s,s.first];
IF s.second# NIL THEN AddEnd[s,s.second];
ENDLOOP;
ENDLOOP;
ENDLOOP;
END;

MakeMats: PROCEDURE= BEGIN
i,j: INTEGER;
FOR j IN [0..side] DO
FOR i IN [1..side] DO MakeOneMat[h,i,j]; ENDLOOP; -- Do the rows
ENDLOOP;
FOR i IN [0..side] DO
FOR j IN [1..side] DO MakeOneMat[v,i,j]; ENDLOOP; -- Do the columns
ENDLOOP;
END;

MakeOneMat: PROCEDURE[d: Direction, i,j: INTEGER]=
-- This procedure computes the relative major coordinates for each
-- wire in a mat.

BEGIN
m,other: MatRecPtr;
notFirstUp: ARRAY SegEnd OF ARRAY BOOLEAN OF BOOLEAN ← ALL[ALL[FALSE]];

ProcessEnd: PROCEDURE[ s,t: SegPtr, cur: INTEGER]
RETURNS[new: INTEGER]= BEGIN
IF s.circuit#s.back.circuit OR s.back.dummy THEN cur←cur+1;
[side,angle] ← Turns[s, t];
l← s.xy.l;
SELECT angle FROM
down=> BEGIN
new ← cur;
IF ~s.dummy THEN needToSetDown[l][side]←TRUE;
END;
thru=> new ← cur;
up=> BEGIN -- find the constraint
IF notFirstUp[side][l] THEN new←cur
ELSE BEGIN
middle← IF side=up THEN
MAX[myMiddle←mats[i][j][d].m[l][up].numThru,
mats[i][j][IF d=v THEN h ELSE v].m[l][up].numThru]
ELSE IF d=v
THEN MAX[mats[i][j-1][h].m[l][up].numThru,
myMiddle← mats[i][j][v].m[l][down].numThru]
ELSE MAX[mats[i-1][j][v].m[l][up].numThru,
myMiddle←mats[i][j][h].m[l][down].numThru];
IF (~matsPass2 AND middle>0) OR (d=v) = l THEN BEGIN
-- blues use bot to keep opposite corners clear on
-- the vertical pass, red/green on horizontal.
otherI ← i + ( IF d=v THEN 0 ELSE
IF side=up THEN 1 ELSE -1);
otherJ ← j + ( IF d=h THEN 0 ELSE
IF side=up THEN 1 ELSE -1);
other← @mats[otherI][otherJ][d];
IF ~other.processed THEN MakeOneMat[d,otherI,otherJ];
bot←other.m[l][~side].downWidth +middle +1;
END ELSE bot←1;
new← MAX[cur,bot, m.m[l][side].downWidth + myMiddle+1];
notFirstUp[side][l]←TRUE;
END;
END;
ENDCASE;
END;

needToSetDown: ARRAY BOOLEAN OF ARRAY SegEnd OF BOOLEAN;
otherI,otherJ,currentR,currentB, oldR,oldB: INTEGER;
bot, middle, myMiddle: INTEGER;
sr,sb,start: SegPtr;
e, side: SegEnd;
angle: Angle;
l: BOOLEAN;

m← @mats[i][j][d];
IF m.processed THEN RETURN;
m.processed← TRUE;
start← IF d=h THEN @orientation[i][j].upSeg
ELSE @orientation[i][j].rightSeg;
currentR←currentB← oldR←oldB←0; -- measure thickness from the dummy
sb←start;
-- possibly change to assign equal coordinates for equal circuits.
FOR sr← start.next, sr.next UNTIL sr=NIL DO
FOR e IN SegEnd DO needToSetDown[FALSE][e]←FALSE; ENDLOOP;
IF ~sr.bc THEN currentR←oldR+1;
IF sr.first#NIL THEN BEGIN -- see if walls affect this seg.
currentR ← MAX[currentR, ProcessEnd[sr,sr.first,oldR]];
END;
IF sr.second#NIL THEN BEGIN -- see if walls affect this seg.
currentR ← MAX[currentR, ProcessEnd[sr,sr.second,oldR]];
END;
IF sr.across#NIL THEN BEGIN-- have the blue layer catch up.
FOR sb← IF sb.dummy THEN sb.across ELSE sb.next, sb.next DO
FOR e IN SegEnd DO needToSetDown[TRUE][e]←FALSE; ENDLOOP;
IF ~sb.bc THEN currentB←oldB+1;
IF sb.first#NIL THEN BEGIN -- see if walls affect this seg.
currentB ← ProcessEnd[sb,sb.first,oldB];
END;
IF sb.second#NIL THEN BEGIN -- see if walls affect this seg.
currentB ← MAX[currentB, ProcessEnd[sb,sb.second,oldB]];
END;
IF sr=sb.across OR sb=sr THEN EXIT;
sb.major← oldB ← currentB;
IF matsPass2 THEN FOR e IN SegEnd DO -- set the downwidths
IF needToSetDown[TRUE][e] THEN m.m[TRUE][e].downWidth←
MAX[m.m[TRUE][e].downWidth, currentB];
ENDLOOP;
ENDLOOP; -- end of the blueloop
sr.major←sb.major←oldR←oldB← MAX[currentR,currentB];
IF matsPass2 THEN FOR e IN SegEnd DO
IF needToSetDown[TRUE][e] THEN m.m[TRUE][e].downWidth←
MAX[m.m[TRUE][e].downWidth, oldB];
ENDLOOP;
END -- of the blue BEGIN block
ELSE sr.major← oldR ← currentR;
IF matsPass2 THEN FOR e IN SegEnd DO
IF needToSetDown[FALSE][e] THEN m.m[FALSE][e].downWidth←
MAX[m.m[FALSE][e].downWidth, oldR];
ENDLOOP;
ENDLOOP;
m.thickness← oldR;
END; -- of MakeOneMat

Turns:PROCEDURE[base,s:SegPtr] RETURNS[end: SegEnd, angle: Angle]=BEGIN
-- This returns the end on which s is connected to base as well as
-- which way the turn goes.
-- assumes that base and s are connected on at least one end.
IF base.xy.h THEN BEGIN
end← IF s.xy.x<base.xy.x THEN down ELSE up;
angle← IF s.xy.h THEN thruELSE IF s.xy.y=base.xy.y THEN down ELSE up;
END
ELSE BEGIN
end← IF s.xy.y<base.xy.y THEN down ELSE up;
angle← IF ~s.xy.h THEN thru ELSE IF s.xy.x=base.xy.x THEN down ELSE up;
END;
RETURN;
END;

tLines, chanWidths: ARRAY Direction OF ARRAY [0..maxSide] OF INTEGER;

SetMajors: PROCEDURE = BEGIN
ComputeChannelWidths[];
FixTransistors[];
EnumerateGridPlusOne[ReviseMajorsOnePair];
END;

ComputeChannelWidths: PROCEDURE=BEGIN
d: Direction;
i: INTEGER;
FOR d IN Direction DO
FOR i IN [0..side] DO chanWidths[d][i]←0 ENDLOOP;
ENDLOOP;
EnumerateGridPlusOne[UpdateWidthsOnePair];
END;

UpdateWidthsOnePair: PROCEDURE[i,j: INTEGER] = BEGIN
chanWidths[h][j] ← MAX[mats[i][j][h].thickness, chanWidths[h][j] ];
chanWidths[v][i] ← MAX[mats[i][j][v].thickness, chanWidths[v][i] ];
END;

FixTransistors: PROCEDURE = BEGIN
d: Direction;
i: INTEGER;
FOR d IN Direction DO
tLines[d][0]←tWidth;
FOR i IN [0..side] DO
tLines[d][i+1] ← tLines[d][i] + 2* tWidth + chanWidths[d][i];
ENDLOOP;
ENDLOOP;
END;

ReviseMajorsOnePair: PROCEDURE[i,j: INTEGER] = BEGIN
l: BOOLEAN;
d: Direction;
start,s: SegPtr;
origin,base: INTEGER;
FOR d IN Direction DO
IF d=h THEN BEGIN
origin← tLines[h][j];
start← @orientation[i][j].upSeg;
start.major ← origin + 1;
base← origin+tWidth;
orientation[i][j].downSeg.major ← origin - 1;
END ELSE BEGIN
origin← tLines[v][i];
start← @orientation[i][j].rightSeg;
start.major ←origin + 1;
base← origin + tWidth;
orientation[i][j].leftSeg.major ← origin - 1;
END;
FOR l IN BOOLEAN DO
FOR s ← IF l THEN start.across ELSE start.next, s.next UNTIL s.dummy DO
s.major← s.major + base;
ENDLOOP;
ENDLOOP;
ENDLOOP;
END;

SetMinors: PROCEDURE= BEGIN
EnumerateGridPlusOne[SetMinorsOnePair];
END;

SetMinorsOnePair: PROCEDURE[i,j: INTEGER] = BEGIN
-- I sure hope this works. It will if the majors guy worked correctly.
wall: ARRAY SegEnd OF INTEGER;
side: SegEnd;
angle: Angle;
origin: INTEGER;
d: Direction;
start,s: SegPtr;
l: BOOLEAN;
FOR d IN Direction DO
start← IF d=h THEN @orientation[i][j].upSeg
ELSE @orientation[i][j].rightSeg;
origin← tLines[IF d=h THEN v ELSE h][IF d=h THEN i ELSE j];
FOR l IN BOOLEAN DO
wall[down]← origin -tWidth;-- set the walls
wall[up] ← origin + tWidth;
FOR s ← IF l THEN start.across ELSE start.next, s.next UNTIL s.dummy DO
-- change Segs someday to allow us to collapse this code.
IF s.first#NIL THEN BEGIN
[side,angle]←Turns[s,s.first]; -- someday store this
SELECT angle FROM
down => BEGIN s.minorF← wall[side]← s.first.major;
s.first.minorS←s.major;
END;
thru => IF s.major >= s.first.major -- otherwise pick it up on
THEN BEGIN
s.minorF←s.first.minorS←wall[side]← --other side.
wall[side]+ (IF side THEN 1 ELSE -1);
s.dogF← TRUE;
END;
up => BEGIN s.minorF← s.first.major;
s.first.minorS←s.major;
END;
ENDCASE;
END ELSE s.minorF← origin; -- s.first=NIL! must end in middle.
IF s.second#NIL THEN BEGIN
[side,angle]←Turns[s,s.second]; -- someday store this
SELECT angle FROM
down => BEGIN s.minorS← wall[side]← s.second.major;
s.second.minorF←s.major;
END;
thru => IF s.major>=s.second.major -- else pick up on other side.
THEN BEGIN
s.minorS←s.second.minorF←wall[side]←
wall[side]+(IF side THEN 1 ELSE -1);
s.dogS←TRUE;
END;
up => BEGIN s.minorS← s.second.major;
s.second.minorF←s.major;
END;
ENDCASE;
END ELSE s.minorS← origin; -- s.first=NIL! must end in middle.
ENDLOOP; -- the s loop
ENDLOOP; -- the l loop
ENDLOOP; -- the d loop
END; -- of SetMinorsOnePair

AdjustMinors: PROCEDURE= BEGIN
s: SegPtr;
i,m1,m2: INTEGER;
FOR i IN [0..topSeg) DO
s← @segments[i];
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 LOOP; -- another circuit?
-- We have to adjust either minor1 or minor2
m1←s.minorF; m2←s.minorS;
IF s.first=NIL THEN -- shorten s, lengthen s.across
IF s.second#NIL THEN s.minorF←s.across.minorS←
m1 + (IF m1<m2 THEN 1 ELSE -1)
ELSE Error -- both are NIL!
ELSE IF s.second=NIL THEN s.minorS←s.across.minorF←
m2 + (IF m1>m2 THEN 1 ELSE -1)
ELSE Error; -- neither is NIL!
ENDLOOP;
END;

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

PlotSegs: PUBLIC PROCEDURE=BEGIN
a,b,c,i: INTEGER;
totLength: INTEGER←0;
s: SegPtr;
hue:Color;
FOR i IN [0..topSeg) DO
s ← @segments[i];
totLength ← totLength + ABS[s.minorF-s.minorS];
a←4*s.minorF;
b←4*s.minorS;
c←4*s.major;
hue← IF s.c=none THEN r ELSE s.c;
IF a>b THEN BEGIN t:INTEGER←a; a←b; b←t; END;
IF s.xy.h THEN PutBox[hue,a,c,b-a,1] ELSE PutBox[hue,c,a,1,b-a];
IF s.dogF THEN -- assert s.major> s.first.major !
IF s.xy.h THEN PutBox[hue, 4*s.minorF, 4*s.first.major, 1,
4*(s.major-s.first.major)]
ELSE PutBox[hue, 4*s.first.major, 4*s.minorF,
4*(s.major-s.first.major), 1];
IF s.dogS THEN
IF s.xy.h THEN PutBox[hue, 4*s.minorS, 4*s.second.major, 1,
4*(s.major-s.second.major)]
ELSE PutBox[hue, 4*s.second.major, 4*s.minorS,
4*(s.major-s.second.major), 1];
ENDLOOP;
IODefs.WriteLine[""];
IODefs.WriteString[" Total Length ="];
IODefs.WriteNumber[totLength,[10,FALSE,TRUE,5]];
IODefs.WriteString[" in "];
IODefs.WriteNumber[topSeg,[10,FALSE,TRUE,5]];
IODefs.WriteLine[" segments."];

IF debugPrint THEN BEGIN
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Orientations --"];
END;
EnumerateGridPlusOne[PrintOrientations];
IF debugPrint THEN BEGIN
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Horizontal Lines --"];
dd←h; EnumerateSidePlusTwo[PrintLines];
IODefs.WriteLine[""];
IODefs.WriteLine[" -- Vertical Lines --"];
dd←v; EnumerateSidePlusTwo[PrintLines];
IODefs.WriteLine[""];
END;
END;


PrintLines:OnI=BEGIN
IF i=0 THEN IODefs.WriteChar[CR];
IODefs.WriteNumber[tLines[dd][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*tLines[h][j];
col:INTEGER←4*tLines[v][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 Error; RETURN; END;
gHorr,aLeft,cLeft=> c←g;
gVert,aDown,cDown=> c←gateColor;
ENDCASE=>Error;
PutBox[c,xBot,row,xTop-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.major;
IF s.across#NIL AND (s.w#r OR s.ac) THEN
PutBox[b,4*MIN[major,s.across.major],row,
4*ABS[s.across.major-major],1];
IF s.nc AND 4*major>=xTop THEN BEGIN
xTop←4*FindStubEnd[s];
PutBox[s.c,4*major,row,(xTop-4*major),1];
END;
ENDLOOP;
FOR s←ss.across,s.next UNTIL s.w=l DO
major←s.major;
IF s.nc THEN -- no problem of getting the right color here
PutBox[s.c,4*major,row,4*(s.next.major-major),1];
ENDLOOP;
-- tie bundles upward
ss←@or.upSeg;
FOR s←ss,s.next UNTIL s.w=d DO
major←s.major;
IF s.across#NIL AND (s.w#u OR s.ac) THEN
PutBox[b,col,4*MIN[major,s.across.major],1,
4*ABS[s.across.major-major]];
IF s.nc AND 4*major>=yTop THEN BEGIN
yTop←4*FindStubEnd[s];
PutBox[s.c,col,4*major,1,(yTop-4*major)];
END;
ENDLOOP;
FOR s←ss.across,s.next UNTIL s.w=d DO
major←s.major;
IF s.nc THEN
PutBox[s.c,col,4*major,1,4*(s.next.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,4]; END;
cLeft,aDown=>
BEGIN PutBox[r,col-4,row+4,4,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,4,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,4]; END;
ENDCASE=>Error
END;

FindStubEnd:PROCEDURE[s:SegPtr] RETURNS[m:INTEGER]=BEGIN
ss:SegPtr;
IF s.w=d OR s.w=l THEN ss ← s -- don’t chase downward dummies
ELSE FOR ss←s,ss.next UNTIL ~ss.nc
DO IF ss=NIL THEN Error; ENDLOOP;
RETURN[ss.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]];
mats←AllocateSegment[SIZE[MatArray]];
END;

RecoverStuffInSeg: PUBLIC PROCEDURE= BEGIN
-- nothing can be recovered
END;

END..