Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Stalift/floating_mixed_subdivisions.adb, Revision 1.1.1.1
1.1 maekawa 1: with unchecked_deallocation;
2: with Standard_Floating_Matrices; use Standard_Floating_Matrices;
3: with Floating_Support_Functions; use Floating_Support_Functions;
4:
5: package body Floating_Mixed_Subdivisions is
6:
7: -- CREATORS :
8:
9: function Create ( pts : Array_of_Lists; nor : Vector; tol : double_float )
10: return Mixed_Cell is
11:
12: res : Mixed_Cell;
13: sup : double_float;
14:
15: begin
16: res.nor := new Vector'(nor);
17: res.pts := new Array_of_Lists(pts'range);
18: for k in pts'range loop
19: sup := Minimal_Support(pts(k),nor);
20: res.pts(k) := Face(pts(k),nor,sup,tol);
21: end loop;
22: return res;
23: end Create;
24:
25: function Create ( pts : Array_of_Lists; nors : List; tol : double_float )
26: return Mixed_Subdivision is
27:
28: res,res_last : Mixed_Subdivision;
29: tmp : List := nors;
30:
31: begin
32: while not Is_Null(tmp) loop
33: Append(res,res_last,Create(pts,Head_Of(tmp).all,tol));
34: tmp := Tail_Of(tmp);
35: end loop;
36: return res;
37: end Create;
38:
39: function Create ( pts : Array_of_Lists; mixsub : Mixed_Subdivision;
40: tol : double_float ) return Mixed_Subdivision is
41:
42: tmp,res,res_last : Mixed_Subdivision;
43:
44: begin
45: tmp := mixsub;
46: while not Is_Null(tmp) loop
47: Append(res,res_last,Create(pts,Head_Of(tmp).nor.all,tol));
48: tmp := Tail_Of(tmp);
49: end loop;
50: return res;
51: end Create;
52:
53: procedure Update ( pts : in Array_of_Lists; nor : in Vector;
54: mixsub,mixsub_last : in out Mixed_Subdivision ) is
55:
56: -- DESCRIPTION :
57: -- Given a tuple of point sets and a normal,
58: -- the mixed subdivision will be updated.
59:
60: tmp : Mixed_Subdivision := mixsub;
61: done : boolean := false;
62:
63: begin
64: while not Is_Null(tmp) and not done loop
65: declare
66: mic : Mixed_Cell := Head_Of(tmp);
67: last : List;
68: begin
69: if Equal(mic.nor.all,nor)
70: then for k in mic.pts'range loop
71: last := mic.pts(k);
72: while not Is_Null(Tail_Of(last)) loop
73: last := Tail_Of(last);
74: end loop;
75: Deep_Concat_Diff(mic.pts(k),last,pts(k));
76: end loop;
77: Set_Head(tmp,mic);
78: done := true;
79: else tmp := Tail_Of(tmp);
80: end if;
81: end;
82: end loop;
83: if not done
84: then declare
85: mic : Mixed_Cell;
86: begin
87: mic.pts := new Array_of_Lists(pts'range);
88: Copy(pts,mic.pts.all);
89: mic.nor := new Standard_Floating_Vectors.Vector'(nor);
90: mic.sub := null;
91: Append(mixsub,mixsub_last,mic);
92: end;
93: end if;
94: end Update;
95:
96: -- CONSTRUCTORS :
97:
98: procedure Copy ( mic1 : in Mixed_Cell; mic2 : in out Mixed_Cell ) is
99: begin
100: Deep_Clear(mic2);
101: if mic1.nor /= null
102: then mic2.nor := new Standard_Floating_Vectors.Vector'(mic1.nor.all);
103: end if;
104: if mic1.pts /= null
105: then mic2.pts := new Array_of_Lists(mic1.pts'range);
106: Copy(mic1.pts.all,mic2.pts.all);
107: end if;
108: if mic1.sub /= null
109: then mic2.sub := new Mixed_Subdivision;
110: Copy(mic1.sub.all,mic2.sub.all);
111: end if;
112: end Copy;
113:
114: procedure Copy ( mixsub1 : in Mixed_Subdivision;
115: mixsub2 : in out Mixed_Subdivision ) is
116:
117: tmp : Mixed_Subdivision := mixsub1;
118: mixsub2_last : Mixed_Subdivision;
119:
120: begin
121: Deep_Clear(mixsub2);
122: while not Is_Null(tmp) loop
123: declare
124: mic1,mic2 : Mixed_Cell;
125: begin
126: mic1 := Head_Of(tmp);
127: Copy(mic1,mic2);
128: Append(mixsub2,mixsub2_last,mic2);
129: end;
130: tmp := Tail_Of(tmp);
131: end loop;
132: end Copy;
133:
134: procedure Append_Diff ( first,last : in out Mixed_Subdivision;
135: mic : in Mixed_Cell ) is
136: begin
137: if not Is_In(first,mic)
138: then Append(first,last,mic);
139: end if;
140: end Append_Diff;
141:
142: procedure Concat_Diff ( first,last : in out Mixed_Subdivision;
143: mixsub : in Mixed_Subdivision ) is
144:
145: tmp : Mixed_Subdivision := mixsub;
146:
147: begin
148: while not Is_Null(tmp) loop
149: declare
150: mic : Mixed_Cell := Head_Of(tmp);
151: begin
152: if not Is_In(first,mic)
153: then Append_Diff(first,last,mic);
154: end if;
155: end;
156: tmp := Tail_Of(tmp);
157: end loop;
158: end Concat_Diff;
159:
160: procedure Construct ( mixsub : in Mixed_Subdivision;
161: first : in out Mixed_Subdivision ) is
162:
163: tmp : Mixed_Subdivision := mixsub;
164:
165: begin
166: while not Is_Null(tmp) loop
167: declare
168: mic : Mixed_Cell := Head_Of(tmp);
169: begin
170: Construct(mic,first);
171: end;
172: tmp := Tail_Of(tmp);
173: end loop;
174: end Construct;
175:
176: procedure Construct_Diff ( mixsub : in Mixed_Subdivision;
177: first : in out Mixed_Subdivision ) is
178:
179: tmp : Mixed_Subdivision := mixsub;
180:
181: begin
182: while not Is_Null(tmp) loop
183: declare
184: mic : Mixed_Cell := Head_Of(tmp);
185: begin
186: if not Is_In(first,mic)
187: then Construct(mic,first);
188: end if;
189: end;
190: tmp := Tail_Of(tmp);
191: end loop;
192: end Construct_Diff;
193:
194: -- SELECTORS :
195:
196: function Equal ( mic1,mic2 : Mixed_Cell ) return boolean is
197: begin
198: if not Equal(mic1.nor,mic2.nor)
199: then return false;
200: elsif Equal(mic1.pts,mic2.pts)
201: then return Equal(mic1.sub,mic2.sub);
202: else return false;
203: end if;
204: end Equal;
205:
206: function Is_Sub ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is
207:
208: -- DESCRIPTION :
209: -- Returns true when every cell in mixsub1 also belongs to mixsub2.
210:
211: tmp : Mixed_Subdivision := mixsub1;
212:
213: begin
214: while not Is_Null(tmp) loop
215: if not Is_In(mixsub2,Head_Of(tmp))
216: then return false;
217: else tmp := Tail_Of(tmp);
218: end if;
219: end loop;
220: return true;
221: end Is_Sub;
222:
223: function Equal ( mixsub1,mixsub2 : Mixed_Subdivision ) return boolean is
224: begin
225: if Is_Sub(mixsub1,mixsub2)
226: then return Is_Sub(mixsub2,mixsub1);
227: else return false;
228: end if;
229: end Equal;
230:
231: function Equal ( mixsub1,mixsub2 : Link_to_Mixed_Subdivision )
232: return boolean is
233: begin
234: if mixsub1 = null and then mixsub2 /= null
235: then return false;
236: elsif mixsub2 = null
237: then return true;
238: else return Equal(mixsub1.all,mixsub2.all);
239: end if;
240: end Equal;
241:
242: function Is_In ( mixsub : Mixed_Subdivision; normal : Vector )
243: return boolean is
244:
245: tmp : Mixed_Subdivision := mixsub;
246: c : Mixed_Cell;
247:
248: begin
249: while not Is_Null(tmp) loop
250: c := Head_Of(tmp);
251: if Equal(c.nor.all,normal)
252: then return true;
253: end if;
254: tmp := Tail_Of(tmp);
255: end loop;
256: return false;
257: end Is_In;
258:
259: function Is_In ( mixsub : Mixed_Subdivision; mic : Mixed_Cell )
260: return boolean is
261:
262: tmp : Mixed_Subdivision := mixsub;
263: mic1 : Mixed_Cell;
264:
265: begin
266: while not Is_Null(tmp) loop
267: mic1 := Head_Of(tmp);
268: if Equal(mic1,mic)
269: then return true;
270: else tmp := Tail_Of(tmp);
271: end if;
272: end loop;
273: return false;
274: end Is_In;
275:
276: -- DESTRUCTORS :
277:
278: procedure free is new unchecked_deallocation
279: (Mixed_Subdivision,Link_to_Mixed_Subdivision);
280:
281: procedure Deep_Clear ( mic : in out Mixed_Cell ) is
282: begin
283: Clear(mic.nor); Deep_Clear(mic.pts); Deep_Clear(mic.sub);
284: end Deep_Clear;
285:
286: procedure Shallow_Clear ( mic : in out Mixed_Cell ) is
287: begin
288: Clear(mic.nor); Shallow_Clear(mic.pts); Shallow_Clear(mic.sub);
289: end Shallow_Clear;
290:
291: procedure Deep_Clear ( mixsub : in out Mixed_Subdivision ) is
292:
293: tmp : Mixed_Subdivision;
294:
295: begin
296: tmp := mixsub;
297: while not Is_Null(tmp) loop
298: declare
299: mic : Mixed_Cell := Head_Of(tmp);
300: begin
301: Deep_Clear(mic);
302: end;
303: tmp := Tail_Of(tmp);
304: end loop;
305: Shallow_Clear(mixsub);
306: end Deep_Clear;
307:
308: procedure Deep_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
309: begin
310: if mixsub /= null
311: then Deep_Clear(mixsub.all);
312: free(mixsub);
313: end if;
314: end Deep_Clear;
315:
316: procedure Shallow_Clear ( mixsub : in out Mixed_Subdivision ) is
317: begin
318: Lists_of_Mixed_Cells.Clear(Lists_of_Mixed_Cells.List(mixsub));
319: end Shallow_Clear;
320:
321: procedure Shallow_Clear ( mixsub : in out Link_to_Mixed_Subdivision ) is
322: begin
323: if mixsub /= null
324: then Shallow_Clear(mixsub.all);
325: free(mixsub);
326: end if;
327: end Shallow_Clear;
328:
329: end Floating_Mixed_Subdivisions;
FreeBSD-CVSweb <freebsd-cvsweb@FreeBSD.org>
![[BACK]](/icons/cvsweb/back.gif){kind=icon}
Return to floating_mixed_subdivisions.adb CVS log ![[TXT]](/icons/cvsweb/text.gif){kind=icon}
![[DIR]](/icons/cvsweb/dir.gif){kind=icon}
Up to [local] / OpenXM_contrib / PHC / Ada / Root_Counts / Stalift