Return to flatten_mixed_subdivisions.adb CVS log

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

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

1.1       maekawa     1: with Standard_Integer_Vectors;           use Standard_Integer_Vectors;
                      2:
                      3: package body Flatten_Mixed_Subdivisions is
                      4:
                      5:   procedure Flatten ( l : in out List ) is
                      6:
                      7:     tmp : List := l;
                      8:     pt : Link_to_Vector;
                      9:
                     10:   begin
                     11:     while not Is_Null(tmp) loop
                     12:       pt := Head_Of(tmp);
                     13:       if pt(pt'last) /= 0
                     14:        then pt(pt'last) := 0;
                     15:             Set_Head(tmp,pt);
                     16:       end if;
                     17:       tmp := Tail_Of(tmp);
                     18:     end loop;
                     19:   end Flatten;
                     20:
                     21:   procedure Flatten ( l : in out Array_of_Lists ) is
                     22:   begin
                     23:     for i in l'range loop
                     24:       Flatten(l(i));
                     25:     end loop;
                     26:   end Flatten;
                     27:
                     28:   procedure Flatten ( mic : in out Mixed_Cell ) is
                     29:   begin
                     30:     Flatten(mic.pts.all);
                     31:     mic.nor.all := (mic.nor'range => 0);
                     32:     mic.nor(mic.nor'last) := 1;
                     33:   end Flatten;
                     34:
                     35:   procedure Old_Flatten ( mixsub : in out Mixed_Subdivision ) is
                     36:
                     37:     tmp : Mixed_Subdivision := mixsub;
                     38:     mic : Mixed_Cell;
                     39:
                     40:   begin
                     41:     while not Is_Null(tmp) loop
                     42:       mic := Head_Of(tmp);
                     43:       Flatten(mic);
                     44:       Set_Head(tmp,mic);
                     45:       tmp := Tail_Of(tmp);
                     46:     end loop;
                     47:   end Old_Flatten;
                     48:
                     49: -- NEW FLATTENING, USING THE RECURSIVE DATA STRUCTURE :
                     50:
                     51:   function Collect_Supports ( n : natural; mixsub : Mixed_Subdivision )
                     52:                             return Array_of_Lists is
                     53:
                     54:   -- DESCRIPTION :
                     55:   --   Returns the array of list of points that occur in the cells
                     56:   --   of the mixed subdivision.
                     57:
                     58:   -- REQUIRED : not Is_Null(mixsub).
                     59:
                     60:     tmp : Mixed_Subdivision := mixsub;
                     61:     mic : Mixed_Cell := Head_Of(mixsub);
                     62:     tmppts : List;
                     63:     pt : Link_to_Vector;
                     64:     res,res_last : Array_of_Lists(mic.pts'range);
                     65:
                     66:   begin
                     67:     while not Is_Null(tmp) loop
                     68:       mic := Head_Of(tmp);
                     69:       for k in mic.pts'range loop
                     70:         tmppts := mic.pts(k);
                     71:         while not Is_Null(tmppts) loop
                     72:           pt := Head_Of(tmppts);
                     73:           if not Is_In(res(k),pt)
                     74:            then Append(res(k),res_last(k),pt.all);
                     75:           end if;
                     76:           tmppts := Tail_Of(tmppts);
                     77:         end loop;
                     78:       end loop;
                     79:       tmp := Tail_Of(tmp);
                     80:     end loop;
                     81:     return res;
                     82:   end Collect_Supports;
                     83:
                     84:   procedure Flatten ( mixsub : in out Mixed_Subdivision ) is
                     85:
                     86:   -- DESCRIPTION :
                     87:   --   Flattens the mixed subdivision, i.e., the modified mixed subdivision
                     88:   --   contains one flattened cells with all the points that occured in the
                     89:   --   subdivision.  The original mixed subdivision is stored as the
                     90:   --   subdivision of that flattened cell.
                     91:
                     92:   begin
                     93:     if not Is_Null(mixsub)
                     94:      then declare
                     95:             n : constant natural := Head_Of(mixsub).nor'length-1;
                     96:             mic : Mixed_Cell;
                     97:             res : Mixed_Subdivision;
                     98:           begin
                     99:             mic.nor := new Standard_Integer_Vectors.Vector(1..n+1);
                    100:             mic.pts := new Array_of_Lists'(Collect_Supports(n,mixsub));
                    101:             Flatten(mic);
                    102:             mic.sub := new Mixed_Subdivision'(mixsub);
                    103:             Construct(mic,res);
                    104:             mixsub := res;
                    105:           end;
                    106:     end if;
                    107:   end Flatten;
                    108:
                    109: end Flatten_Mixed_Subdivisions;