--routeRuns.mesa

DIRECTORY  RouteDefs;

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

Error:SIGNAL=CODE;
NoRoom:SIGNAL=CODE;
Offsets:TYPE=RECORD[l,r:EventNo_bigRun,lu:BOOLEAN_TRUE];
HigherRet:TYPE=RECORD[hi,pure:BOOLEAN,id:ChannelNo];

order:RunListPtr_NIL;
plowOn:BOOLEAN_FALSE;

TheMainShowIsRouteRunsInChannels:PUBLIC CtlProc=BEGIN
EnumeratePaths[MakeRunsFromPaths];
ScavageOrder[];
EnumerateAllRuns[OrderRunsForBetterPlacement];
EnumerateOrder[AssignCulDeSacRunNo];
EnumerateOrder[AssignBottomUpRunNo];
ReverseOrder[];
EnumerateOrder[AssignTopDownRunNo];
EnumerateOrder[FixUpJunctionsWithInters];
EnumeratePaths[AssignInterInterLocations];
EnumerateAllRuns[CheckRun];
EnumerateChannels[ShowRun];
RETURN[-1];
END;

ScavageOrder:PROCEDURE=BEGIN
UNTIL order=NIL
  DO p:RunListPtr=order; order_p.t; FreeList[p]; ENDLOOP;
END;

ReverseOrder:PROCEDURE=BEGIN
s:RunListPtr_order; order_NIL;
UNTIL s=NIL DO t:RunListPtr=s; s_s.t; t.t_order; order_t; ENDLOOP;
END;

EnumerateOrder:PROCEDURE[c:PROCEDURE[RunPtr]]=
  {FOR o:RunListPtr_order,o.t UNTIL o=NIL DO c[o.h]; ENDLOOP};

EnumeratePaths:PROCEDURE[call:PROCEDURE[PathPtr]]=BEGIN
WalkX:PROCEDURE[path:PathPtr,side:Side]=BEGIN
  IF path.channel#NIL THEN call[path];
  IF side#n AND path.n#NIL THEN WalkX[path.n,s];
  IF side#s AND path.s#NIL THEN WalkX[path.s,n];
  IF side#e AND path.e#NIL THEN WalkX[path.e,w];
  IF side#w AND path.w#NIL THEN WalkX[path.w,e];
  END;
FOR pwl:PathwayListPtr_paths,pwl.t UNTIL pwl=NIL
  DO WalkX[pwl.h.path.h,x]; ENDLOOP;
END;

MakeRunsFromPaths:PROCEDURE[path:PathPtr]=BEGIN
chan:RectanglePtr=path.channel;
pathL:PathPtr=IF chan.orient=hor THEN path.w ELSE path.s;
pathR:PathPtr=IF chan.orient=hor THEN path.e ELSE path.n;
c2:RectanglePtr=IF pathR=NIL THEN NIL ELSE pathR.channel;
off:Offsets=GetOffsets[path];
offs2:Offsets=IF c2=chan THEN GetOffsets[pathR] ELSE [];
stx:EventNo=SELECT TRUE FROM
  off.r#bigRun=>off.r, off.l#bigRun=>off.l, ENDCASE=>-1;
stu:BOOLEAN=SELECT TRUE FROM
  off.r#bigRun=>~off.lu, ENDCASE=>off.lu;
IF stx=-1 AND (pathL=NIL OR pathL.channel=chan
            OR pathR=NIL OR c2=chan) THEN Error;
IF off.l#bigRun AND off.r#bigRun AND off.l#off.r
  THEN AddRun[st:off.l,end:off.r,chan:chan,path:path,circuit:path.circuit,
     stU:off.lu,stD:~off.lu,stL:pathL#NIL,
     endU:~off.lu,endD:off.lu,endL:pathR#NIL];
IF pathL#NIL AND pathL.channel#chan
  THEN AddRun[st:-1,end:off.l,chan:chan,path:path,circuit:path.circuit,
     stU:FALSE,stD:FALSE,stL:TRUE,
    endU:stx#-1 AND off.lu,endD:stx#-1 AND ~off.lu,
    endL:pathR#NIL OR off.r#bigRun];
IF off.l#bigRun AND pathR#NIL THEN BEGIN
  el:BOOLEAN=c2#chan OR offs2.r#bigRun OR
      (IF c2.orient=hor THEN pathR.e ELSE pathR.n)#NIL;
  AddRun[st:stx,end:offs2.l,chan:chan,path:path,circuit:path.circuit,
        stU:stu,stD:~stu,stL:off.r#bigRun OR pathL#NIL,
       endU:c2=chan AND  offs2.lu,endD:c2=chan AND ~offs2.lu,endL:el];
  END;
END;

GetOffsets:PROCEDURE[path:PathPtr] RETURNS[Offsets]=BEGIN
chan:RectanglePtr=path.channel;
path1:PathPtr=IF chan.orient=hor THEN path.n ELSE path.w;
path2:PathPtr=IF chan.orient=hor THEN path.s ELSE path.e;
off1:EventNo=IF path1#NIL THEN path1.index.index ELSE bigRun;
off2:EventNo=IF path2#NIL THEN path2.index.index ELSE bigRun;
RETURN[IF off1>off2 THEN [off2,off1,FALSE] ELSE [off1,off2,TRUE]];
END;

OrderRunsForBetterPlacement:PROCEDURE[chan:RectanglePtr,run:RunPtr]=
  {UNTIL run.order DO MarkHighest[chan,run]; ENDLOOP};


MarkHighest:PROCEDURE[chan:RectanglePtr,run:RunPtr]=BEGIN
FOR rl2:RunListPtr_chan.runs,rl2.t UNTIL rl2=NIL DO
  run2:RunPtr=rl2.h;
  IF run#run2 AND ~run2.order AND Higher[run2,run] THEN run_run2;
  ENDLOOP;
FOR rl2:RunListPtr_chan.runs,rl2.t UNTIL rl2=NIL DO
  run2:RunPtr=rl2.h;
  IF ~run2.order AND run2.circuit=run.circuit THEN BEGIN
    list:RunListPtr=AllocateList[];
    list^_[run2,order]; order_list; run2.order_TRUE;
    END;
  ENDLOOP;
END;

Higher:PROCEDURE[a,b:RunPtr] RETURNS[h:BOOLEAN]=BEGIN
IF a.start>=b.end OR b.start>=a.end THEN RETURN[FALSE];
BEGIN
chan:RectanglePtr=a.chan;
side1:Side=IF chan.orient=hor THEN w ELSE s;
side2:Side=IF chan.orient=hor THEN e ELSE n;
pure1:BOOLEAN=a.stU#a.stD AND b.stU#b.stD;
pure2:BOOLEAN=a.endU#a.endD AND b.endU#b.endD;
x1:HigherRet=IF a.start=-1 AND b.start=-1
   THEN TrueHigher[a.path,b.path,side1]
   ELSE [IF a.start>=b.start THEN a.stU ELSE b.stD,pure1,chan.channelNo];
x2:HigherRet=IF a.end=bigRun AND b.end=bigRun
   THEN TrueHigher[a.path,b.path,side2]
   ELSE [IF a.end<=b.end THEN a.endU ELSE b.endD,pure2,chan.channelNo];
choice:BOOLEAN=IF x1.pure=x2.pure THEN x1.id>=x2.id ELSE x1.pure;
RETURN[IF choice THEN x1.hi ELSE x2.hi];
END; END;

TrueHigher:PROCEDURE[ao,bo:PathPtr,side:Side] RETURNS[ans:HigherRet]=BEGIN
a:PathPtr=SELECT side FROM n=>ao.n, s=>ao.s, e=>ao.e, ENDCASE=>ao.w;
b:PathPtr=SELECT side FROM n=>bo.n, s=>bo.s, e=>bo.e, ENDCASE=>bo.w;
atype:InterType=MakeType[n:a.n#NIL,s:a.s#NIL,e:a.e#NIL, w:a.w#NIL];
btype:InterType=MakeType[n:b.n#NIL,s:b.s#NIL,e:b.e#NIL, w:b.w#NIL];
IF a.inter#b.inter OR a.channel#b.channel THEN Error;
ans.id_IF a.inter#NIL THEN a.inter.channelNo ELSE a.channel.channelNo;
ans.pure_SELECT atype FROM 7,11,13,14,15 => FALSE, ENDCASE=>
         SELECT btype FROM 7,11,13,14,15 => FALSE, ENDCASE=>TRUE;
IF a.inter#NIL AND atype=btype THEN SELECT side FROM
  w=>SELECT atype FROM
      06=>ans_TrueHigher[a,b,s];
      05=>ans_TrueHigher[b,a,n];
      12=>ans_TrueHigher[a,b,w];
      ENDCASE=>ans.hi_TRUE;
  e=>SELECT atype FROM
      09=>ans_TrueHigher[a,b,n];
      10=>ans_TrueHigher[b,a,s];
      12=>ans_TrueHigher[a,b,e];
      ENDCASE=>ans.hi_TRUE;
  n=>SELECT atype FROM
      10=>ans_TrueHigher[b,a,w];
      06=>ans_TrueHigher[a,b,e];
      03=>ans_TrueHigher[a,b,n];
      ENDCASE=>ans.hi_TRUE;
  s=>SELECT atype FROM
      05=>ans_TrueHigher[b,a,e];
      09=>ans_TrueHigher[a,b,w];
      03=>ans_TrueHigher[a,b,s];
      ENDCASE=>ans.hi_TRUE;
  ENDCASE=>Error;
IF a.inter#NIL AND atype#btype THEN SELECT side FROM
  w=>ans.hi_atype=5 OR btype=6 OR
                atype#6 AND btype#5 AND atype#14 AND btype#13;
  e=>ans.hi_atype=9 OR btype=10 OR
                atype#10 AND btype#9 AND atype#14 AND btype#13;
  n=>ans.hi_atype=9 OR btype=5 OR
                atype#5 AND btype#9 AND atype#7 AND btype#11;
  s=>ans.hi_atype=10 OR btype=6 OR
                atype#6 AND btype#10 AND atype#7 AND btype#11;
  ENDCASE=>Error;
IF a.inter=NIL THEN SELECT side FROM
  e=>BEGIN
    aUp:Lambda=IF a.n=NIL THEN -1 ELSE a.n.index.offset;
    aDn:Lambda=IF a.s=NIL THEN -1 ELSE a.s.index.offset;
    aEv:Lambda=MAX[aUp,aDn];
    bUp:Lambda=IF b.n=NIL THEN -1 ELSE b.n.index.offset;
    bDn:Lambda=IF b.s=NIL THEN -1 ELSE b.s.index.offset;
    bEv:Lambda=MAX[bUp,bDn];
    SELECT TRUE FROM
      aEv#bEv=>ans.hi_IF aEv<bEv THEN a.n#NIL ELSE b.s#NIL;
      aEv=-1 =>ans_TrueHigher[a,b,side];
      ENDCASE=>ans.hi_a.n#NIL;
    END;
  w=>BEGIN
    aUp:Lambda=IF a.n=NIL THEN bigRun ELSE a.n.index.offset;
    aDn:Lambda=IF a.s=NIL THEN bigRun ELSE a.s.index.offset;
    aEv:Lambda=MIN[aUp,aDn];
    bUp:Lambda=IF b.n=NIL THEN bigRun ELSE b.n.index.offset;
    bDn:Lambda=IF b.s=NIL THEN bigRun ELSE b.s.index.offset;
    bEv:Lambda=MIN[bUp,bDn];
    SELECT TRUE FROM
      aEv#bEv=>ans.hi_IF aEv>bEv THEN a.n#NIL ELSE b.s#NIL;
      aEv=bigRun =>ans_TrueHigher[a,b,side];
      ENDCASE=>ans.hi_a.n#NIL;
    END;
  n=>BEGIN
    aUp:Lambda=IF a.w=NIL THEN -1 ELSE a.w.index.offset;
    aDn:Lambda=IF a.e=NIL THEN -1 ELSE a.e.index.offset;
    aEv:Lambda=MAX[aUp,aDn];
    bUp:Lambda=IF b.w=NIL THEN -1 ELSE b.w.index.offset;
    bDn:Lambda=IF b.e=NIL THEN -1 ELSE b.e.index.offset;
    bEv:Lambda=MAX[bUp,bDn];
    SELECT TRUE FROM
      aEv#bEv=>ans.hi_IF aEv<bEv THEN a.w#NIL ELSE b.e#NIL;
      aEv=-1 =>ans_TrueHigher[a,b,side];
      ENDCASE=>ans.hi_a.w#NIL;
    END;
  s=>BEGIN
    aUp:Lambda=IF a.w=NIL THEN bigRun ELSE a.w.index.offset;
    aDn:Lambda=IF a.e=NIL THEN bigRun ELSE a.e.index.offset;
    aEv:Lambda=MIN[aUp,aDn];
    bUp:Lambda=IF b.w=NIL THEN bigRun ELSE b.w.index.offset;
    bDn:Lambda=IF b.e=NIL THEN bigRun ELSE b.e.index.offset;
    bEv:Lambda=MIN[bUp,bDn];
    SELECT TRUE FROM
      aEv#bEv=>ans.hi_IF aEv>bEv THEN a.w#NIL ELSE b.e#NIL;
      aEv=bigRun =>ans_TrueHigher[a,b,side];
      ENDCASE=>ans.hi_a.w#NIL;
    END;
  ENDCASE=>Error;
END;

AssignCulDeSacRunNo:PROCEDURE[run:RunPtr]=BEGIN
chan:RectanglePtr=run.chan;
IF chan.nature = culDeSacL AND run.start<=0 OR 
   chan.nature = culDeSacR AND run.start>=chan.sizeC.x-1 THEN BEGIN
  path:PathPtr=run.path;
  path1:PathPtr=IF chan.nature =culDeSacL
    THEN IF chan.orient=hor THEN path.w ELSE path.s
    ELSE IF chan.orient=hor THEN path.e ELSE path.n;
  off:Lambda=path1.index.offset;
  del:Lambda_IF chan.orient=hor
    THEN off-chan.levelers.s-chan.margins.s
    ELSE chan.sizeL.y-off-chan.levelers.e-chan.margins.e;
  this:RunNo_del/7; 
  IF this IN [0..chan.sizeC.y) THEN run.run_this; 
  END;
END;

AssignBottomUpRunNo:PROCEDURE[run:RunPtr]=BEGIN
chan:RectanglePtr=run.chan;
IF run.run<0 THEN SELECT run.path.huggers.ch FROM
  s,e,x=>FOR i:INTEGER IN [0..chan.sizeC.y)
    DO IF FindRun[chan,i,run] THEN {run.run_i; EXIT}; ENDLOOP;
  ENDCASE=>RETURN;
IF run.run NOT IN [0..chan.sizeC.y) THEN {NoRoom; run.run_-1}; 
END;

AssignTopDownRunNo:PROCEDURE[run:RunPtr]=BEGIN
chan:RectanglePtr=run.chan;
IF run.run<0 THEN SELECT run.path.huggers.ch FROM
  s,e,x=>RETURN;
  ENDCASE=>FOR i:INTEGER DECREASING IN [0..chan.sizeC.y)
    DO IF FindRun[chan,i,run] THEN {run.run_i; EXIT}; ENDLOOP;
IF run.run NOT IN [0..chan.sizeC.y) THEN {NoRoom; run.run_-1}; 
END;

FindRun:PROCEDURE[rect:RectanglePtr,where:RunNo,r:RunPtr]
  RETURNS[BOOLEAN]=BEGIN
FOR rl:RunListPtr_rect.runs,rl.t UNTIL rl=NIL DO
  run:RunPtr=rl.h;
  IF run.run=where AND run.start<r.end AND r.start<run.end
       AND run.circuit#r.circuit THEN RETURN[FALSE];
  ENDLOOP;
RETURN[TRUE];
END;

FixUpJunctionsWithInters:PROCEDURE[run:RunPtr]=BEGIN
chan:RectanglePtr=run.chan;
hor:BOOLEAN=chan.orient=hor;
path:PathPtr=run.path;
IF run.start=-1 THEN BEGIN
  pathI:PathPtr=IF hor THEN path.w ELSE path.s;
  IF pathI.inter=NIL THEN Error ELSE BEGIN
  where:RunNo=WhereIs[pathI,IF hor THEN e ELSE n,run.run];
  IF where#run.run THEN BEGIN
    AddRun[chan:chan,st:-1,end:-1,circuit:path.circuit,
          path:path,stU:FALSE,stD:FALSE,stL:TRUE,endU:FALSE,
          endD:FALSE,endL:TRUE];
    chan.runs.h.run_where;
    END;
  END; END;
IF run.end=bigRun THEN BEGIN
  pathI:PathPtr=IF hor THEN path.e ELSE path.n;
  IF pathI.inter=NIL THEN Error ELSE BEGIN
  where:RunNo=WhereIs[pathI,IF hor THEN w ELSE s,run.run];
  IF where#run.run THEN BEGIN
    AddRun[chan:chan,st:bigRun,end:bigRun,circuit:path.circuit,
          path:path,stU:FALSE,stD:FALSE,stL:TRUE,endU:FALSE,
          endD:FALSE,endL:TRUE];
    chan.runs.h.run_where;
    END;
  END; END;
END;

AssignInterInterLocations:PROCEDURE[path:PathPtr]=BEGIN
inter:RectanglePtr=path.inter;
IF inter=NIL THEN RETURN;
IF path.n#NIL AND path.n.inter#NIL THEN BEGIN
  []_WhereIs[path,n,0]; []_WhereIs[path.n,s,0];
  END;
IF path.w#NIL AND path.w.inter#NIL THEN BEGIN
  []_WhereIs[path,w,0]; []_WhereIs[path.w,e,0];
  END;
END;

AddRun:PROCEDURE[chan:RectanglePtr,st,end:EventNo,path:PathPtr,
    stU,stD,stL,endU,endD,endL:BOOLEAN,circuit:Circuit]=BEGIN
list:RunListPtr_AllocateList[];
r:RunPtr_AllocateRun[];
r^_[circuit:circuit,run:-2,start:st,end:end,
    stU:stU,stD:stD,stL:stL,endU:endU,endD:endD,endL:endL,
    chan:chan,path:path];
list^_[r,chan.runs];
chan.runs_list;
END;

CheckRun:PROCEDURE[rect:RectanglePtr,r:RunPtr]=BEGIN
IF plowOn THEN RETURN;
IF r.run NOT IN [0..rect.sizeC.y) THEN Error;
FOR rl2:RunListPtr_rect.runs,rl2.t UNTIL rl2=NIL DO
  r2:RunPtr_rl2.h;
  IF r2=r THEN LOOP;
  IF (r.run = r2.run OR r.circuit = r2.circuit)
       AND r.start<r2.end AND r2.start<r.end
       AND r.start#r.end AND r2.start#r2.end THEN Error;
  ENDLOOP;
END;

ShowRun:PROCEDURE[rect:RectanglePtr]=BEGIN
runMax:INTEGER_0;
line:CARDINAL=40;
top:STRING_[line];
bottom:STRING_[line];
ShowLabel["RUN "];
ShowDecimal[rect.channelNo];
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_e.index+1;
    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];
FOR rl:RunListPtr_rect.runs,rl.t UNTIL rl=NIL
  DO runMax_MAX[runMax,rl.h.run]; ENDLOOP;
FOR i:INTEGER DECREASING IN [0..runMax] DO
  Return[];
  FOR i:CARDINAL IN [0..line) DO top[i]_' ; ENDLOOP;
  FOR rl:RunListPtr_rect.runs,rl.t UNTIL rl=NIL DO
    r:RunPtr=rl.h;
    IF r.run=i THEN BEGIN
      char:CHARACTER_ShowCircuit[r.circuit];
      FOR j:INTEGER IN [r.start..MIN[r.end,rect.sizeC.x])
        DO k:CARDINAL=j+1; top[k]_char; ENDLOOP;
      END;
    ENDLOOP;
  ShowString[top];
  ENDLOOP;
Return[];
ShowString[bottom];
END;

END.