MODULE Face;

IMPORT Vertex, Cell;

TYPE 
  CC = Cell.Corners;
  CT = Cell.CornerTags;

PROCEDURE Copy(READONLY face: List; extra: CARDINAL := 0): REF List =
  BEGIN
    WITH n = NUMBER(face), r = NEW(REF List, n + extra) DO
      SUBARRAY(r^, 0, n) := face;
      RETURN r
    END
  END Copy;

PROCEDURE GetFreeFaces(READONLY cell: Cell.List): REF List =
  VAR nf: CARDINAL := 0;
  BEGIN
    WITH
      nc = NUMBER(cell),
      face = NEW(REF List, 4*nc)^
    DO

      PROCEDURE SortFace0(VAR v: Cell.Corners; VAR t: Cell.CornerTags) =
        (*
          Permutes "v[1..3]" cyclically so that "v[1]" is the smallest,
          carrying "t[1..3]" along. *)
        BEGIN
          FOR j := 0 TO 1 DO
            IF v[1] > v[2] OR v[1] > v[3] THEN
              VAR z := v[1]; BEGIN v[1] := v[2]; v[2] :=  v[3]; v[3] := z END;
              VAR z := t[1]; BEGIN t[1] := t[2]; t[2] :=  t[3]; t[3] := z END
            END;
          END
        END SortFace0;
      
      PROCEDURE AddFace(VALUE v: Cell.Corners; VALUE t: Cell.CornerTags; ck: Cell.Num) =
        BEGIN
          SortFace0(v, t);
          FOR i := 0 TO nf-1 DO 
            WITH f = face[i] DO
              IF f.v[0] = v[1] THEN
                IF  f.v[1] = v[3] AND f.v[2] = v[2] THEN
                  (* Face is not free, discard: *)
                  DEC(nf); IF i < nf THEN f := face[nf] END;
                  RETURN
                ELSIF f.v[1] = v[2] AND f.v[2] = v[3] THEN
                  (* Face is used twice in same topological orientation *)
                  <* ASSERT FALSE *>
                END
              END
            END
          END;
          (* Not seen yet: *)
          face[nf] := T{
            v := SUBARRAY(v,1,3), 
            t := SUBARRAY(t,1,3), 
            c := SideCells{ck, None},
            p := SidePoints{v[0], Vertex.None},
            s := SideTags{t[0], ' '}
          };
          INC(nf);
        END AddFace;
        
      BEGIN
        FOR ck := 0 TO LAST(cell) DO
          WITH c = cell[ck], v = c.v, t = c.t DO
            AddFace(v, t, ck);
            AddFace(CC{v[1], v[0], v[3], v[2]}, CT{t[1], t[0], t[3], t[2]}, ck);
            AddFace(CC{v[2], v[3], v[0], v[1]}, CT{t[2], t[3], t[0], t[1]}, ck);
            AddFace(CC{v[3], v[2], v[1], v[0]}, CT{t[3], t[2], t[1], t[0]}, ck);
          END
        END;
      END;
      
      WITH r = NEW(REF List, nf) DO
        r^ := SUBARRAY(face, 0, nf); RETURN r
      END
    END
  END GetFreeFaces;
  
PROCEDURE GetStar(READONLY face: List; v: Vertex.Num): REF ARRAY OF Vertex.Num =
  VAR deg: CARDINAL := 0;  (* Neighbor count *)
      nk: CARDINAL := 0;  (* Number of incident faces *)
  BEGIN
    <* ASSERT v # Vertex.None *>
    (* Count incident faces: *)
    deg := 0; 
    FOR k := 0 TO LAST(face) DO 
      WITH f = face[k] DO
        FOR k := 0 TO 2 DO 
          WITH u = f.v[k] DO
            <* ASSERT u # Vertex.None *>
            IF u = v THEN INC(deg) END
          END
        END
      END
    END;

    (* Collect them: *)
    WITH 
      s = NEW(REF ARRAY OF Vertex.Num, deg+1), star = s^,
      r = NEW(REF ARRAY OF Vertex.Num, deg+1), rats = r^
    DO
      (* Collect neighbors: *)
      star[0] := v; rats[0] := v;
      nk := 1;
      FOR k := 0 TO LAST(face) DO 
        WITH f = face[k] DO
          IF    f.v[0] = v THEN star[nk] := f.v[1]; rats[nk] := f.v[2]; INC(nk) 
          ELSIF f.v[1] = v THEN star[nk] := f.v[2]; rats[nk] := f.v[0]; INC(nk) 
          ELSIF f.v[2] = v THEN star[nk] := f.v[0]; rats[nk] := f.v[1]; INC(nk) 
          END
        END
      END;
      <* ASSERT nk = deg+1 *>

      (* Sort neighbors in connected order: *)
      FOR i := 2 TO deg-1 DO
        WITH u = star[i-1] DO
          VAR j := i; 
          BEGIN
            (* If this fails, the faces do not form ring around "v": *)
            WHILE j <= deg AND rats[j] # u DO INC(j) END;
            <* ASSERT j <= deg *>
            VAR z := star[i]; 
            BEGIN
              star[i] := star[j]; 
              star[j] := z; 
              rats[j] := rats[i]
            END;
          END;
        END
      END;
      <* ASSERT rats[1] = star[deg] *>
      RETURN s
    END
  END GetStar;
  
BEGIN
END Face.