--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.