--routeRectangle.mesa

DIRECTORY  RouteDefs;

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

--SAMPLE EXAMPLE

Error:SIGNAL=CODE;

Rect:TYPE=RECORD[x,y,x1,y1:INTEGER];

nextChannelNo:ChannelNo←0;

CreateRectangles:PUBLIC CtlProc=BEGIN
rectangles←NIL;
nextChannelNo←1;
ShowLabel["RECTANGLES"];
CreateBareChannelsAndInters[];
SubdivideIfNeeded[];
EnumerateRectangles[AddEventsToRectangles];
--EnumerateRectangles[CheckRectangles];
RETURN[-1];
END;

CreateBareChannelsAndInters:PROCEDURE=BEGIN
FOR y:Lambda←0, NextYEvent[y] UNTIL y>=problem.chipSize.y DO
  FOR x:Lambda←NextXEvent[0,y], NextXEvent[x,y] UNTIL x>=problem.chipSize.x
    DO DealWithPoint[x,y]; ENDLOOP;
  ENDLOOP;
END;

--an "event" is the edge of a cell

NextYEvent:PROCEDURE[above:Lambda] RETURNS[next:Lambda]=BEGIN
next←bigLambda;
FOR cl:CellListPtr←problem.cells,cl.t UNTIL cl=NIL DO
  y:Lambda←cl.h.pos.y; IF y>above THEN next←MIN[next,y];
  y←y+cl.h.sizeL.y; IF y>above THEN next←MIN[next,y];
  ENDLOOP;
END;

--NextYEvent:PROCEDURE[above:Lambda] RETURNS[next:Lambda]=BEGIN
--Sub:PROCEDURE[c:CellPtr]=
--  {y:Lambda←c.pos.y;
--  IF above>=y THEN y←y+c.sizeL.y; IF y>above THEN next←MIN[next,y]};
--next←bigLambda;
--EnumerateCells[Sub];
--END;

NextXEvent:PROCEDURE[atX,atY:Lambda] RETURNS[this:Lambda]=BEGIN
kind:RectKind←cell;
next:Lambda←atX;
UNTIL kind=none DO this←next; [next,kind]←NextXEdge[next,atY]; ENDLOOP;
END;

DealWithPoint:PROCEDURE[x,y:Lambda]=BEGIN
--the lower left corner of an as yet empty region
ClipStrange:PROCEDURE[cell:CellPtr]=BEGIN
  r1:Rect←[cell.pos.x,cell.pos.y,
     cell.pos.x+cell.sizeL.x,cell.pos.y+cell.sizeL.y];
  IF ~Overlap[@r0,@r1] THEN RETURN;
  IF r1.x NOT IN [r0.x..r0.x1) AND r1.y IN [r0.y..r0.y1)
      THEN Error;
  r0.x1←x3←r1.x; r0.y1←y3←r1.y;
  END;
maxX:INTEGER←32000;
kind,topKind,rightKind:RectKind;
x1,y1,x2,y2,x3,y3:Lambda;
r0:Rect;
leftWhite,bottomWhite,topWhite,rightWhite:BOOLEAN←FALSE;
Return[];
ShowPoint["empty point = ",x,y];
[x1,bottomWhite,kind]←FarXExtension[x,y];
IF kind#none THEN Error;
[y1,leftWhite,kind]←FarYExtension[y,x];
IF kind#none THEN Error;
[x2,,topKind]←FarXExtension[x,y1];
[y2,,rightKind]←FarYExtension[y,x1];
x3←MIN[x1,x2];
y3←MIN[y1,y2];
r0←[x,y,x3,y3];
EnumerateCells[ClipStrange];
topWhite←topKind#cell;
rightWhite←rightKind#cell;
NewRect[[x,y],[x3-x,y3-y],NIL];
END;

FarXExtension:PROCEDURE[x,y:Lambda]
  RETURNS[x3:Lambda,belowWhite:BOOLEAN,kind:RectKind]=BEGIN
x1,x2:Lambda←problem.chipSize.x;
belowWhite←FALSE;
IF  y#0 THEN BEGIN
  temp:Lambda;
  [temp,kind]←NextXEdge[x,y-1];
  belowWhite←kind#cell;
  x1←temp;
  UNTIL kind#cell DO [temp,kind]←NextXEdge[x1←temp,y-1]; ENDLOOP;
  END;
[x2,kind]←NextXEdge[x,y];
x3←MIN[x1,x2];
END;

FarYExtension:PROCEDURE[x,y:Lambda] --call with [y,x] !!!
  RETURNS[x3:Lambda,belowWhite:BOOLEAN,kind:RectKind]=BEGIN
x1,x2:Lambda←problem.chipSize.y;
belowWhite←FALSE;
IF  y#0 THEN BEGIN
  temp:Lambda;
  [temp,kind]←NextYEdge[x,y-1];
  belowWhite←kind#cell;
  x1←temp;
  UNTIL kind#cell DO [temp,kind]←NextYEdge[x1←temp,y-1]; ENDLOOP;
  END;
[x2,kind]←NextYEdge[x,y];
x3←MIN[x1,x2];
END;

NextXEdge:PROCEDURE[atX,atY:Lambda] RETURNS[INTEGER,RectKind]=BEGIN
--IF [atX,atY] is in a rectangle,
--  THEN return [rightEdge+1,kind] ELSE return [firstEdge to right, none]
best:Lambda←bigLambda;
FOR cl:CellListPtr←problem.cells,cl.t UNTIL cl=NIL DO
  p:CoordL←cl.h.pos; s:CoordL←cl.h.sizeL;
  IF atY-p.y IN [0..s.y) THEN SELECT atX-p.x FROM
     <0=>best←MIN[best,p.x]; <s.x=>RETURN[p.x+s.x,cell];
     ENDCASE;
  ENDLOOP;
FOR cl:RectangleListPtr←rectangles,cl.t UNTIL cl=NIL DO
  rect:RectanglePtr=cl.h;
  p:CoordL←rect.pos; s:CoordL←rect.sizeL;
  IF atY-p.y IN [0..s.y) THEN SELECT atX-p.x FROM
     <0=>best←MIN[best,p.x]; <s.x=>RETURN[p.x+s.x,inter];
     ENDCASE;
  ENDLOOP;
RETURN[best,none];
END;

NextYEdge:PROCEDURE[atX,atY:Lambda] RETURNS[INTEGER,RectKind]=BEGIN
--called with [y,x]
best:Lambda←bigLambda;
FOR cl:CellListPtr←problem.cells,cl.t UNTIL cl=NIL DO
  p:CoordL←cl.h.pos; s:CoordL←cl.h.sizeL;
  IF atY-p.x IN [0..s.x) THEN SELECT atX-p.y FROM
     <0=>best←MIN[best,p.y]; <s.y=>RETURN[p.y+s.y,cell]; ENDCASE;
  ENDLOOP;
FOR cl:RectangleListPtr←rectangles,cl.t UNTIL cl=NIL DO
  rect:RectanglePtr=cl.h;
  p:CoordL←rect.pos; s:CoordL←rect.sizeL;
  IF atY-p.x IN [0..s.x) THEN SELECT atX-p.y FROM
     <0=>best←MIN[best,p.y]; <s.y=>RETURN[p.y+s.y,inter];
     ENDCASE;
  ENDLOOP;
RETURN[best,none];
END;

Overlap:PROCEDURE[a,b:POINTER TO Rect] RETURNS[BOOLEAN]=BEGIN
RETURN[ a.x<b.x1 AND b.x<a.x1 AND a.y<b.y1 AND b.y<a.y1]; 
END;

SubdivideIfNeeded:PROCEDURE=BEGIN
DO
  progress:BOOLEAN←FALSE;
  FOR rl:RectangleListPtr←rectangles,rl.t UNTIL rl=NIL DO
    rect:RectanglePtr=rl.h;
    top:Lambda=rect.pos.y+rect.sizeL.y;
    xs:Lambda=rect.pos.x;
    xe:Lambda←xs+rect.sizeL.x;
    FOR r2:RectangleListPtr←rectangles,r2.t UNTIL r2=NIL DO
      rect2:RectanglePtr←r2.h;
      xs2:Lambda=rect2.pos.x;
      xe2:Lambda=xs2+rect2.sizeL.x;
      split:Lambda;
      IF top#rect2.pos.y THEN LOOP;
      SELECT TRUE FROM
        xe2 IN (xs..xe)=>split←xe2;
        xs2 IN (xs..xe)=>split←xs2;
        ENDCASE=>LOOP;
      BEGIN
        dx:Lambda←xe-split;
        pos:CoordL=[split,rect.pos.y];
        sizeL:CoordL=[dx,rect.sizeL.y];
        NewRect[pos,sizeL,rl];
        rect.sizeL.x←rect.sizeL.x-dx;
        xe←split;
        progress←TRUE;
        END;
      ENDLOOP;
    ENDLOOP;
  IF progress THEN LOOP;
  FOR rl:RectangleListPtr←rectangles,rl.t UNTIL rl=NIL DO
    rect:RectanglePtr=rl.h;
    top:Lambda=rect.pos.x+rect.sizeL.x;
    ys:Lambda=rect.pos.y;
    ye:Lambda←ys+rect.sizeL.y;
    FOR r2:RectangleListPtr←rectangles,r2.t UNTIL r2=NIL DO
      rect2:RectanglePtr←r2.h;
      ys2:Lambda=rect2.pos.y;
      ye2:Lambda=ys2+rect2.sizeL.y;
      split:Lambda;
      IF top#rect2.pos.x THEN LOOP;
      SELECT TRUE FROM
        ye2 IN (ys..ye)=>split←ye2;
        ys2 IN (ys..ye)=>split←ys2;
        ENDCASE=>LOOP;
      BEGIN
        dy:Lambda←ye-split;
        pos:CoordL=[rect.pos.x,split];
        sizeL:CoordL=[rect.sizeL.x,dy];
        NewRect[pos,sizeL,rl];
        rect.sizeL.y←rect.sizeL.y-dy;
        ye←split;
        progress←TRUE;
        END;
      ENDLOOP;
    ENDLOOP;
  IF ~progress THEN EXIT;
  ENDLOOP;
END;

NewRect:PROCEDURE[pos,size:CoordL,base:RectangleListPtr]=BEGIN
list:RectangleListPtr←AllocateList[];
rect:RectanglePtr←AllocateRectangle[];
rect.channelNo←nextChannelNo;
nextChannelNo←nextChannelNo+1;
rect.pos←pos;
rect.sizeL←size;
IF base=NIL THEN {list↑←[rect,rectangles]; rectangles←list}
  ELSE {list↑←[rect,base.t]; base.t←list};
END;

AddEventsToRectangles:PROCEDURE[rect:RectanglePtr]=BEGIN
k:Side;
EwWall:PROCEDURE[cell:CellPtr,s:SignalPtr]=BEGIN
  l:Side=IF k=e THEN w ELSE e;
  off:Lambda=s.offset+cell.pos.y-rect.pos.y;
  IF s.side=k AND off IN [0..rect.sizeL.y)
  THEN BEGIN
  AddEvent[rect,[,s.circuit,IF k=w THEN bottom ELSE top,l,s.level,off,s.net]];
  IF k=w THEN rect.eSource←TRUE ELSE rect.wSource←TRUE;
  END; END;
NsWall:PROCEDURE[cell:CellPtr,s:SignalPtr]=BEGIN
  l:Side=IF k=s THEN n ELSE s;
  off:Lambda=s.offset+cell.pos.x-rect.pos.x;
  IF s.side=k AND off IN [0..rect.sizeL.x)
  THEN BEGIN
  AddEvent[rect,[,s.circuit,IF k=n THEN bottom ELSE top,l,s.level,off,s.net]];
  IF k=s THEN rect.nSource←TRUE ELSE rect.sSource←TRUE;
  END; END;
Sub:PROCEDURE[cell:CellPtr]=BEGIN
  SELECT TRUE FROM
    cell.pos.x=rect.pos.x+rect.sizeL.x=>{k←w; EnumerateSignals[cell,EwWall]};
    cell.pos.x+cell.sizeL.x=rect.pos.x=>{k←e; EnumerateSignals[cell,EwWall]};
    cell.pos.y=rect.pos.y+rect.sizeL.y=>{k←s; EnumerateSignals[cell,NsWall]};
    cell.pos.y+cell.sizeL.y=rect.pos.y=>{k←n; EnumerateSignals[cell,NsWall]};
    ENDCASE;
  END;
IF rect.events#NIL THEN Error;
EnumerateCells[Sub];
END;

AddEvent:PROCEDURE[chan:RectanglePtr,e:Event]=BEGIN
ep:EventPtr←AllocateEvent[];
list:EventListPtr←AllocateList[];
ep↑←e;
list↑←[ep,chan.events];
chan.events←list;
END;

END.