-- 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:LONG POINTER TO SegArray_LOOPHOLE[1000010B+SIZE[orientationArray]];
  topSeg:INTEGER;
  maxSeg:INTEGER=7*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=>1];
  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:LONG CARDINAL_LOOPHOLE[s];
  foo2:LONG CARDINAL_LOOPHOLE[@segments[0]];
  foo3:LONG CARDINAL_LOOPHOLE[@segments[maxSeg]];
  foo4:LONG CARDINAL_LOOPHOLE[@orientation[0][0]];
  foo5:LONG 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:LONG POINTER TO orientationArray_LOOPHOLE[1000000B];

-- 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 thru	ELSE 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..
e12(1792)\i3I9i98I22341i4I571i4I