--routeRectLess.mesa

--tries to improve a valid set of rectangles
--by combining adjacent rectangles where possible
--by making separate lists for channel and inter types
--by determining the "event" coordinate system
--by computing "levelers", "nature", "orient", and "where"

DIRECTORY  RouteDefs;

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

Error:SIGNAL=CODE;

RectLess:PUBLIC CtlProc=BEGIN
inters←NIL;
channels←NIL;
EnumerateOrderedRectanglePairs[MarkNeighbors];
EnumerateRectangles[CompressUD];
EnumerateRectangles[CompressLR];
EnumerateRectangles[MarkNatureAndOrientAndWhere];
EnumerateRectangles[MakeSecondaryLists];
EnumerateChannels[SetEventNumbers];
EnumerateChannels[SetNextAndPrevEvents];
EnumerateRectangles[ComputeSizeC];
ShowLabel["RECTLESS"];
EnumerateRectangles[ShowRectangles];
ShowLabel["CHANNELS"];
IF ~chipmonk THEN EnumerateRectangles[ShowChannels];
RETURN[-1];
END;

EnumerateOrderedRectanglePairs:PROCEDURE
  [c:PROCEDURE[RectanglePtr,RectanglePtr]]=BEGIN
FOR l:RectangleListPtr←rectangles,l.t UNTIL l=NIL DO
  FOR r:RectangleListPtr←rectangles,r.t UNTIL r=NIL DO
    c[l.h,r.h]; ENDLOOP; ENDLOOP;
END;

MarkNeighbors:PROCEDURE[rect,rect2:RectanglePtr]=BEGIN
IF rect2.pos.y=rect.pos.y+rect.sizeL.y
    AND rect2.pos.x<rect.pos.x+rect.sizeL.x
    AND rect.pos.x<rect2.pos.x+rect2.sizeL.x
    AND rect.sizeL.x>9 AND rect2.sizeL.x>9
    THEN {rect.n←rect2; rect2.s←rect};
IF rect2.pos.x=rect.pos.x+rect.sizeL.x
    AND rect2.pos.y<rect.pos.y+rect.sizeL.y
    AND rect.pos.y<rect2.pos.y+rect2.sizeL.y
    AND rect.sizeL.y>9 AND rect2.sizeL.y>9
    THEN {rect.e←rect2; rect2.w←rect};
END;

CompressUD:PROCEDURE[d:RectanglePtr]=
  {IF d.n#NIL AND (d.w=NIL OR d.n.w=NIL) THEN []←TryUD[d.n,d]};
CompressLR:PROCEDURE[d:RectanglePtr]=
  {IF d.w#NIL AND (d.s=NIL OR d.w.s=NIL) THEN []←TryLR[d.w,d]};

TryUD:PROCEDURE[u,d:RectanglePtr] RETURNS[BOOLEAN]=BEGIN
IF u=NIL OR u.s#d OR d.n#u OR u.wSource OR d.wSource OR u.eSource OR d.eSource
 OR u.sizeL.x#d.sizeL.x OR u.pos.x#d.pos.x
 OR u.e#NIL AND d.e#NIL AND ~TryUD[u.e,d.e]
 THEN RETURN[FALSE];
IF d.e=NIL THEN d.se←d.sizeL.y+u.se;
IF d.w=NIL THEN d.sw←d.sizeL.y+u.sw;
IF u.e=NIL THEN d.ne←u.sizeL.y+u.ne;
IF u.w=NIL THEN d.nw←u.sizeL.y+u.nw;
IF d.e=NIL THEN {d.e←u.e; IF d.e#NIL THEN d.e.w←d};
IF d.w=NIL THEN {d.w←u.w; IF d.w#NIL THEN d.w.e←d};
AdjustEventOffsets[u,d.sizeL.y,TRUE];
Merge[u,d];
d.sizeL.y←d.sizeL.y+u.sizeL.y;
d.n←u.n; IF d.n#NIL THEN d.n.s←d;
RemoveRectangle[u];
RETURN[TRUE];
END;

TryLR:PROCEDURE[l,r:RectanglePtr] RETURNS[BOOLEAN]=BEGIN
IF l=NIL OR l.e#r OR r.w#l OR l.sSource OR r.sSource OR l.nSource OR r.nSource
 OR l.sizeL.y#r.sizeL.y OR l.pos.y#r.pos.y
 OR l.n#NIL AND r.n#NIL AND ~TryLR[l.n,r.n]
 THEN RETURN[FALSE];
IF r.s=NIL THEN r.ws←r.sizeL.x+l.ws;
IF r.n=NIL THEN r.wn←r.sizeL.x+l.wn;
IF l.s=NIL THEN r.es←l.sizeL.x+l.es;
IF l.n=NIL THEN r.en←l.sizeL.x+l.en;
IF r.n=NIL THEN {r.n←l.n; IF r.n#NIL THEN r.n.s←r};
IF r.s=NIL THEN {r.s←l.s; IF r.s#NIL THEN r.s.n←r};
AdjustEventOffsets[r,l.sizeL.x,FALSE];
Merge[l,r];
r.sizeL.x←r.sizeL.x+l.sizeL.x;
r.pos.x←l.pos.x;
r.w←l.w; IF r.w#NIL THEN r.w.e←r;
RemoveRectangle[l];
RETURN[TRUE];
END;

Merge:PROCEDURE[u,d:RectanglePtr]=BEGIN
d.events←AppendLists[d.events,u.events];
d.eSource←d.eSource OR u.eSource;
d.wSource←d.wSource OR u.wSource;
d.nSource←d.nSource OR u.nSource;
d.sSource←d.sSource OR u.sSource;
END;

AppendLists:PROCEDURE[a,b:EventListPtr] RETURNS[EventListPtr]=BEGIN
IF a=NIL THEN RETURN[b];
FOR l:EventListPtr←a,l.t DO IF l.t=NIL THEN {l.t←b; RETURN[a]}; ENDLOOP;
END;

AdjustEventOffsets:PROCEDURE[r:RectanglePtr,d:Lambda,ud:BOOLEAN]=
BEGIN
FOR l:EventListPtr←r.events,l.t UNTIL l=NIL DO
  e:EventPtr=l.h;
  IF (SELECT e.side FROM n,s=>~ud, ENDCASE=>ud)
   THEN l.h.offset←l.h.offset+d;
  ENDLOOP;
END;

RemoveRectangle:PROCEDURE[rect:RectanglePtr]=BEGIN
back:RectangleListPtr←NIL;
IF rect=NIL THEN RETURN;
FOR rl:RectangleListPtr←rectangles,rl.t UNTIL rl=NIL DO
  IF rl.h=rect THEN BEGIN
    IF back=NIL THEN rectangles←rl.t ELSE back.t←rl.t;
    FreeList[rl];
 -- FreeRectangle[rect];
    RETURN;
    END;
  back←rl; 
  ENDLOOP;
Error;
END;

MarkNatureAndOrientAndWhere:PROCEDURE[rect:RectanglePtr]=BEGIN
type:InterType=MakeType[n:rect.nSource, s:rect.sSource,
                  e:rect.eSource, w:rect.wSource];
type2:InterType=MakeType[n:rect.n#NIL, s:rect.s#NIL,
                  e:rect.e#NIL, w:rect.w#NIL];
IF rect.n#NIL AND rect.nSource THEN Error;
IF rect.s#NIL AND rect.sSource THEN Error;
IF rect.e#NIL AND rect.eSource THEN Error;
IF rect.w#NIL AND rect.wSource THEN Error;
rect.nature←channel;
rect.orient←bend;
--If type2 OR type = 15 you have no choice of nature, otherwise
--prefer channel inter culDeSac bend wall and box in that order
IF type=0 THEN SELECT type2 FROM
    12,08,04=>rect.orient←hor; 03,02,01=>rect.orient←vert;
    ENDCASE=>{rect.nature←inter; rect.orient←inter}
ELSE SELECT type2 FROM
   07,13=>{rect.nature←wallL; rect.orient←vert};
   11,14=>{rect.nature←wallR; rect.orient←hor };
   10=>rect.nature←bend10; 09=>rect.nature←bend9;
   06=>rect.nature←bend6; 05=>rect.nature←bend5;
   01,02,03=>{rect.orient←vert; SELECT type FROM
     02,06,10,14=>rect.nature←culDeSacL;
     01,05,09,13=>rect.nature←culDeSacR; ENDCASE};
   04,08,12=>{rect.orient←hor; SELECT type FROM
     08,09,10,11=>rect.nature←culDeSacL;
     04,05,06,07=>rect.nature←culDeSacR; ENDCASE};
   00=>SELECT type FROM
     15=>rect.nature←box;
     14=>{rect.nature←culDeSacL; rect.orient←vert};
     13=>{rect.nature←culDeSacR; rect.orient←vert};
     11=>{rect.nature←culDeSacL; rect.orient←hor };
     10=> rect.nature←bend5; 09=> rect.nature←bend6;
     07=>{rect.nature←culDeSacR; rect.orient←hor };
     06=> rect.nature←bend9; 05=> rect.nature←bend10;
     04,08,12=>rect.orient←vert;
     01,02,03=>rect.orient←hor;
     ENDCASE;
   ENDCASE;
FOR l:EventListPtr←rect.events,l.t UNTIL l=NIL DO
  e:EventPtr=l.h;
  hor:BOOLEAN=(rect.orient=hor);
  e.where←SELECT e.side FROM
    n=>IF hor THEN top ELSE right,
    s=>IF hor THEN bottom ELSE left,
    e=>IF hor THEN right ELSE bottom,
    ENDCASE=>IF hor THEN left ELSE top;
  ENDLOOP;
END;

MakeSecondaryLists:PROCEDURE[rect:RectanglePtr]=BEGIN
list:RectangleListPtr←AllocateList[];
SELECT rect.nature FROM
  inter,wallL,wallR,bend5,bend9,bend6,bend10=>BEGIN
      rect.junction←AllocateJunction[];
      rect.l.inter←rect; list↑←[rect,inters]; inters←list;
      END;
  channel,culDeSacR,culDeSacL=>
    {rect.l.channel←rect; list↑←[rect,channels]; channels←list};
  ENDCASE=>Error;
END;

SetEventNumbers:PROCEDURE[rect:RectanglePtr]=BEGIN
index:INTEGER←0;
FOR el:EventListPtr←rect.events,el.t UNTIL el=NIL
   DO e:EventPtr=el.h;
  IF e.index#-1 THEN Error;
  IF e.opposite#NIL THEN Error;
  IF e.next#NIL THEN Error;
  IF e.prev#NIL THEN Error;
  ENDLOOP;
FOR index←0, index+1 DO
  find,extra:EventPtr←NIL;
  min:Lambda←bigLambda;
  FOR el:EventListPtr←rect.events,el.t UNTIL el=NIL DO
    s:EventPtr=el.h;
    SELECT TRUE FROM
      s.index#-1 OR s.where=left OR s.where=right => LOOP;
      find=NIL => find←s;
      find.side=s.side AND s.offset<find.offset => find←s;
      find.side=s.side =>LOOP;
      s.offset<find.offset => {extra←find; find←s};
      extra=NIL OR s.offset<extra.offset => extra←s;
      ENDCASE;
    ENDLOOP;
  IF find=NIL THEN EXIT;
  find.index←index;
  IF extra#NIL AND extra.offset<find.offset+7 THEN BEGIN
    extra.index←index;
    extra.opposite←find; find.opposite←extra;
    END;
  ENDLOOP;
END;

SetNextAndPrevEvents:PROCEDURE[rect:RectanglePtr]=BEGIN
Sub:PROCEDURE[rect:RectanglePtr,e1:EventPtr]=BEGIN
  best:EventPtr←@nominal;
  IF e1.where=left OR e1.where=right THEN RETURN;
  FOR el2:EventListPtr←rect.events,el2.t UNTIL el2=NIL DO
    e2:EventPtr=el2.h;
    IF e2.where=e1.where AND e2.offset IN (e1.offset..best.offset)
    THEN best←e2;
    ENDLOOP;
  IF best.offset#bigLambda THEN {e1.next←best; best.prev←e1};
  END;
nominal:Event;   nominal.offset←bigLambda;
EnumerateEvents[rect,Sub];
END;

ComputeSizeC:PROCEDURE[rect:RectanglePtr]=BEGIN
widthL:Lambda←IF rect.orient=hor THEN rect.sizeL.y ELSE rect.sizeL.x;
rect.sizeC←[0,(widthL-8)/7];--not good enough
FOR el:EventListPtr←rect.events,el.t UNTIL el=NIL DO
  e1:EventPtr=el.h;
  IF (e1.where=left OR e1.where=right) AND e1.index>-1 THEN Error;
  IF e1.index>rect.sizeC.x THEN rect.sizeC.x←e1.index;
  ENDLOOP;
END;

ShowRectangles:PROCEDURE[rect:RectanglePtr]=BEGIN
Return[];
ShowDecimal[rect.channelNo, "Rect "];
ShowPoint[" pos ",rect.pos.x,rect.pos.y];
ShowPoint[" size: ",rect.sizeL.x,rect.sizeL.y];
END;

MakeLevelers:PUBLIC CtlProc=BEGIN
r:RectanglePtr←NIL;
f:ARRAY [0..6] OF Lambda;
ClearF:PROCEDURE={FOR i:[0..6] IN [0..6] DO f[i]←i; ENDLOOP};
IncF:PROCEDURE[d:Lambda]=
 {d←7000+d; FOR i:[0..6] IN [0..6] DO f[i]←f[i]+((d+i) MOD 7); ENDLOOP};
FindMinF:PROCEDURE RETURNS[what:[0..6]]=BEGIN
  min:Lambda←bigLambda;
  FOR i:[0..6] IN [0..6] DO IF f[i]<min THEN {min←f[i]; what←i}; ENDLOOP;
  END;
EnumerateRectangles[ScavangeRuns];--for second time around
FOR rl:RectangleListPtr←rectangles,rl.t UNTIL rl=NIL DO
  rect:RectanglePtr=rl.h;
  ClearF[];
  FOR r←rect.e,r.e UNTIL r=NIL
    DO IncF[rect.pos.y+rect.margins.s-r.pos.y-r.margins.s]; ENDLOOP;
  FOR r←rect.w,r.w UNTIL r=NIL
    DO IncF[rect.pos.y+rect.margins.s-r.pos.y-r.margins.s]; ENDLOOP;
  rect.levelers.s←FindMinF[];
  ClearF[];
  FOR r←rect.n,r.n UNTIL r=NIL
    DO IncF[r.pos.x+r.sizeL.x-r.margins.e-rect.pos.x-rect.sizeL.x+rect.margins.e]; ENDLOOP;
  FOR r←rect.s,r.s UNTIL r=NIL
    DO IncF[r.pos.x+r.sizeL.x-r.margins.e-rect.pos.x-rect.sizeL.x+rect.margins.e]; ENDLOOP;
  rect.levelers.e←FindMinF[];
  ClearF[];
  FOR r←rect.e,r.e UNTIL r=NIL
    DO IncF[r.pos.y+r.sizeL.y-r.margins.n-rect.pos.y-rect.sizeL.y+rect.margins.n]; ENDLOOP;
  FOR r←rect.w,r.w UNTIL r=NIL
    DO IncF[r.pos.y+r.sizeL.y-r.margins.n-rect.pos.y-rect.sizeL.y+rect.margins.n]; ENDLOOP;
  rect.levelers.n←FindMinF[];
  ClearF[];
  FOR r←rect.n,r.n UNTIL r=NIL
    DO IncF[rect.pos.x+rect.margins.w-r.pos.x-r.margins.w]; ENDLOOP;
  FOR r←rect.s,r.s UNTIL r=NIL
    DO IncF[rect.pos.x+rect.margins.w-r.pos.x-r.margins.w]; ENDLOOP;
  rect.levelers.w←FindMinF[];
  SELECT rect.orient FROM
    hor=>rect.avail←(rect.sizeL.x-rect.margins.w-rect.margins.e
                     -rect.levelers.w-rect.levelers.e-4)/7;
    vert=>rect.avail←(rect.sizeL.y-rect.margins.n-rect.margins.s
                     -rect.levelers.n-rect.levelers.s-4)/7;
    ENDCASE=>rect.avail←0;
  ENDLOOP;
RETURN[-1];
END;

ScavangeRuns:PROCEDURE[rect:RectanglePtr]=BEGIN
DO
  rl:RunListPtr=rect.runs;
  IF rl=NIL THEN EXIT;
  rect.runs←rl.t;
  FreeRun[rl.h];
  FreeList[rl];
  ENDLOOP;
DO
  rl:ConnListPtr=rect.conns;
  IF rl=NIL THEN EXIT;
  rect.conns←rl.t;
  FreeConn[rl.h];
  FreeList[rl];
  ENDLOOP;
IF rect.junction#NIL THEN rect.junction↑←[];
END;

line:CARDINAL=40;

ShowChannels:PROCEDURE[rect:RectanglePtr]=BEGIN
top:STRING←[line];
bottom:STRING←[line];
IF rect.orient=inter THEN {IF rect.events#NIL THEN Error; RETURN};
Return[];
ShowDecimal[rect.channelNo," number; "];
ShowPoint[" pos ",rect.pos.x,rect.pos.y];
ShowPoint[" size: ",rect.sizeL.x,rect.sizeL.y];
FOR i:CARDINAL IN [0..line) DO top[i]←bottom[i]←' ; ENDLOOP;
top.length←bottom.length←line;
FOR t:EventListPtr←rect.events, t.t UNTIL t=NIL DO
    e:EventPtr=t.h;
    i:CARDINAL=IF e.index=-1 THEN 0 ELSE e.index;
    IF i NOT IN [0..line) THEN {Error; LOOP};
    IF e.where=top THEN top[i]←ShowCircuit[e.circuit];
    IF e.where=bottom THEN bottom[i]←ShowCircuit[e.circuit];
    ENDLOOP;
Return[];
Return[];
ShowString[top];
Return[];
ShowString[bottom];
END;

END.