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