-- 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..
(1792)\i3I9i98I