Return to face_structures.adb CVS log

Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Dynlift

Import the second public release of PHCpack.

OKed by Jan Verschelde.

package body Face_Structures is

-- CONSTRUCTOR :

  procedure Compute_New_Faces
                 ( fs : in out Face_Structure; k,n : in natural;
                   point : in out Link_to_Vector; newfs : out Faces ) is

    procedure Append ( fc : in VecVec ) is

      f : Face;

    begin
      f.points := Shallow_Create(fc);
      Append(res,res_last,f);
    end Append;
    procedure EnumLis is new Enumerate_Faces_in_List(Append);
    procedure EnumTri is new Enumerate_Faces_in_Triangulation(Append);

  begin
   -- COMPUTE THE NEW FACES AND UPDATE fs :
    if Is_Null(fs.t)
     then
       if Length_Of(fs.l) >= n
        then
          fs.t := Initial_Triangulation(n,fs.l,point);
          if Is_Null(fs.t)
           then EnumLis(fs.l,point,k);
           else EnumTri(fs.t,point,k);
          end if;
        else
          EnumLis(fs.l,point,k);
       end if;
     else
       declare
         newt : Triangulation;
       begin
         point(point'last) := Next_Lifting(fs.t,point.all);
         Update(fs.t,point,newt);
         Enumtri(newt,point,k);
       end;
    end if;
    Append(fs.l,fs.last,point);
    newfs := res;
  end Compute_New_Faces;

-- FLATTENING :

  procedure Flatten ( f : in out Face ) is
  begin
    if f.normal /= null
     then f.normal.all := (f.normal'range => 0);
          f.normal(f.normal'last) := 1;
    end if;
    Flatten(f.points);
  end Flatten;

  procedure Flatten ( fs : in out Faces ) is

    tmp : Faces := fs;
    f : Face;

  begin
    while not Is_Null(tmp) loop
      f := Head_Of(tmp);
      Flatten(f);
      Set_Head(tmp,f);
      tmp := Tail_Of(tmp);
    end loop;
  end Flatten;

  procedure Flatten ( fs : in out Face_Structure ) is
  begin
    Flatten(fs.l); Flatten(fs.t); Flatten(fs.f);
  end Flatten;

  procedure Flatten ( fs : in out Array_of_Face_Structures ) is
  begin
    for i in fs'range loop
      Flatten(fs(i));
    end loop;
  end Flatten;

-- SELECTORS :

  function Is_In ( fs : Face_Structure; point : vector ) return boolean is
  begin
    if Is_Null(fs.t)
     then return Is_In(fs.l,point);
     else return Is_In(fs.t,point);
    end if;
  end Is_In;

-- DESTRUCTORS :

  procedure Deep_Clear ( fs : in out Face_Structure ) is
  begin
    Deep_Clear(fs.l); Deep_Clear(fs.f); Deep_Clear(fs.t);
  end Deep_Clear;

  procedure Shallow_Clear ( fs : in out Face_Structure ) is
  begin
    Shallow_Clear(fs.l); Shallow_Clear(fs.f); Shallow_Clear(fs.t);
  end Shallow_Clear;

  procedure Deep_Clear ( fs : in out Array_of_Face_Structures ) is
  begin
    for i in fs'range loop
      Deep_Clear(fs(i));
    end loop;
  end Deep_Clear;

  procedure Shallow_Clear ( fs : in out Array_of_Face_Structures );
  begin
    for i in fs'range loop
      Shallow_Clear(fs(i));
    end loop;
  end Shallow_Clear;

end Face_Structures;