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     ! 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;