Return to face_structures.adb CVS log

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

Annotation of OpenXM_contrib/PHC/Ada/Root_Counts/Dynlift/face_structures.adb, Revision 1.1

1.1     ! maekawa     1: package body Face_Structures is
        !             2:
        !             3: -- CONSTRUCTOR :
        !             4:
        !             5:   procedure Compute_New_Faces
        !             6:                  ( fs : in out Face_Structure; k,n : in natural;
        !             7:                    point : in out Link_to_Vector; newfs : out Faces ) is
        !             8:
        !             9:     procedure Append ( fc : in VecVec ) is
        !            10:
        !            11:       f : Face;
        !            12:
        !            13:     begin
        !            14:       f.points := Shallow_Create(fc);
        !            15:       Append(res,res_last,f);
        !            16:     end Append;
        !            17:     procedure EnumLis is new Enumerate_Faces_in_List(Append);
        !            18:     procedure EnumTri is new Enumerate_Faces_in_Triangulation(Append);
        !            19:
        !            20:   begin
        !            21:    -- COMPUTE THE NEW FACES AND UPDATE fs :
        !            22:     if Is_Null(fs.t)
        !            23:      then
        !            24:        if Length_Of(fs.l) >= n
        !            25:         then
        !            26:           fs.t := Initial_Triangulation(n,fs.l,point);
        !            27:           if Is_Null(fs.t)
        !            28:            then EnumLis(fs.l,point,k);
        !            29:            else EnumTri(fs.t,point,k);
        !            30:           end if;
        !            31:         else
        !            32:           EnumLis(fs.l,point,k);
        !            33:        end if;
        !            34:      else
        !            35:        declare
        !            36:          newt : Triangulation;
        !            37:        begin
        !            38:          point(point'last) := Next_Lifting(fs.t,point.all);
        !            39:          Update(fs.t,point,newt);
        !            40:          Enumtri(newt,point,k);
        !            41:        end;
        !            42:     end if;
        !            43:     Append(fs.l,fs.last,point);
        !            44:     newfs := res;
        !            45:   end Compute_New_Faces;
        !            46:
        !            47: -- FLATTENING :
        !            48:
        !            49:   procedure Flatten ( f : in out Face ) is
        !            50:   begin
        !            51:     if f.normal /= null
        !            52:      then f.normal.all := (f.normal'range => 0);
        !            53:           f.normal(f.normal'last) := 1;
        !            54:     end if;
        !            55:     Flatten(f.points);
        !            56:   end Flatten;
        !            57:
        !            58:   procedure Flatten ( fs : in out Faces ) is
        !            59:
        !            60:     tmp : Faces := fs;
        !            61:     f : Face;
        !            62:
        !            63:   begin
        !            64:     while not Is_Null(tmp) loop
        !            65:       f := Head_Of(tmp);
        !            66:       Flatten(f);
        !            67:       Set_Head(tmp,f);
        !            68:       tmp := Tail_Of(tmp);
        !            69:     end loop;
        !            70:   end Flatten;
        !            71:
        !            72:   procedure Flatten ( fs : in out Face_Structure ) is
        !            73:   begin
        !            74:     Flatten(fs.l); Flatten(fs.t); Flatten(fs.f);
        !            75:   end Flatten;
        !            76:
        !            77:   procedure Flatten ( fs : in out Array_of_Face_Structures ) is
        !            78:   begin
        !            79:     for i in fs'range loop
        !            80:       Flatten(fs(i));
        !            81:     end loop;
        !            82:   end Flatten;
        !            83:
        !            84: -- SELECTORS :
        !            85:
        !            86:   function Is_In ( fs : Face_Structure; point : vector ) return boolean is
        !            87:   begin
        !            88:     if Is_Null(fs.t)
        !            89:      then return Is_In(fs.l,point);
        !            90:      else return Is_In(fs.t,point);
        !            91:     end if;
        !            92:   end Is_In;
        !            93:
        !            94: -- DESTRUCTORS :
        !            95:
        !            96:   procedure Deep_Clear ( fs : in out Face_Structure ) is
        !            97:   begin
        !            98:     Deep_Clear(fs.l); Deep_Clear(fs.f); Deep_Clear(fs.t);
        !            99:   end Deep_Clear;
        !           100:
        !           101:   procedure Shallow_Clear ( fs : in out Face_Structure ) is
        !           102:   begin
        !           103:     Shallow_Clear(fs.l); Shallow_Clear(fs.f); Shallow_Clear(fs.t);
        !           104:   end Shallow_Clear;
        !           105:
        !           106:   procedure Deep_Clear ( fs : in out Array_of_Face_Structures ) is
        !           107:   begin
        !           108:     for i in fs'range loop
        !           109:       Deep_Clear(fs(i));
        !           110:     end loop;
        !           111:   end Deep_Clear;
        !           112:
        !           113:   procedure Shallow_Clear ( fs : in out Array_of_Face_Structures );
        !           114:   begin
        !           115:     for i in fs'range loop
        !           116:       Shallow_Clear(fs(i));
        !           117:     end loop;
        !           118:   end Shallow_Clear;
        !           119:
        !           120: end Face_Structures;