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;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>