Return to common_faces_of_polytope.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/common_faces_of_polytope.adb, Revision 1.1.1.1

1.1       maekawa     1: with Standard_Integer_Vectors;           use Standard_Integer_Vectors;
                      2: with Standard_Integer_VecVecs;           use Standard_Integer_VecVecs;
                      3:
                      4: package body Common_Faces_of_Polytope is
                      5:
                      6:   function Have_Common_Point ( l : List; v : VecVec ) return boolean is
                      7:
                      8:   -- DESCRIPTION :
                      9:   --   Returns true if at least one point in v belongs to the list l.
                     10:
                     11:   begin
                     12:     for i in v'range loop
                     13:       if Is_In(l,v(i).all)
                     14:        then return true;
                     15:       end if;
                     16:     end loop;
                     17:     return false;
                     18:   end Have_Common_Point;
                     19:
                     20:   function Is_Neighbor1 ( l : List; fc : Face ) return boolean is
                     21:   begin
                     22:     return Have_Common_Point(l,fc.all);
                     23:   end Is_Neighbor1;
                     24:
                     25:   function Is_Neighbor ( l : List; fc : Face ) return boolean is
                     26:
                     27:     cntnotin : natural := 0;
                     28:        -- counts the points in the face fc that are not in the list l
                     29:
                     30:   begin
                     31:     for i in fc'range loop
                     32:       if not Is_In(l,fc(i).all)
                     33:        then cntnotin := cntnotin + 1;
                     34:             if cntnotin > 1
                     35:              then return false;
                     36:             end if;
                     37:       end if;
                     38:     end loop;
                     39:     return true;
                     40:   end Is_Neighbor;
                     41:
                     42:   function Neighboring_Faces ( mic : Mixed_Cell; fs : Faces; i : natural )
                     43:                              return Faces is
                     44:
                     45:     tmp : Faces := fs;
                     46:     res,res_last : Faces;
                     47:
                     48:   begin
                     49:     while not Is_Null(tmp) loop
                     50:       declare
                     51:         fc : Face := Head_Of(tmp);
                     52:       begin
                     53:         if Is_Neighbor(mic.pts(i),fc)
                     54:          then Append(res,res_last,fc);
                     55:         end if;
                     56:         tmp := Tail_Of(tmp);
                     57:       end;
                     58:     end loop;
                     59:     return res;
                     60:   end Neighboring_Faces;
                     61:
                     62:   function Neighboring_Faces ( mic : Mixed_Cell; afs : Array_of_Faces )
                     63:                              return Array_of_Faces is
                     64:
                     65:     res : Array_of_Faces(afs'range);
                     66:
                     67:   begin
                     68:     for i in res'range loop
                     69:       res(i) := Neighboring_Faces(mic,afs(i),i);
                     70:     end loop;
                     71:     return res;
                     72:   end Neighboring_Faces;
                     73:
                     74: end Common_Faces_of_Polytope;