--routeCrosses.mesa

DIRECTORY  RouteDefs;

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

--the function of Crosses is to fill in the offset field in a Conn record.
--this offset will keep cross wires from shorting.
--strtKind and endKind are also computed but no one uses them except crosses.


Error:SIGNAL=CODE;
marginChanged:BOOLEAN;

InstallInternalContacts:PUBLIC CtlProc=BEGIN
marginChanged←FALSE;
EnumerateChannels[MakeOffsets];
IF ~chipmonk THEN EnumerateChannels[ShowCrossesX];
EnumerateChannels[CheckCrosses];
RETURN[IF marginChanged THEN 1 ELSE -1];
END;

MakeOffsets:PROCEDURE[rect:RectanglePtr]=BEGIN
EnumerateConns[rect,InitConn];
EnumerateConns[rect,OffsetSources];
OffsetJogs[rect,-1];
OffsetJogs[rect,bigRun];
SetRunOffsets[rect];
EnumerateConns[rect,FixJogColor];
EnumerateConns[rect,SetX];
EnumerateConns[rect,CheckMargins];
END;

InitConn:PROCEDURE[rect:RectanglePtr,con:ConnPtr]=BEGIN
con.startKind←FigureKind[rect,con,con.start];
con.endKind←FigureKind[rect,con,con.end];
IF con.offset#noOffset THEN Error;
IF con.lambdaX#-1 THEN Error;
END;

FigureKind:PROCEDURE[rect:RectanglePtr,con:ConnPtr,where:RunNo]
  RETURNS[kind:ConnKind]=BEGIN
kind←none;
IF where=-1 OR where=bigRun THEN RETURN[edge];
FOR rl:RunListPtr←rect.runs, rl.t UNTIL rl=NIL DO
  run:RunPtr=rl.h;
  IF ~(con.circuit=run.circuit AND where=run.run) THEN LOOP;
  IF con.event IN [run.start..run.end) THEN kind←CombineKinds[kind,right];
  IF con.event IN (run.start..run.end] THEN kind←CombineKinds[kind,left];
  ENDLOOP;
IF kind=none THEN SELECT con.event FROM
     -1=>kind←left; bigRun=>kind←right; ENDCASE=>Error;
END;

CombineKinds:PROCEDURE[a,b:ConnKind] RETURNS[ConnKind]=BEGIN
IF a=edge OR b=edge THEN {Error; RETURN[edge]};
RETURN[IF a=b OR a=none THEN b ELSE IF b=none THEN a ELSE tee]
END;

OffsetSources:PROCEDURE[rect:RectanglePtr,c:ConnPtr]=BEGIN
runMax:INTEGER=rect.sizeC.y;
c2,c3:ConnPtr←NIL;
tt:ConnPtr=IF c.eventPtr=NIL OR c.eventPtr.opposite=NIL THEN NIL
           ELSE c.eventPtr.opposite.conn;
IF c.offset#noOffset THEN RETURN;
IF c.start=-1
THEN IF c.end=bigRun THEN {c.offset←0; RETURN} ELSE {c2←c; c3←tt}
ELSE IF c.end=bigRun THEN {c3←c; c2←tt} ELSE RETURN;
IF c2#NIL THEN c2.offset←0;
IF c3#NIL THEN c3.offset←0;
IF c2=c3 THEN Error;
IF c2=NIL OR c3=NIL OR c3.start>c2.end THEN RETURN;
BEGIN
r2:RunNo=IF c2=NIL THEN 0 ELSE IF c2=c3 THEN runMax ELSE c2.end;
r3:RunNo=IF c3=NIL THEN runMax ELSE c3.start;
r2Gain:RunNo←r2+1;
r3Gain:RunNo←runMax-r3;
index:INTEGER=(SELECT c2.endKind FROM left=>0,tee=>3,right=>6, ENDCASE=>ERROR)
    +(SELECT c3.startKind FROM left=>0,tee=>1,right=>2, ENDCASE=>ERROR);
FOR rl:RunListPtr←rect.runs,rl.t UNTIL rl=NIL DO
  r:RunPtr=rl.h;
  IF c.event NOT IN (r.start..r.end) THEN LOOP;
  IF r.run<r2 THEN r2Gain←MIN[r2Gain,r2-r.run];
  IF r.run>r3 THEN r3Gain←MIN[r3Gain,r.run-r3];
  ENDLOOP;
SELECT index FROM
    0=>IF r2Gain>r3Gain THEN c3.offset←-1 ELSE c2.offset←-1;
    1=>c3.offset←1;
    2=>c3.offset←1;
    3=>c2.offset←1;
    4=>c2.offset←1;--don't care
    5=>c2.offset←-1;
    6=>c2.offset←1;
    7=>c3.offset←-1;
    8=>IF r2Gain>r3Gain THEN c3.offset←1 ELSE c2.offset←1;
    ENDCASE=>Error;
END; END;

OffsetJogs:PROCEDURE[rect:RectanglePtr,event:INTEGER]=BEGIN
FOR cl:ConnListPtr←rect.conns, cl.t UNTIL cl=NIL DO
  con:ConnPtr=cl.h;
  IF con.event#event OR con.offset#noOffset THEN LOOP;
  FOR j:INTEGER IN [0..1] UNTIL con.offset#noOffset DO
  this:INTEGER←0;
  preferR,legalR,emptyR:INTEGER←noOffset;
  preferL,legalL,emptyL:INTEGER←-noOffset;
  SELECT con.startKind FROM left,right=>NULL; ENDCASE=>Error;
  SELECT con.endKind FROM left,right=>NULL; ENDCASE=>Error;
  FOR w:ConnListPtr←rect.conns, w.t UNTIL w=NIL DO
    con2:ConnPtr=w.h;
    plus:BOOLEAN←FALSE;
    left,right:BOOLEAN←FALSE;
    off:Lambda=con2.offset;
    IF con2.event#event OR con2.circuit=con.circuit OR con2.offset=noOffset
      THEN LOOP;
    IF con2.start>con.end OR con.start>con2.end THEN LOOP;
    IF con2.end=con.start THEN
      {IF con.startKind=right THEN right←TRUE ELSE left←TRUE};
    IF con2.start=con.end THEN
      {IF con.endKind=right THEN right←TRUE ELSE left←TRUE};
    SELECT con2.end-con.end FROM
      0 =>SELECT con2.start-con.start FROM
         0=>left←right←TRUE;
         ENDCASE=>IF con.endKind=right THEN {right←plus←TRUE} ELSE left←TRUE;
      >0 =>SELECT con2.start-con.start FROM
         0=>IF con.startKind=right THEN {right←plus←TRUE} ELSE left←TRUE;
         >0=>plus←FALSE;
         ENDCASE=>plus←off+1<=preferL;
      ENDCASE=>SELECT con2.start-con.start FROM
         0=>IF con.startKind=right THEN {right←plus←TRUE} ELSE left←TRUE;
         >0=>plus←off+1<=preferL;
         ENDCASE=>plus←TRUE;
    IF plus THEN preferL←MAX[off+1,preferL] ELSE preferR←MIN[off-1,preferR];
    emptyL←MAX[emptyL,off+1];
    emptyR←MIN[emptyR,off-1];
    IF right THEN {IF legalL#-noOffset THEN Error ELSE legalL←off+1};
    IF left  THEN {IF legalR# noOffset THEN Error ELSE legalR←off-1};
    ENDLOOP;
  IF legalL#-noOffset AND legalR#noOffset THEN {SplitConn[rect,event,cl,j]; LOOP};
  this←IF legalL#-noOffset OR legalR=noOffset AND (preferL#-noOffset OR preferR=noOffset)
      THEN MAX[0,emptyL] ELSE MIN[0,emptyR];
  IF this NOT IN [legalL..legalR] OR this IN (emptyR..emptyL) THEN Error;
  con.offset←this;
  IF this=noOffset OR this=-noOffset THEN Error;
  IF event=-1 AND this<-1 THEN Error;
  IF event=-1 AND this<0 THEN MoveConns[rect,event,1];
  IF event=bigRun AND this>-1 THEN MoveConns[rect,event,-1];
  IF event=bigRun AND this>0 THEN MoveConns[rect,event,-1];
  ENDLOOP; ENDLOOP;
END;

MoveConns:PROCEDURE[rect:RectanglePtr,event,delta:INTEGER]=BEGIN
Sub:PROCEDURE[rect:RectanglePtr,c:ConnPtr]=
  {IF c.event=event AND c.offset#noOffset THEN c.offset←c.offset+delta};
EnumerateConns[rect,Sub];
END;

SplitConn:PROCEDURE[rect:RectanglePtr,event:EventNo,cl:ConnListPtr,j:INTEGER]=
BEGIN
con:ConnPtr=cl.h;
yy:RunNo=FindEmptyPlace[rect,event,con.start];
IF yy=-1 OR j=1 THEN {Error; con.offset←0; RETURN};
BEGIN
t:BOOLEAN=IF con.startRun=NIL THEN (event=-1)
  ELSE IF con.endRun=NIL THEN (event#bigRun)
  ELSE con.startRun.start<con.endRun.end;
con3:ConnPtr=AllocateConn[];
run3:RunPtr=AllocateRun[];
listC:ConnListPtr=AllocateList[];
listR:RunListPtr=AllocateList[];
listC↑←[con3,cl.t];
cl.t←listC;
listR↑←[run3,rect.runs];
rect.runs←listR;
con3↑←con↑;
con.endRun←con3.startRun←run3;
run3↑←[con.circuit,yy,con.event,con.event,0,0,rect];
IF t THEN {run3.startConn←con;  run3.endConn←con3}
     ELSE {run3.startConn←con3; run3.endConn←con};
con.end←yy;
con.endKind←IF con.startKind=left THEN right ELSE left;
IF con.start>con.end THEN SwapEnds[con];
con3.start←yy;
con3.startKind←IF con3.endKind=left THEN right ELSE left;
IF con3.start>con3.end THEN SwapEnds[con3];
END;
END;

FindEmptyPlace:PROCEDURE[rect:RectanglePtr,event:EventNo,near:RunNo]
  RETURNS[RunNo]=BEGIN
Try:PROCEDURE[where:RunNo] RETURNS[BOOLEAN]=BEGIN
  IF where NOT IN [0..rect.sizeC.y) THEN RETURN[FALSE];
  FOR rl:RunListPtr←rect.runs,rl.t UNTIL rl=NIL DO
    r:RunPtr=rl.h;
    IF r.run=where AND event IN [r.start..r.end] THEN RETURN[FALSE];
    ENDLOOP;
  RETURN[TRUE];
  END;
FOR i:INTEGER IN [0..rect.sizeC.y) DO
  IF Try[near+i] THEN RETURN[near+i];
  IF Try[near-i] THEN RETURN[near-i];
  ENDLOOP;
RETURN[-1];
END;


SwapEnds:PROCEDURE[c:ConnPtr]=BEGIN
{t:RunNo=c.start; c.start←c.end; c.end←t};
{q:ConnKind=c.startKind; c.startKind←c.endKind; c.endKind←q};
END;

SetRunOffsets:PROCEDURE[rect:RectanglePtr]=BEGIN
FOR rl:RunListPtr←rect.runs,rl.t UNTIL rl=NIL DO
  run:RunPtr=rl.h;
  run.startOff←run.endOff←0;
-- use start and end runs
  FOR cl:ConnListPtr←rect.conns,cl.t UNTIL cl=NIL DO
    con:ConnPtr=cl.h;
    IF con.circuit#run.circuit THEN LOOP;
    IF run.run#con.start AND run.run#con.end
      AND (con.event=-1 OR con.event=bigRun) THEN LOOP;
    IF con.event#run.start AND con.event#run.end THEN LOOP;
    {end:BOOLEAN=IF run.start#run.end THEN run.end=con.event ELSE
      (run.run=con.start AND con.startKind=left
       OR run.run=con.end   AND con.endKind=left);
    IF end THEN run.endOff←con.offset ELSE run.startOff←con.offset};
    ENDLOOP;
  ENDLOOP;
END;

FixJogColor:PROCEDURE[rect:RectanglePtr,con:ConnPtr]=BEGIN
event:EventPtr=con.eventPtr;
eventNo:INTEGER=con.event;
con.level←blue;
con.closeS←con.closeE←FALSE;
IF con.start=-1 AND con.end=bigRun AND
  (event.level=red OR event.opposite.level=red)
   THEN {con.level←red; RETURN};
IF event#NIL AND event.level=red THEN {con.level←red; RETURN};
FOR rl:RunListPtr←rect.runs,rl.t UNTIL rl=NIL DO
  run:RunPtr=rl.h;
  IF run.circuit=con.circuit THEN LOOP;
  IF run.run NOT IN [con.start..con.end] THEN LOOP;
  IF eventNo NOT IN [run.start..run.end] THEN LOOP;
  IF con.offset=0 THEN BEGIN
    IF eventNo= run.start AND con.offset<run.startOff THEN LOOP;
    IF eventNo= run.end AND con.offset>run.endOff THEN LOOP;
    END;
  con.level←red;
  IF con.start=-1 AND run.run=0 AND
    (event.where=bottom AND event.level=blue
    OR event.where=top AND event.opposite.level=blue)
    THEN con.closeS←TRUE;
  IF con.end=bigRun AND run.run>=rect.sizeC.y-1 AND
    (event.where=top AND event.level=blue
    OR event.where=bottom AND event.opposite.level=blue)
    THEN con.closeE←TRUE;
  ENDLOOP;
END;

CheckCrosses:PROCEDURE[rect:RectanglePtr]=BEGIN
FOR cl:ConnListPtr←rect.conns,cl.t UNTIL cl=NIL DO
  con:ConnPtr=cl.h;
  IF con.offset=noOffset OR con.offset=-noOffset THEN Error;
  ENDLOOP;
END;

ShowCrossesX:PROCEDURE[rect:RectanglePtr]=BEGIN
Store:PROCEDURE[c:CHARACTER,x:INTEGER]=BEGIN
  IF x NOT IN [0..line/2) THEN
    {x←x-limit+line-1; IF x NOT IN [line/2..line) THEN RETURN};
  IF c='r AND s[x]#' THEN c←'R;
  IF c='c THEN {IF s[x]='  THEN c←'b ELSE RETURN};
  s[x]←c;
  END;
runMax:INTEGER=rect.sizeC.y;
limit:CARDINAL=4+2*runMax;
line:CARDINAL=40;
limitE:CARDINAL=MAX[limit-1,line/2];
s:STRING←[line];
ShowLabel["CROSSES "];
ShowDecimal[rect.channelNo];
Return[];
FOR i:INTEGER IN [0..rect.sizeC.x] DO
  max:INTEGER←-noOffset;
  min:INTEGER←noOffset;
  FOR cl:ConnListPtr←rect.conns,cl.t UNTIL cl=NIL DO
    con:ConnPtr=cl.h;
    IF con.event#i THEN LOOP;
    max←MAX[max,con.offset];
    min←MIN[min,con.offset];
    ENDLOOP;
  FOR z:INTEGER IN [min..max] DO
    Return[];
    Clear[s];
    IF z=0 THEN FOR t:EventListPtr←rect.events, t.t UNTIL t=NIL DO
      e:EventPtr←t.h;
      IF i # e.index THEN LOOP;
      IF e.where=top THEN s[line-1]←ShowCircuit[e.circuit];
      IF e.where=bottom THEN s[0]←ShowCircuit[e.circuit];
      ENDLOOP;
    FOR cl:ConnListPtr←rect.conns,cl.t UNTIL cl=NIL DO
      con:ConnPtr=cl.h;
      stop:INTEGER=IF con.end=bigRun THEN limitE ELSE 2+2*con.end;
      IF con.event#i OR con.offset#z THEN LOOP;
      FOR j:[0..10000) IN [2+2*con.start..stop]
        DO IF ~(j=0 OR j=limit) THEN Store['b,j]; ENDLOOP;
      ENDLOOP;
    FOR cl:ConnListPtr←rect.conns,cl.t UNTIL cl=NIL DO
      con:ConnPtr=cl.h;
      IF con.event#i OR con.offset=z THEN LOOP;
      IF con.startKind=tee OR con.startKind=right AND con.offset<z
        OR con.startKind=left AND con.offset>z THEN Store['b,2+2*con.start];
      IF con.endKind=tee OR con.endKind=right AND con.offset<z
        OR con.endKind=left AND con.offset>z THEN Store['b,2+2*con.end];
      ENDLOOP;
    FOR rl:RunListPtr←rect.runs,rl.t UNTIL rl=NIL DO
      r:RunPtr=rl.h; IF i IN (r.start..r.end) THEN Store['c,2+2*r.run];
      ENDLOOP;
    ShowString[s];
    ENDLOOP;
  Clear[s];
  FOR rl:RunListPtr←rect.runs,rl.t UNTIL rl=NIL DO
    r:RunPtr=rl.h;
    IF i IN [r.start..r.end) THEN Store['b,2+2*r.run];
    ENDLOOP;
  FOR zz:INTEGER IN [0..3) DO Return[]; ShowString[s]; ENDLOOP;
  ENDLOOP;
END;

Convert:PROCEDURE[x:ConnKind] RETURNS[CHARACTER]=BEGIN
RETURN[SELECT x FROM tee=>'t, right=>'r, left=>'l, edge=>'e, none=>'x, ENDCASE=>'z];
END;

SetX:PROCEDURE[rect:RectanglePtr,c1:ConnPtr]=BEGIN
span:Lambda=IF rect.orient=hor THEN rect.sizeL.x ELSE rect.sizeL.y;
ok1:PROCEDURE[c:ConnPtr,x:Lambda] RETURNS[BOOLEAN]=BEGIN
  e1:EventPtr=c.eventPtr;
  e2:EventPtr=IF e1=NIL THEN NIL ELSE e1.opposite;
  IF e1=NIL THEN RETURN[TRUE];
  IF x NOT IN [0..span) THEN RETURN[FALSE];
  RETURN[(e1.next=NIL OR e1.next.offset>x+6)
   AND (e1.prev=NIL OR e1.prev.offset<x-6)
   AND (e2.next=NIL OR e2.next.offset>x+6 OR Decoupled[c,e2.next.conn])
   AND (e2.prev=NIL OR e2.prev.offset<x-6 OR Decoupled[c,e2.prev.conn])
    ];
  END;
IF c1.lambdaX#-1 THEN RETURN;
IF c1.event NOT IN [0..bigRun) THEN BEGIN
  IF c1.event<0 THEN c1.lambdaX←7*c1.offset;
  IF c1.event>=bigRun THEN c1.lambdaX←
    (IF rect.orient=hor THEN rect.sizeL.x ELSE rect.sizeL.y) + 7*c1.offset;
  RETURN;
  END;
BEGIN
e1:EventPtr=c1.eventPtr;
e2:EventPtr=e1.opposite;
IF e2=NIL THEN {c1.lambdaX←e1.offset; RETURN};
BEGIN
lSub:PROCEDURE[t:Lambda] RETURNS[b:BOOLEAN]=BEGIN
  b←ok1[c1,t] AND ok1[c2,t+del];
  IF b THEN {c1.lambdaX←t; c2.lambdaX←t+del};
  END;
c2:ConnPtr=e2.conn;
del:Lambda=7*(c2.offset-c1.offset);
x1:Lambda=e1.offset;
x2:Lambda=e2.offset;
xmin:Lambda=MIN[x1,x2];
xmax:Lambda=MAX[x1,x2];
IF Decoupled[c1,c2] THEN BEGIN
  IF ok1[c1,x1] THEN
    {c1.lambdaX←x1; IF ok1[c2,x2] THEN c2.lambdaX←x2;  RETURN};
  FOR t:INTEGER IN [x1-6..x1+6] DO
    IF ok1[c1,t] THEN {c1.lambdaX←t; RETURN};
    ENDLOOP;
  Error;
  RETURN;
  END;
IF c1.offset=0 THEN {IF lSub[x1] OR lSub[x2] THEN RETURN}
               ELSE {IF lSub[x2] OR lSub[x1] THEN RETURN};
FOR t:Lambda IN (xmin..xmax)   DO IF lSub[t] THEN RETURN; ENDLOOP;
FOR t:Lambda IN [xmin-6..xmin) DO IF lSub[t] THEN RETURN; ENDLOOP;
FOR t:Lambda IN (xmax..xmax+6] DO IF lSub[t] THEN RETURN; ENDLOOP;
END;
END;
END;

Decoupled:PROCEDURE [c1,c2:ConnPtr] RETURNS[BOOLEAN]=
{RETURN[c1.end<c2.start OR c2.end<c1.start]};

CheckMargins:PROCEDURE[rect:RectanglePtr,con:ConnPtr]=BEGIN
IF (con.start=-1) = (con.end=bigRun)
 OR con.eventPtr=NIL
 OR con.eventPtr.opposite=NIL
 OR con.lambdaX=con.eventPtr.offset THEN RETURN ELSE BEGIN
con2:ConnPtr=con.eventPtr.opposite.conn;
IF con.start=-1 AND con2.start=0 THEN BEGIN
  t:INTEGER←IF con.closeS THEN 9 ELSE 6;
  IF rect.orient=hor
  THEN {t←t-rect.levelers.s; IF rect.margins.s<t
           THEN {rect.margins.s←t; marginChanged←TRUE}}
  ELSE {t←t-rect.levelers.e; IF rect.margins.e<t
           THEN {rect.margins.e←t; marginChanged←TRUE}};
  END;
IF con.end=bigRun AND con2.end>=rect.sizeC.y-1 THEN BEGIN
  t:INTEGER←IF con.closeE THEN 9 ELSE 6;
  IF rect.orient=hor
  THEN {t←t-rect.levelers.n; IF rect.margins.n<t
           THEN {rect.margins.n←t; marginChanged←TRUE}}
  ELSE {t←t-rect.levelers.w; IF rect.margins.w<t
           THEN {rect.margins.w←t; marginChanged←TRUE}};
  END;
END; END;


END.