MODULE SPQuad;

IMPORT Fmt;

REVEAL 
  Quad = BRANDED REF 
    RECORD 
      enext: ARRAY [0..3] OF Quad;
      bnext: ARRAY [0..3] OF [0..3];
      data: ARRAY [0..3] OF REFANY;
      num: CARDINAL;
    END;
    
PROCEDURE Rot(a: Arc): Arc =
  BEGIN
    RETURN Arc{quad := a.quad, bits := (a.bits + 1) MOD 4};
  END Rot;
  
PROCEDURE Sym(a: Arc): Arc =
  BEGIN
    RETURN Arc{quad := a.quad, bits := (a.bits + 2) MOD 4};
  END Sym;
  
PROCEDURE Tor(a: Arc): Arc =
  BEGIN
    RETURN Arc{quad := a.quad, bits := (a.bits + 3) MOD 4};
  END Tor;

PROCEDURE Onext(a: Arc): Arc =
  BEGIN
    WITH s = a.bits DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := a.quad.bnext[s]
      }
    END
  END Onext;
  
PROCEDURE Rnext(a: Arc): Arc =
  BEGIN
    WITH s = (a.bits + 1) MOD 4 DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := (a.quad.bnext[s] + 3) MOD 4
      }
    END
  END Rnext;
  
PROCEDURE Dnext(a: Arc): Arc =
  BEGIN
    WITH s = (a.bits + 2) MOD 4 DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := (a.quad.bnext[s] + 2) MOD 4
      }
    END
  END Dnext;
  
PROCEDURE Lnext(a: Arc): Arc =
  BEGIN
    WITH s = (a.bits + 3) MOD 4 DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := (a.quad.bnext[s] + 1) MOD 4
      }
    END
  END Lnext;
  
PROCEDURE Oprev(a: Arc): Arc =
  BEGIN
    WITH s = (a.bits + 1) MOD 4 DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := (a.quad.bnext[s] + 1) MOD 4
      }
    END
  END Oprev;
  
PROCEDURE Rprev(a: Arc): Arc =
  BEGIN
    WITH s = (a.bits + 2) MOD 4 DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := a.quad.bnext[s]
      }
    END
  END Rprev;
  
PROCEDURE Dprev(a: Arc): Arc =
  BEGIN
    WITH s = (a.bits + 3) MOD 4 DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := (a.quad.bnext[s] + 3) MOD 4
      }
    END
  END Dprev;
  
PROCEDURE Lprev(a: Arc): Arc =
  BEGIN
    WITH s = a.bits MOD 4 DO
      RETURN Arc{
        quad := a.quad.enext[s],
        bits := (a.quad.bnext[s] + 2) MOD 4
      }
    END
  END Lprev;
  
PROCEDURE Odata (a: Arc): REFANY =
  BEGIN 
    RETURN a.quad.data[a.bits] 
  END Odata;
  
PROCEDURE Rdata (a: Arc): REFANY =
  BEGIN 
    RETURN a.quad.data[(a.bits + 1) MOD 4] 
  END Rdata;
  
PROCEDURE Ddata (a: Arc): REFANY =
  BEGIN 
    RETURN a.quad.data[(a.bits + 2) MOD 4] 
  END Ddata;
  
PROCEDURE Ldata (a: Arc): REFANY =
  BEGIN 
    RETURN a.quad.data[(a.bits + 3) MOD 4] 
  END Ldata;

PROCEDURE SetOdata (a: Arc; data: REFANY) =
  BEGIN 
    a.quad.data[a.bits] := data 
  END SetOdata;
  
PROCEDURE SetRdata (a: Arc; data: REFANY) =
  BEGIN 
    a.quad.data[(a.bits + 1) MOD 4] := data 
  END SetRdata;
  
PROCEDURE SetDdata (a: Arc; data: REFANY) =
  BEGIN 
    a.quad.data[(a.bits + 2) MOD 4] := data 
  END SetDdata;

PROCEDURE SetLdata (a: Arc; data: REFANY) =
  BEGIN 
    a.quad.data[(a.bits + 3) MOD 4] := data 
  END SetLdata;

VAR 
  quadCount: CARDINAL := 0;

PROCEDURE MakeEdge (): Arc =
  BEGIN
    WITH e = NEW(Quad) DO
      FOR i := 0 TO 3 DO e.enext[i] := e; e.data[i] := NIL END;
      e.bnext[0] := 0;
      e.bnext[1] := 3;
      e.bnext[2] := 2;
      e.bnext[3] := 1;
      e.num := quadCount; INC(quadCount);
      RETURN Arc{quad := e, bits := 0}
    END;
  END MakeEdge;

PROCEDURE Splice (a, b: Arc) =
  BEGIN
    WITH 
      c = Rot(Onext(a)),
      d = Rot(Onext(b))
    DO 
      WITH
        ta = Onext(a),
        tb = Onext(b)
      DO
        a.quad.enext[a.bits] := tb.quad;
        a.quad.bnext[a.bits] := tb.bits;
        b.quad.enext[b.bits] := ta.quad;
        b.quad.bnext[b.bits] := ta.bits;
      END;
      WITH
        tc = Onext(c),
        td = Onext(d)
      DO
        c.quad.enext[c.bits] := td.quad;
        c.quad.bnext[c.bits] := td.bits;
        d.quad.enext[d.bits] := tc.quad;
        d.quad.bnext[d.bits] := tc.bits;
      END;
    END;
  END Splice;

PROCEDURE NumberArcs(a: Arc): REF ARRAY OF Arc =

  VAR r: REF ARRAY OF Arc := NEW(REF ARRAY OF Arc, 2);
      nArcs: CARDINAL := 0;
  
  PROCEDURE Visited(a: Arc): BOOLEAN =
    BEGIN
      WITH n = 2*a.quad.num DO
        RETURN n < nArcs AND r[n].quad = a.quad
      END
    END Visited;
    
  PROCEDURE Visit(a: Arc) =
    BEGIN
      IF nArcs = NUMBER(r^) THEN 
        WITH t = NEW(REF ARRAY OF Arc, 2*nArcs) DO
          SUBARRAY(t^, 0, nArcs) := r^;
          r := t
        END
      END;
      r[nArcs] := a;
      r[nArcs + 1] := Sym(a);
      a.quad.num := nArcs DIV 2;
      nArcs := nArcs + 2
    END Visit;
  
  VAR nChecked: CARDINAL := 0;
  BEGIN
    Visit(a);
    WHILE nChecked < nArcs DO
      WITH b = Onext(r[nChecked]) DO
        IF NOT Visited(b) THEN Visit(b) END;
        nChecked := nChecked + 1
      END
    END;
    WITH t = NEW(REF ARRAY OF Arc, nArcs) DO
      t^ := SUBARRAY(r^, 0, nArcs);
      RETURN t
    END
  END NumberArcs;

PROCEDURE CollectArcs(a: Arc; VAR arc: ARRAY OF Arc) =

  VAR seen: REF ARRAY OF Arc := NEW(REF ARRAY OF Arc, 2);
      nSeen: CARDINAL := 0;
  
  PROCEDURE Visited(a: Arc): BOOLEAN = 
    BEGIN
      RETURN arc[2*a.quad.num].quad = a.quad
    END Visited;
  
  PROCEDURE Visit(a: Arc) =
    BEGIN
      WITH num = a.quad.num DO
        arc[2*num] := a;
        arc[2*num+1] := Sym(a)
      END;
      IF nSeen = NUMBER(seen^) THEN 
        WITH t = NEW(REF ARRAY OF Arc, 2*nSeen) DO
          SUBARRAY(t^, 0, nSeen) := seen^;
          seen := t
        END
      END;
      seen[nSeen] := a;
      nSeen := nSeen + 1
    END Visit;
  
  VAR nChecked: CARDINAL := 0;
  BEGIN
    FOR i := 0 TO LAST(arc) DO arc[i] := NullArc END;
    Visit(a);
    WHILE nChecked < nSeen DO
      WITH b = Onext(seen[nChecked]) DO
        IF NOT Visited(b) THEN Visit(b) END;
      END;
      WITH b = Onext(Sym(seen[nChecked])) DO
        IF NOT Visited(b) THEN Visit(b) END;
      END;
      nChecked := nChecked + 1
    END;
  END CollectArcs;

PROCEDURE EdgeNum(a: Arc): CARDINAL =
  BEGIN
    RETURN a.quad.num
  END EdgeNum;

PROCEDURE SetEdgeNum(a: Arc; num: CARDINAL) =
  BEGIN
    a.quad.num := num
  END SetEdgeNum;

PROCEDURE ToText(a: Arc): TEXT =
  BEGIN
    RETURN Fmt.Int(a.quad.num) & ":" & Fmt.Int(a.bits)
  END ToText;

BEGIN
END SPQuad.