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

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;