Arbre N aires implémenté avec une liste (vecteur)
Variante
Arbre N aires d'un objet à l'échelle de classe.
- Using bell character.
Specification
type Tag_Name is
(Null_Tag,
Universe, Animal, Content, Planning, Plan, Activity, Event, Note,
Perso_Ac, Def_Class, Acc_Line, Deal, Entep_Ac, Contact, Car, House,
Saved_Ac);
subtype Abstracted_Index is Positive range 1..Ptr_Max;
type Abstracted_Class(Tag : Tag_Name);
type Abstracted_Access is access all Abstracted_Class'Class;
function Equal(Left, Right : in Abstracted_Access) return Boolean;
package Abstracted_Vectors is new Vectors(Abstracted_Index, Abstracted_Access, Equal);
use Abstracted_Vectors;
subtype Objects_vector is Abstracted_Vectors.Vector;
type Abstracted_Class(Tag : Tag_Name) is abstract tagged
record
Index : Abstracted_Index := 1;
Name : Name_Type := (others => Wide_Character'Val(32));
Vector : Objects_Vector;
Create_Date : Time := Clock;
end record;
procedure Write (O : in Abstracted_Class;File : in W_Io.File_Type) is abstract;
procedure Read (O : in out Abstracted_Class;File : in W_Io.File_Type) is abstract;
procedure Random (O : in out Abstracted_Class) is abstract;
type Terminal_record is tagged
record
Obj : Abstracted_Access;
V_Switch : Objects_Vector;
Obj_Cur : Abstracted_Access;
end record;
Implementation
Voici les procedure de sauvegarde et de restauration de l'arbre dans lequelles j'utilise quelque procedure externe :
- Global_Read : permet de lire un noeud dans un fichier ; Non fournit
- Global_Print : permet d'afficher l'état d'un noeud ; Le nombre d'enfant trié par Tag_Name ; non fournit
- parent : permet d'aller au noeud parent ;
- Switch : permet d'aller au noeud enfant à l'index indiqué.
Sauvegarde
procedure Save_Object (Object : Abstracted_Access;
File : W_Io.File_Type;
Index : Natural := 0) is
O : Abstracted_Access := Object;
New_Index : Natural := Index;
begin
O.all.Write(File);
W_Io.Put_Line(File, To_Wide_String(Integer'Image(Integer(Abstracted_Vectors.Length(O.Vector)))));
W_Io.Put_Line(File, Wide_Character'Val(7) & "");
if not Is_Empty(O.Vector) then
for I in 1..Last_Index(O.Vector) loop
declare
E : constant Abstracted_Access :=
Abstracted_Vectors.Element(O.Vector, I);
begin
Save_Object(E, File, New_Index+1);
end;
end loop;
for I in 0..Index loop
W_Io.Put_Line(File, Wide_Character'Val(7) & "");
end loop;
end if;
end Save_Object;
procedure Save (Object : in Abstracted_Access;
Filename : in String) is
File : W_Io.File_Type;
begin
W_Io.Create(File, W_Io.Out_File, Filename);
Save_Object(Object, File);
W_Io.Close(File);
end Save;
Restauration
procedure Restore_Vector(T : in out Terminal_Record;
File : W_Io.File_Type) is
Line_Index : positive := 1;
Is_End : Boolean := False;
Wchar : Wide_Character;
Prompt : Name_Type;
Success : Boolean := True;
O : Abstracted_Access;
End_Of_File : Boolean := False;
P : Natural := 0;
Child_Numb : Natural := 0;
begin
declare
Children : Wide_String := W_Io.Get_Line(File);
begin
Child_Numb := Natural'Value(To_String(Children));
if Child_Numb /= 0 then
for I in 1..Child_Numb loop
if not W_Io.End_Of_File(File) then
-- ici on cherche le caractère bell
while not W_Io.End_Of_File(File) loop
begin
W_Io.Look_ahead(File, Wchar, Is_end);
if Is_Graphic(To_Character(Wchar)) then
exit;
end if;
W_Io.Get_Immediate(File, Wchar);
if Wchar = Wide_Character'Val(7) then
P := P + 1;
end if;
end;
end loop;
Global_Read(File, End_Of_File, O);
Global_Print(O, Win, Line_index);
if P > 0 and P <= Natural(Length(T.V_Switch)) then
for I in 1..P-1 loop
Parent(T, Prompt);
end loop;
Success := False;
elsif P > 0 then
for I in 1..P loop
Parent(T, Prompt);
end loop;
end if;
Line_Index := 1;
if not Success then
if O.Index /= 1 then
T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;
elsif not Is_Empty (T.Obj_Cur.Vector) and O.Index = 1 then
Switch(T, Last_Index(T.Obj_Cur.Vector), Prompt, Success);
T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;
end if;
elsif not Is_Empty (T.Obj_Cur.Vector) and O.Index = 1 then
Switch(T, Last_Index(T.Obj_Cur.Vector), Prompt, Success);
if Success then
T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;
else
raise Program_Error;
end if;
else
T.Obj_Cur.Vector := T.Obj_Cur.Vector & O;
end if;
if not W_Io.End_Of_File(File) then
Restore_Vector(T, File);
end if;
end if;
end loop;
end if;
-- le code ci-dessous est peut-être inutile.
if not W_Io.End_Of_File(File) then
Restore_Vector(T, File);
end if;
exception
when others =>
Put("Error when restore object");
end;
end Restore_Vector;
procedure Restore_Object (T : in out Terminal_Record;
File : W_Io.File_Type) is
End_Of_File : Boolean := False;
Vector : Objects_Vector;
begin
if not W_Io.End_Of_File(File) then
Global_Read(File, End_Of_File, T.Obj);
end if;
T.Obj_Cur := T.Obj;
if not W_Io.End_Of_File(File) then
Restore_Vector(T, File);
end if;
end Restore_Object;
procedure Restore(T : in out Terminal_Record;
Filename : in String) is
File : W_Io.File_Type;
begin
W_Io.Open(File, W_Io.in_File, Filename);
if not W_Io.End_Of_File(File) then
Restore_Object(T, File);
end if;
W_Io.Close(File);
end Restore;
Navigation
procedure Parent(T : in out Terminal_Record;
Prompt : out Name_Type) is
V : Objects_Vector := T.V_Switch;
begin
if not Is_Empty(V) then
if Last_Index(V) >= 1 then
T.Obj_Cur := Last_Element(V);
if T.Obj_Cur /= null then
Prompt := T.Obj_Cur.Name;
if Last_Index(V) > 1 then
Delete(V, Last_Index(V));
end if;
end if;
end if;
end if;
T.V_Switch := V;
end Parent;
procedure Switch(T : in out Terminal_Record;
Num : in Abstracted_Index;
Prompt : out Name_Type;
Success : out boolean) is
Vector : Objects_Vector;
begin
Success := False;
Prompt := (others => Wide_Character'Val(32));
if T.Obj_Cur /= null then
Vector := T.Obj_Cur.Vector;
if not Is_Empty(Vector) then
if Num <= Last_Index(Vector) then
T.V_Switch := T.V_Switch & T.Obj_Cur;
T.Obj_Cur := Abstracted_Vectors.Element(Vector, Num);
if T.Obj_Cur /= null then
Prompt := T.Obj_Cur.Name;
Success := True;
else
raise Program_Error;
end if;
end if;
end if;
end if;
end Switch;