--routePaths1.mesa

DIRECTORY  RouteDefs;

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

Error:SIGNAL=CODE;

allPaths:PUBLIC PathListPtr←NIL;

ReducePath:PUBLIC PROCEDURE={WHILE Reduce[allPaths.h,x] DO ENDLOOP};

Reduce:PUBLIC PROCEDURE[path:PathPtr,s:Side] RETURNS[BOOLEAN]=BEGIN
IF s#n AND path.n#NIL AND Simplify[path,n] THEN RETURN[TRUE];
IF s#s AND path.s#NIL AND Simplify[path,s] THEN RETURN[TRUE];
IF s#e AND path.e#NIL AND Simplify[path,e] THEN RETURN[TRUE];
IF s#w AND path.w#NIL AND Simplify[path,w] THEN RETURN[TRUE];
IF s#n AND path.n#NIL AND Reduce[path.n,s] THEN RETURN[TRUE];
IF s#s AND path.s#NIL AND Reduce[path.s,n] THEN RETURN[TRUE];
IF s#e AND path.e#NIL AND Reduce[path.e,w] THEN RETURN[TRUE];
IF s#w AND path.w#NIL AND Reduce[path.w,e] THEN RETURN[TRUE];
RETURN[FALSE];
END;

Simplify:PROCEDURE[a:PathPtr,d:Side] RETURNS[BOOLEAN]=BEGIN
b:PathPtr=SELECT d FROM n=>a.n, s=>a.s, e=>a.e, ENDCASE=>a.w;
IF b.index=NIL AND (b.s=NIL OR d=n) AND (b.n=NIL OR d=s)
   AND (b.e=NIL OR d=w) AND (b.w=NIL OR d=e)
   THEN {SELECT d FROM n=>a.n←NIL; s=>a.s←NIL; e=>a.e←NIL; ENDCASE=>a.w←NIL;
      GetRidOfPath[b]; RETURN[TRUE]};
IF Same[a,b] THEN BEGIN
  ver:BOOLEAN=d=n OR d=s;
  t:BOOLEAN←IF ver
    THEN (a.e=NIL OR b.e=NIL) AND (a.w=NIL OR b.w=NIL)
    ELSE (a.n=NIL OR b.n=NIL) AND (a.s=NIL OR b.s=NIL);
  IF t THEN RETURN[Fixit1[a,b,d]];
  IF ver AND (a.e#NIL AND b.e#NIL) AND Same[a.e,b.e] THEN BEGIN
    IF (a.w=NIL OR b.w=NIL) AND TtN[b,b.e] AND TtS[a,a.e]
      AND TtN[a,a.e] AND TtS[b,b.e] AND Fixit2[a,b,e] THEN RETURN[TRUE];
    IF d=n
    THEN  {IF ~Same[a,a.e] AND a.e.n=NIL AND b.e.s=NIL
          THEN {a.e.n←b.e; b.e.s←a.e; b.e.w←NIL; b.e←NIL; RETURN[TRUE]}}
    ELSE  {IF ~Same[a,a.e] AND a.e.s=NIL AND b.e.n=NIL
          THEN {a.e.s←b.e; b.e.n←a.e; b.e.w←NIL; b.e←NIL; RETURN[TRUE]}};
    END;
  IF ver AND (a.w#NIL AND b.w#NIL) AND Same[a.w,b.w] THEN BEGIN
    IF (a.e=NIL OR b.e=NIL) AND TtN[b,b.w] AND TtS[a,a.w]
      AND TtN[a,a.w] AND TtS[b,b.w] AND Fixit2[a,b,w] THEN RETURN[TRUE];
    IF d=n
    THEN  {IF ~Same[a,a.w] AND a.w.n=NIL AND b.w.s=NIL
          THEN {a.w.n←b.w; b.w.s←a.w; b.w.e←NIL; b.w←NIL; RETURN[TRUE]}}
    ELSE  {IF ~Same[a,a.w] AND a.w.s=NIL AND b.w.n=NIL
          THEN {a.w.s←b.w; b.w.n←a.w; b.w.e←NIL; b.w←NIL; RETURN[TRUE]}};
    END;
  IF ~ver AND (a.n#NIL AND b.n#NIL) AND Same[a.n,b.n] THEN BEGIN
    IF (a.s=NIL OR b.s=NIL) AND TtW[b,b.n] AND TtW[a,a.n]
      AND TtE[a,a.n] AND TtE[b,b.n] AND Fixit2[a,b,n] THEN RETURN[TRUE];
    IF d=e
    THEN  {IF ~Same[a,a.n] AND a.n.e=NIL AND b.n.w=NIL
          THEN {a.n.e←b.n; b.n.w←a.n; b.n.s←NIL; b.n←NIL; RETURN[TRUE]}}
    ELSE  {IF ~Same[a,a.n] AND a.n.w=NIL AND b.n.e=NIL
          THEN {a.n.w←b.n; b.n.e←a.n; b.n.s←NIL; b.n←NIL; RETURN[TRUE]}};
    END;
  IF ~ver AND (a.s#NIL AND b.s#NIL) AND Same[a.s,b.s] THEN BEGIN
    IF (a.n=NIL OR b.n=NIL) AND TtW[b,b.s] AND TtW[a,a.s]
      AND TtE[a,a.s] AND TtE[b,b.s] AND Fixit2[a,b,s] THEN RETURN[TRUE];
    IF d=e
    THEN  {IF ~Same[a,a.s] AND a.s.e=NIL AND b.s.w=NIL
          THEN {a.s.e←b.s; b.s.w←a.s; b.s.n←NIL; b.s←NIL; RETURN[TRUE]}}
    ELSE  {IF ~Same[a,a.s] AND a.s.w=NIL AND b.s.e=NIL
          THEN {a.s.w←b.s; b.s.e←a.s; b.s.n←NIL; b.s←NIL; RETURN[TRUE]}};
    END;
  END;
RETURN[FALSE];
END;

TtS:PROCEDURE[m,n:PathPtr] RETURNS[BOOLEAN]=BEGIN
IF m.s=NIL AND n.s=NIL THEN RETURN[TRUE];
IF m.s#NIL AND n.s#NIL THEN RETURN[FALSE];
RETURN[~(m.s#NIL AND m.s.index#NIL OR n.s#NIL AND n.s.index#NIL)
    OR Same[m,n]];
END;

TtN:PROCEDURE[m,n:PathPtr] RETURNS[BOOLEAN]=BEGIN
IF m.n=NIL AND n.n=NIL THEN RETURN[TRUE];
IF m.n#NIL AND n.n#NIL THEN RETURN[FALSE];
RETURN[~(m.n#NIL AND m.n.index#NIL OR n.n#NIL AND n.n.index#NIL)
    OR Same[m,n]];
END;

TtW:PROCEDURE[m,n:PathPtr] RETURNS[BOOLEAN]=BEGIN
IF m.w=NIL AND n.w=NIL THEN RETURN[TRUE];
IF m.w#NIL AND n.w#NIL THEN RETURN[FALSE];
RETURN[~(m.w#NIL AND m.w.index#NIL OR n.w#NIL AND n.w.index#NIL)
    OR Same[m,n]];
END;

TtE:PROCEDURE[m,n:PathPtr] RETURNS[BOOLEAN]=BEGIN
IF m.e=NIL AND n.e=NIL THEN RETURN[TRUE];
IF m.e#NIL AND n.e#NIL THEN RETURN[FALSE];
RETURN[~(m.e#NIL AND m.e.index#NIL OR n.e#NIL AND n.e.index#NIL)
    OR Same[m,n]];
END;

Same:PROCEDURE[a,b:PathPtr] RETURNS[BOOLEAN]=BEGIN
RETURN[a.channel=b.channel AND a.inter=b.inter AND a.index=NIL AND b.index=NIL];
END;

Fixit1:PROCEDURE[path,new:PathPtr,d:Side]RETURNS[BOOLEAN]=BEGIN
SELECT d FROM
  n=>path.n←new.s←NIL; s=>path.s←new.n←NIL;
  e=>path.e←new.w←NIL; w=>path.w←new.e←NIL;
  ENDCASE;
IF new.n#NIL THEN {path.n←new.n; path.n.s←path};
IF new.s#NIL THEN {path.s←new.s; path.s.n←path};
IF new.e#NIL THEN {path.e←new.e; path.e.w←path};
IF new.w#NIL THEN {path.w←new.w; path.w.e←path};
GetRidOfPath[new];
RETURN[TRUE];
END;

Fixit2:PROCEDURE[a,b:PathPtr,d:Side]RETURNS[BOOLEAN]=BEGIN
i,j:PathPtr;
SELECT d FROM
  e=>{i←a.e; j←b.e; i.w←j.w←NIL}; 
  w=>{i←a.w; j←b.w; i.e←j.e←NIL}; 
  n=>{i←a.n; j←b.n; i.s←j.s←NIL}; 
  s=>{i←a.s; j←b.s; i.n←j.n←NIL}; 
  ENDCASE=>Error;
SELECT b FROM
  a.s,a.n=>{IF d=w THEN {i.e←a.e; IF i.e#NIL THEN i.e.w←i;
                         j.e←b.e; IF j.e#NIL THEN j.e.w←j}
                   ELSE {i.w←a.w; IF i.w#NIL THEN i.w.e←i;
                         j.w←b.w; IF j.w#NIL THEN j.w.e←j}};
  ENDCASE=>{IF d=n THEN {i.s←a.s; IF i.s#NIL THEN i.s.n←i;
                         j.s←b.s; IF j.s#NIL THEN j.s.n←j}
                   ELSE {i.n←a.n; IF i.n#NIL THEN i.n.s←i;
                         j.n←b.n; IF j.n#NIL THEN j.n.s←j}};
SELECT b FROM
  a.s=>{IF i.s#NIL OR j.n#NIL THEN Error;
       i.s←j; j.n←i;
       IF i.n=NIL THEN i.n←a.n;
       IF i.n#NIL THEN i.n.s←i;
       IF j.s=NIL THEN j.s←b.s;
       IF j.s#NIL THEN j.s.n←j};
  a.n=>{IF i.n#NIL OR j.s#NIL THEN Error;
       i.n←j; j.s←i;
       IF i.s=NIL THEN i.s←a.s;
       IF i.s#NIL THEN i.s.n←i;
       IF j.n=NIL THEN j.n←b.n;
       IF j.n#NIL THEN j.n.s←j};
  a.e=>{IF i.e#NIL OR j.w#NIL THEN Error;
       i.e←j; j.w←i;
       IF i.w=NIL THEN i.w←a.w;
       IF i.w#NIL THEN i.w.e←i;
       IF j.e=NIL THEN j.e←b.e;
       IF j.e#NIL THEN j.e.w←j};
  a.w=>{IF i.w#NIL OR j.e#NIL THEN Error;
       i.w←j; j.e←i;
       IF i.e=NIL THEN i.e←a.e;
       IF i.e#NIL THEN i.e.w←i;
       IF j.w=NIL THEN j.w←b.w;
       IF j.w#NIL THEN j.w.e←j};
  ENDCASE;
i.started←j.started←FALSE;
a.w←a.e←a.n←a.s←b.w←b.e←b.n←b.s←NIL;
GetRidOfPath[a];
GetRidOfPath[b];
RETURN[TRUE];
END;

GetRidOfPath:PROCEDURE[path:PathPtr]=BEGIN
back:PathListPtr←NIL;
FOR pl:PathListPtr←allPaths, pl.t UNTIL pl=NIL DO
  IF pl.h=path THEN BEGIN
    IF back=NIL THEN allPaths←pl.t ELSE back.t←pl.t;
    FreeList[pl];
    FreePath[path];
    RETURN;
    END;
  back←pl;
  ENDLOOP;
Error;  
END;

END.