--routeMakeBlue.mesa

--1> tidy up rectangle overlaps not visable to user
--     Remove complete overlaps by deleting something
--     Reduce or extend partial overlaps so all connecting things
--       overlap by the width of one wire (2 or 3 lambda)
--     Break long wires into segments ending at contacts or junctions
--2> turn as much as possible of the red wires to blue
--    only works when contacts extend up and right from junctions.

-- PROBLEM  current logic doesn't break red wires at junctions

DIRECTORY  RouteDefs;

RouteMakeBlue:PROGRAM IMPORTS RouteDefs EXPORTS RouteDefs =BEGIN
OPEN RouteDefs;

Error:SIGNAL=CODE;

--Silicon:TYPE=RECORD[pos,pos2:CoordL←[0,0],level:What←both,
--  solid:BOOLEAN←FALSE, circuit:Circuit←0];

list:SiliconListPtr←NIL;
big:Lambda;

MakeBlue:PUBLIC PROCEDURE=BEGIN
--IF TRUE THEN RETURN;
big←problem.chipSize.x;
MakeBlueX[];
--EnumerateSilicon[Rotate];
--MakeBlueX[];
--EnumerateSilicon[RotateBack];
END;

Rotate:PROCEDURE[s:SiliconPtr]=BEGIN
t:Lambda←s.pos.y;
s.pos.y←big-s.pos2.x;
s.pos2.x←s.pos2.y;
s.pos2.y←big-s.pos.x;
s.pos.x←t;
END;

RotateBack:PROCEDURE[s:SiliconPtr]=BEGIN
t:Lambda←s.pos.x;
s.pos.x←big-s.pos2.y;
s.pos2.y←s.pos2.x;
s.pos2.x←big-s.pos.y;
s.pos.y←t;
END;

MakeBlueX:PROCEDURE=BEGIN
EnumerateSilicon[TidyDoubleContacts];
EnumerateSilicon[TidyWireToContacts];
EnumerateSilicon[TidyWireToWire];
EnumerateSilicon[TidyButtingEnds];
EnumerateSilicon[SplitWiresAtContacts];
ScavengeSilicon[];
EnumerateSilicon[MakeRedBlue];
EnumerateSilicon[TidyWireToContacts];
ScavengeSilicon[];
END;

TidyDoubleContacts:PROCEDURE[s:SiliconPtr]=BEGIN
IF s.level#both THEN RETURN;
FOR sl:SiliconListPtr←layout,sl.t UNTIL sl=NIL DO
  s2:SiliconPtr=sl.h;
  IF s2.level=both AND s2.pos=s.pos AND s2#s THEN Destroy[s2];
  ENDLOOP;
END;

TidyWireToContacts:PROCEDURE[s:SiliconPtr]=BEGIN
seenRed,seenBlue:BOOLEAN←FALSE;
IF s.level#both THEN RETURN;
FOR sl:SiliconListPtr←layout,sl.t UNTIL sl=NIL DO
  s2:SiliconPtr=sl.h;
  w:INTEGER=IF s2.level=red THEN 2 ELSE 3;
  IF s2.level=both THEN LOOP;
  IF s2.pos2.y-s2.pos.y=w AND s2.pos.y-s.pos.y IN [0..4-w] THEN BEGIN
    IF s2.pos.x-s.pos.x  IN [0..4] THEN s2.pos.x←s.pos.x;
    IF s2.pos2.x-s.pos.x IN [0..4] THEN s2.pos2.x←s.pos.x+w;
    IF s2.level=red THEN seenRed←TRUE ELSE seenBlue←TRUE;
    END;
  IF s2.pos2.x-s2.pos.x=w AND s2.pos.x-s.pos.x IN [0..4-w] THEN BEGIN
    IF s2.pos.y  IN [s.pos.y..s.pos.y+4] THEN s2.pos.y←s.pos.y;
    IF s2.pos2.y IN [s.pos.y..s.pos.y+4] THEN s2.pos2.y←s.pos.y+w;
    IF s2.level=red THEN seenRed←TRUE ELSE seenBlue←TRUE;
    END;
  ENDLOOP;
IF ~seenRed OR ~seenBlue THEN Destroy[s];
END;

TidyWireToWire:PROCEDURE[s:SiliconPtr]=BEGIN
w:INTEGER=IF s.level=red THEN 2 ELSE 3;
IF s.level=both THEN RETURN;
IF ~(s.pos2.y-s.pos.y=w) THEN RETURN;
FOR sl:SiliconListPtr←layout,sl.t UNTIL sl=NIL DO
  s2:SiliconPtr=sl.h;
  IF s2.level#s.level THEN LOOP;
  IF ~(s2.pos2.x-s2.pos.x=w) THEN LOOP;
  IF s=s2 THEN LOOP;
  IF s.pos.y IN [s2.pos.y-w..s2.pos2.y+w) THEN BEGIN
    IF s.pos.x  IN [s2.pos.x..s2.pos2.x] THEN s.pos.x←s2.pos.x;
    IF s.pos2.x IN [s2.pos.x..s2.pos2.x] THEN s.pos2.x←s2.pos2.x;
    END;
  IF s2.pos.x IN [s.pos.x-w..s.pos2.x+w) THEN BEGIN
    IF s2.pos.y  IN [s.pos.y..s.pos2.y] THEN s2.pos.y←s.pos.y;
    IF s2.pos2.y IN [s.pos.y..s.pos2.y] THEN s2.pos2.y←s.pos2.y;
    END;
  ENDLOOP;
END;

SplitWiresAtContacts:PROCEDURE[s:SiliconPtr]=BEGIN
w:INTEGER=IF s.level=red THEN 2 ELSE 3;
IF s.level=both THEN RETURN;
IF s.pos2.y-s.pos.y=w
THEN FOR sl:SiliconListPtr←layout,sl.t UNTIL sl=NIL DO
  s2:SiliconPtr=sl.h;
  IF  s2.pos.x IN (s.pos.x..s.pos2.x-w)
     AND s.pos.y IN (s2.pos.y-w-w..s2.pos2.y+w)
     AND (s2.level=both OR s2.level=s.level AND s.pos2.y#s.pos.y+w)
   THEN SplitWiresAtContacts[SplitWire[s,s2.pos.x,TRUE]];
  ENDLOOP
ELSE FOR sl:SiliconListPtr←layout,sl.t UNTIL sl=NIL DO
  s2:SiliconPtr=sl.h;
  IF  s2.pos.y IN (s.pos.y..s.pos2.y-w)
     AND s.pos.x IN (s2.pos.x-w-w..s2.pos2.x+w)
     AND (s2.level=both OR s2.level=s.level AND s.pos2.x#s.pos.x+w)
   THEN SplitWiresAtContacts[SplitWire[s,s2.pos.y,FALSE]];
  ENDLOOP;
END;

SplitWire:PROCEDURE[s:SiliconPtr,where:Lambda,hor:BOOLEAN]
   RETURNS[s2:SiliconPtr]=BEGIN
w:INTEGER=IF s.level=red THEN 2 ELSE 3;
listS:SiliconListPtr←AllocateList[];
s2←AllocateSilicon[];
s2↑←s↑;
listS↑←[s2,layout];
layout←listS;
IF hor THEN {s.pos2.x←where+w; s2.pos.x←where}
       ELSE {s.pos2.y←where+w; s2.pos.y←where}
END;

TidyButtingEnds:PROCEDURE[s:SiliconPtr]=BEGIN
w:INTEGER=IF s.level=red THEN 2 ELSE 3;
IF s.level=both THEN RETURN;
FOR sl:SiliconListPtr←layout,sl.t UNTIL sl=NIL DO
  s2:SiliconPtr=sl.h;
  SELECT TRUE FROM
    s2.level#s.level OR s2=s => LOOP;
    s2.pos.y=s.pos.y AND s2.pos2.y=s.pos2.y => SELECT TRUE FROM
      s2.pos.x<=s.pos.x AND s2.pos2.x>=s.pos2.x => {Destroy[s]; RETURN};
      s2.pos.x>=s.pos.x AND s2.pos2.x<=s.pos2.x => {Destroy[s2]; LOOP};
      s2.pos.x<s.pos.x=>IF s2.pos2.x>=s.pos.x THEN s.pos←s2.pos ELSE LOOP;
      ENDCASE=>IF s.pos2.x >=s2.pos.x THEN s.pos2←s2.pos2 ELSE LOOP; 
    s2.pos.x=s.pos.x AND s2.pos2.x=s.pos2.x => SELECT TRUE FROM
      s2.pos.y<=s.pos.y AND s2.pos2.y>=s.pos2.y => {Destroy[s]; RETURN};
      s2.pos.y>=s.pos.y AND s2.pos2.y<=s.pos2.y => {Destroy[s2]; LOOP};
      s2.pos.y<s.pos.y=>IF s2.pos2.y>=s.pos.y THEN s.pos←s2.pos ELSE LOOP;
      ENDCASE=>IF s.pos2.y >=s2.pos.y THEN s.pos2←s2.pos2 ELSE LOOP;
    ENDCASE=>LOOP;
  Destroy[s2];
  TidyButtingEnds[s];
  RETURN;
  ENDLOOP;
END;

Stuff:TYPE=RECORD[where:CoordL,red,blue:Four,con,passing:SiliconPtr←NIL, cellNearby,onCell:BOOLEAN←FALSE];
Four:TYPE=RECORD[n,s,e,w:SiliconPtr←NIL];

l,r:Stuff←[];
progress:BOOLEAN;
thisWire:SiliconPtr←NIL;--to save passing it

MakeRedBlue:PROCEDURE[s:SiliconPtr]=BEGIN
LastStuff:PROCEDURE[p:POINTER TO Stuff] RETURNS[b:BOOLEAN]=
  {b←IF hor THEN p.where.x>=s.pos2.x-2 ELSE p.where.y>=s.pos2.y-2};
hor:BOOLEAN=s.pos2.y-s.pos.y=2;
IF s.level#red THEN RETURN;
thisWire←s;
MakeList[s];
progress←FALSE;
WhatsAtL[hor,s.pos];
UNTIL LastStuff[@l] DO
  WhatsAtR[hor,s];
  IF  hor AND r.where.x>s.pos2.x-2 THEN Error;
  IF ~hor AND r.where.y>s.pos2.y-2 THEN Error;
  IF hor THEN ProcessH[s] ELSE ProcessV[s];
  IF s.level#red OR s.pos=outOfSight OR LastStuff[@r] THEN EXIT;
  IF ~progress OR r.where=[s.pos2.x-2,s.pos2.y-2]
     THEN l←r ELSE WhatsAtL[hor,r.where];
  ENDLOOP;
ScavengeList[];
END;

WhatsAtL:PROCEDURE[hor:BOOLEAN,pos:CoordL]=BEGIN
l←[];
l.where←pos;
FOR sl:SiliconListPtr←list,sl.t UNTIL sl=NIL DO
  s:SiliconPtr=sl.h;
  parallel:BOOLEAN=IF hor THEN s.pos2.y-s.pos.y<4 ELSE s.pos2.x-s.pos.x<4;
  IF s.pos.y=pos.y AND s.pos.x IN [pos.x-2..pos.x+2]
  THEN SELECT s.level FROM
    both=>l.con←s;
    red =>{IF parallel THEN l.red.e←s ELSE l.red.n←s};
    blue=>{IF parallel THEN l.blue.e←s ELSE l.blue.n←s};
    ENDCASE=>Error
  ELSE SELECT s.level FROM
    red=>IF s.pos2.y=pos.y+2 AND s.pos2.x IN [pos.x-2..pos.x+4] THEN
        {IF parallel THEN l.red.w←s ELSE l.red.s←s};
    blue=>BEGIN
      IF s.pos2.y=pos.y+3 AND s.pos2.x IN [pos.x-2..pos.x+4] THEN
        {IF parallel THEN l.blue.w←s ELSE l.blue.s←s}
      ELSE IF pos.x IN (s.pos.x-7..s.pos2.x+3)
          AND pos.y IN (s.pos.y-7..s.pos2.y+3)
        AND (l.passing=NIL OR parallel) THEN l.passing←s;
      END;
    ENDCASE;
  ENDLOOP;
CellNearby[@l];
END;

WhatsAtR:PROCEDURE[hor:BOOLEAN,ss:SiliconPtr]=BEGIN
end:CoordL=[ss.pos2.x-2,ss.pos2.y-2];
pos:CoordL=[l.where.x+(IF hor THEN 3 ELSE 0),l.where.y];
w:CoordL←end;
FOR dummy:INTEGER IN [0..2) DO
r←[];
FOR sl:SiliconListPtr←list,sl.t UNTIL sl=NIL DO
  s:SiliconPtr=sl.h;
  h:INTEGER=SELECT s.level FROM blue=>3,red=>2,ENDCASE=>4;
  sEnd:CoordL=[s.pos2.x-h,s.pos2.y-h];
  color:POINTER TO Four=IF s.level=blue THEN @r.blue ELSE @r.red;
  parallel:BOOLEAN = hor=(s.pos2.y-s.pos.y<4);
  IF s=ss THEN LOOP;
  IF s.level=both THEN BEGIN
    IF hor THEN BEGIN
      IF s.pos.y#pos.y THEN LOOP;
      IF s.pos.x IN (pos.x..w.x) THEN {r←[]; w.x←s.pos.x; Error};
      END
    ELSE BEGIN
      IF s.pos.x#pos.x THEN LOOP;
      IF s.pos.y IN (pos.y..w.y) THEN {r←[]; w.y←s.pos.y; Error};
      END;
    IF s.pos.y=w.y AND s.pos.x-w.x IN [-2..2] THEN r.con←s;
    LOOP;
    END;
  IF hor THEN BEGIN
    IF s.level=blue AND pos.y IN (s.pos.y-7..s.pos2.y+3)
      AND pos.y#s.pos.y AND pos.y#s.pos2.y-3 THEN BEGIN
        IF s.pos.x IN (pos.x..w.x) THEN {r←[]; w.x←s.pos.x};
        IF s.pos.x =w.x THEN r.passing←s;
        END;
    IF pos.y NOT IN [s.pos.y..s.pos2.y-h] THEN LOOP;
    IF ~parallel THEN BEGIN
      IF s.pos.x IN (pos.x..w.x) THEN {r←[]; w.x←s.pos.x};
      IF s.pos.x-w.x IN [0..2] AND s.pos.y=w.y THEN color.n←s;
      IF s.pos.x-w.x IN [0..2] AND s.pos2.y=w.y+h THEN color.s←s;
      END;
    END
  ELSE BEGIN
    IF s.level=blue AND pos.x IN (s.pos.x-7..s.pos2.x+3)
      AND pos.x#s.pos.x AND pos.x#s.pos2.x-3 THEN BEGIN
        IF s.pos.y IN (pos.y..w.y) THEN {r←[]; w.y←s.pos.y};
        IF s.pos.y=w.y THEN r.passing←s;
        END;
    IF pos.x NOT IN [s.pos.x..s.pos2.x-h] THEN LOOP;
    IF ~parallel THEN BEGIN
      IF s.pos.y IN (pos.y..w.y) THEN {r←[]; w.y←s.pos.y};
      IF s.pos.y=w.x AND s.pos.x=w.x THEN color.e←s;
      IF s.pos.x=w.x AND s.pos2.x=w.x+h THEN color.w←s;
      END;
    END;
  IF parallel
    THEN {IF s.pos=w THEN color.e←s; IF sEnd=w THEN color.w←s}
    ELSE {IF s.pos=w THEN color.n←s; IF sEnd=w THEN color.s←s};
  ENDLOOP;
ENDLOOP;
IF w=end THEN r.red.w←ss;
r.where←w;
CellNearby[@r];
END;

CellNearby:PROCEDURE[stuff:POINTER TO Stuff]=BEGIN
pos:CoordL=stuff.where;
stuff.cellNearby←FALSE;
stuff.onCell←FALSE;
FOR cl:CellListPtr←problem.cells,cl.t UNTIL cl=NIL DO
  cell:CellPtr=cl.h;
  IF  ~ ( pos.x-cell.pos.x IN [-6..cell.sizeL.x+2]
      AND pos.y-cell.pos.y IN [-6..cell.sizeL.y+2])
    THEN LOOP;
  IF (thisWire.pos.y>cell.pos.y+cell.sizeL.y
       OR thisWire.pos2.y<cell.pos.y
       OR thisWire.pos.x>cell.pos.x+cell.sizeL.x
       OR thisWire.pos2.x<cell.pos.x)
    THEN {stuff.cellNearby←TRUE; RETURN};
  IF thisWire.pos.y=cell.pos.y+cell.sizeL.y AND pos.y=thisWire.pos.y
    THEN FOR el:SignalListPtr←cell.signals,el.t UNTIL el=NIL DO
        e:SignalPtr=el.h;
        IF e.side=n AND cell.pos.x+e.offset=pos.x AND e.level=both
        THEN stuff.onCell←TRUE;
        ENDLOOP;
  IF thisWire.pos.x=cell.pos.x+cell.sizeL.x AND pos.x=thisWire.pos.x
    THEN FOR el:SignalListPtr←cell.signals,el.t UNTIL el=NIL DO
        e:SignalPtr=el.h;
        IF e.side=e AND cell.pos.y+e.offset=pos.y AND e.level=both
        THEN stuff.onCell←TRUE;
        ENDLOOP;
  IF thisWire.pos2.y=cell.pos.y AND pos.y+2=thisWire.pos2.y
    THEN FOR el:SignalListPtr←cell.signals,el.t UNTIL el=NIL DO
        e:SignalPtr=el.h;
        IF e.side=s AND cell.pos.x+e.offset=pos.x AND e.level=both
        THEN stuff.onCell←TRUE;
        ENDLOOP;
  IF thisWire.pos2.x=cell.pos.x AND pos.x+2=thisWire.pos2.x
    THEN FOR el:SignalListPtr←cell.signals,el.t UNTIL el=NIL DO
        e:SignalPtr=el.h;
        IF e.side=w AND cell.pos.y+e.offset=pos.y AND e.level=both
        THEN stuff.onCell←TRUE;
        ENDLOOP;
  ENDLOOP;
END;

ProcessH:PROCEDURE[s:SiliconPtr]=BEGIN
hor:BOOLEAN=TRUE;
y:Lambda=s.pos.y;
noBlueRight:BOOLEAN=r.blue=[] AND r.passing=NIL AND ~r.cellNearby;
noBlueLeft: BOOLEAN=l.blue=[] AND l.passing=NIL AND ~l.cellNearby;
noRedLeft:  BOOLEAN=l.red.n=NIL AND l.red.s=NIL AND l.red.w=NIL;
noRedRight: BOOLEAN=r.red.n=NIL AND r.red.s=NIL AND r.red.e=NIL;
buttL:BOOLEAN=noBlueLeft  AND ~noRedLeft;
buttR:BOOLEAN=noBlueRight AND ~noRedRight;
newx:Lambda= l.where.x+(IF buttL THEN 0 ELSE 7);
newx2:Lambda=r.where.x-(IF buttR THEN 0 ELSE 7);
PassingParallel:PROCEDURE[p:SiliconPtr] RETURNS[BOOLEAN]=BEGIN
  RETURN[p#NIL AND p.pos2.y=p.pos.y+3 AND p.pos.y IN [s.pos.y-2..s.pos2.y+2]];
  END;
AdjustRight:PROCEDURE=BEGIN
  IF r.blue.n=NIL AND r.blue.s=NIL AND l.blue.e#NIL THEN
    {s.pos2.x←r.blue.e.pos2.x; Destroy[r.blue.e]};
  END;
AdjustLeft:PROCEDURE=BEGIN
  IF l.blue.n=NIL AND l.blue.s=NIL AND l.blue.w#NIL THEN
    {s.pos.x←l.blue.w.pos.x; Destroy[l.blue.w]};
  END;
ExtendRight:PROCEDURE={NewBlueWireH[l.where.x,s.pos.x←newx2]};
ExtendLeft:PROCEDURE={s.pos2.x←newx+2; NewBlueWireH[newx,r.where.x]};
NewBlueWireH:PROCEDURE[p,q:Lambda]={MakeBlueWire[hor,p,y,q-p+3]; Copy[]};
NewRedWireH:PROCEDURE[p,q:Lambda]={MakeRedWire[hor,p,y,q-p+2]; Copy[]};
NewContact:PROCEDURE[x:Lambda]={MakeContact[x,y]; Copy[]};
progress←FALSE;
IF PassingParallel[l.passing] OR PassingParallel[r.passing] OR r.cellNearby OR l.cellNearby THEN RETURN;
IF (l.con#NIL OR buttL) AND (r.con#NIL OR buttR) THEN Bluify[s];
IF l.con#NIL AND r.onCell THEN {Bluify[s]; Destroy[l.con]};
IF r.con#NIL AND l.onCell THEN {Bluify[s]; Destroy[r.con]};
IF l.con#NIL AND r.con#NIL THEN BEGIN --1 case
  IF noRedLeft  THEN {Destroy[l.con]; AdjustLeft[]};
  IF noRedRight THEN {Destroy[r.con]; AdjustRight[]};
  END;
IF l.con#NIL AND r.con=NIL THEN BEGIN --9 cases here
  k:INTEGER=IF noRedLeft THEN 0 ELSE 14;
  IF ~noBlueRight AND l.where.x>=newx2-k THEN RETURN;
  IF noRedLeft THEN l.con.pos.x←newx2 ELSE NewContact[newx2];
  IF noRedLeft AND (l.blue.n=NIL AND l.blue.s=NIL AND l.blue.w#NIL)
    THEN BEGIN l.blue.w.pos2.x←newx2+3;
      IF buttR THEN Destroy[s] ELSE s.pos.x←newx2; END
    ELSE {IF ~noBlueRight THEN ExtendRight[]};
  END;
IF l.con=NIL AND r.con#NIL THEN BEGIN --9 cases here
  k:INTEGER=IF noRedRight THEN 0 ELSE 14;
  IF ~noBlueLeft AND r.where.x<=newx+k THEN RETURN;
  IF noRedRight THEN r.con.pos.x←newx ELSE NewContact[newx];
  IF noRedRight AND (r.blue.n=NIL AND r.blue.s=NIL AND r.blue.w#NIL)
    THEN BEGIN r.blue.w.pos.x←newx;
      IF buttL THEN Destroy[s] ELSE s.pos2.x←newx+2; END
    ELSE {IF ~noBlueLeft THEN ExtendLeft[]};
  END;
IF l.con=NIL AND r.con=NIL THEN BEGIN
  IF newx2<newx THEN RETURN;
  IF noBlueLeft AND noBlueRight THEN {NewContact[newx]; NewContact[newx2]};
  IF noBlueLeft AND ~noBlueRight THEN {ExtendRight[]; NewContact[newx2];
     IF ~noRedLeft THEN NewContact[l.where.x]};
  IF ~noBlueLeft AND noBlueRight THEN {ExtendLeft[]; NewContact[newx];
     IF ~noRedRight THEN NewContact[l.where.y]};
  IF ~noBlueLeft AND ~noBlueRight THEN BEGIN
    IF newx2<newx+14 THEN RETURN;
    NewContact[newx2];
    NewRedWireH[s.pos.x,newx];
    NewBlueWireH[newx,newx2];
    NewContact[newx];
    s.pos.x←newx2;
    END;
  END;
progress←TRUE;
END;

ProcessV:PROCEDURE[s:SiliconPtr]=BEGIN
hor:BOOLEAN=FALSE;
x:Lambda=s.pos.x;
noBlueRight:BOOLEAN=r.blue=[] AND r.passing=NIL AND ~r.cellNearby;
noBlueLeft: BOOLEAN=l.blue=[] AND l.passing=NIL AND ~l.cellNearby;
noRedLeft:  BOOLEAN=l.red.n=NIL AND l.red.s=NIL AND l.red.w=NIL;
noRedRight: BOOLEAN=r.red.n=NIL AND r.red.s=NIL AND r.red.e=NIL;
buttL:BOOLEAN=noBlueLeft  AND ~noRedLeft;
buttR:BOOLEAN=noBlueRight AND ~noRedRight;
newy:Lambda= l.where.y+(IF buttL THEN 0 ELSE 7);
newy2:Lambda=r.where.y-(IF buttR THEN 0 ELSE 7);
PassingParallel:PROCEDURE[p:SiliconPtr] RETURNS[BOOLEAN]=BEGIN
  RETURN[p#NIL AND p.pos2.x=p.pos.x+3 AND p.pos.x IN [s.pos.x-2..s.pos2.x+2]];
  END;
AdjustRight:PROCEDURE=BEGIN
  IF r.blue.n=NIL AND r.blue.s=NIL AND l.blue.e#NIL THEN
    {s.pos2.y←r.blue.e.pos2.y; Destroy[r.blue.e]};
  END;
AdjustLeft:PROCEDURE=BEGIN
  IF l.blue.n=NIL AND l.blue.s=NIL AND l.blue.w#NIL THEN
    {s.pos.y←l.blue.w.pos.y; Destroy[l.blue.w]};
  END;
ExtendRight:PROCEDURE={NewBlueWireH[l.where.y,s.pos.y←newy2]};
ExtendLeft:PROCEDURE={s.pos2.y←newy+2; NewBlueWireH[newy,r.where.y]};
NewBlueWireH:PROCEDURE[p,q:Lambda]={MakeBlueWire[hor,x,p,q-p+3]; Copy[]};
NewRedWireH:PROCEDURE[p,q:Lambda]={MakeRedWire[hor,x,p,q-p+2]; Copy[]};
NewContact:PROCEDURE[y:Lambda]={MakeContact[x,y]; Copy[]};
progress←FALSE;
IF PassingParallel[l.passing] OR PassingParallel[r.passing] OR r.cellNearby OR l.cellNearby THEN RETURN;
IF (l.con#NIL OR buttL) AND (r.con#NIL OR buttR) THEN Bluify[s];
IF l.con#NIL AND r.onCell THEN {Bluify[s]; Destroy[l.con]};
IF r.con#NIL AND l.onCell THEN {Bluify[s]; Destroy[r.con]};
IF l.con#NIL AND r.con#NIL THEN BEGIN
  IF noRedLeft  THEN {Destroy[l.con]; AdjustLeft[]};
  IF noRedRight THEN {Destroy[r.con]; AdjustRight[]};
  END;
IF l.con#NIL AND r.con=NIL THEN BEGIN --9 cases here
  k:INTEGER=IF noRedLeft THEN 0 ELSE 14;
  IF ~noBlueRight AND l.where.y>=newy2-k THEN RETURN;
  IF noRedLeft THEN l.con.pos.y←newy2 ELSE NewContact[newy2];
  IF noRedLeft AND (l.blue.n=NIL AND l.blue.s=NIL AND l.blue.w#NIL)
    THEN BEGIN l.blue.w.pos2.y←newy2+3;
      IF buttR THEN Destroy[s] ELSE s.pos.y←newy2; END
    ELSE {IF ~noBlueRight THEN ExtendRight[]};
  END;
IF l.con=NIL AND r.con#NIL THEN BEGIN --9 cases here
  k:INTEGER=IF noRedRight THEN 0 ELSE 14;
  IF ~noBlueLeft AND r.where.y<=newy+k THEN RETURN;
  IF noRedRight THEN r.con.pos.y←newy ELSE NewContact[newy];
  IF noRedRight AND (r.blue.n=NIL AND r.blue.s=NIL AND r.blue.w#NIL)
    THEN BEGIN r.blue.w.pos.y←newy;
      IF buttL THEN Destroy[s] ELSE s.pos2.y←newy+2; END
    ELSE {IF ~noBlueLeft THEN ExtendLeft[]};
  END;
IF l.con=NIL AND r.con=NIL THEN BEGIN
  IF newy2<newy THEN RETURN;
  IF noBlueLeft AND noBlueRight THEN {NewContact[newy]; NewContact[newy2]};
  IF noBlueLeft AND ~noBlueRight THEN {ExtendRight[]; NewContact[newy2];
     IF ~noRedLeft THEN NewContact[l.where.y]};
  IF ~noBlueLeft AND noBlueRight THEN {ExtendLeft[]; NewContact[newy];
     IF ~noRedRight THEN NewContact[l.where.y]};
  IF ~noBlueLeft AND ~noBlueRight THEN BEGIN
    IF newy2<newy+14 THEN RETURN;
    NewContact[newy2];
    NewRedWireH[s.pos.y,newy];
    NewBlueWireH[newy,newy2];
    NewContact[newy];
    s.pos.y←newy2;
    END;
  END;
progress←TRUE;
END;


ScavengeList:PROCEDURE=BEGIN
UNTIL list=NIL DO t:SiliconListPtr=list; list←t.t; FreeList[t]; ENDLOOP;
END;

MakeList:PROCEDURE[ss:SiliconPtr]=BEGIN
IF list#NIL THEN {Error; ScavengeList[]};
FOR sl:SiliconListPtr←layout,sl.t UNTIL sl=NIL DO
  s:SiliconPtr=sl.h;
  IF  s.pos2.x+3<ss.pos.x THEN LOOP;
  IF  s.pos2.y+3<ss.pos.y THEN LOOP;
  IF ss.pos2.x+3< s.pos.x THEN LOOP;
  IF ss.pos2.y+3< s.pos.y THEN LOOP;
  OnList[s];
  ENDLOOP;
END;

OnList:PROCEDURE[s:SiliconPtr]=BEGIN
t:SiliconListPtr=AllocateList[];
t↑←[s,list];
list←t;
END;

Copy:PROCEDURE=BEGIN OnList[layout.h]; END;

Bluify:PROCEDURE[s:SiliconPtr]=BEGIN
s.level←blue;
s.pos2.x←s.pos2.x+1;
s.pos2.y←s.pos2.y+1;
END;

Destroy:PROCEDURE[s:SiliconPtr]=BEGIN
s↑←[outOfSight,outOfSight,both];
END;

ScavengeSilicon:PROCEDURE=BEGIN
back,next:SiliconListPtr←NIL;
FOR sl:SiliconListPtr←layout,next UNTIL sl=NIL DO
  s:SiliconPtr=sl.h;
  next←sl.t;
  IF s.pos#outOfSight THEN {back←sl; LOOP};
  FreeSilicon[s];
  IF back=NIL THEN layout←next ELSE back.t←next;
  FreeList[sl];
  ENDLOOP;
END;

END.