|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - downloadIndex: ┃ B T ┃
Length: 41582 (0xa26e)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─ ⟦129cab021⟧ »DATA«
└─⟦this⟧
with Tad_Actor, Actor_Tree;
with Tad_Material, Material_Tree;
with The_Material_Tree;
with Tad_Global, Global_Tree;
with The_Global_Tree;
with Tad_Group, Group_Tree;
with Tad_Local, Local_Tree;
with Tad_Parameter, Parameter_Tree;
with Tad_Experience, Experience_Tree;
with The_Experience_Tree;
with Tad_Abstract, Pointer_Level;
with Tad_Scene, Scene_Tree;
with The_Scene_Tree, Spectacle_Tree;
with Token;
with Text_Io;
use Text_Io;
with Personnal_String;
use Personnal_String;
package body Tds is
type Ptr_Material is access Tad_Material.Object;
type Ptr_Actor is access Tad_Actor.Object;
type Ptr_Global is access Tad_Global.Object;
Tmp_Ptr_Material : Ptr_Material; --
Tmp_Ptr_Actor : Ptr_Actor; --
Tmp_Actor_Tree : Actor_Tree.Object; --
Tmp_Ptr_Global : Ptr_Global; --
Tmp_Param_Tree : Parameter_Tree.Object; --
Tmp_Local_Tree : Local_Tree.Object; --
Tmp_Code_Tree : Tad_Abstract.Pobject; --
Tmp_Group_Tree : Group_Tree.Object; --
Current_Actor_Address : Natural := 0;
Current_Param_Order : Natural := 1;
Create_Tree : Boolean := True;
function Create_New_Material (The_Name : Pstring) return Boolean is
The_Object : Tad_Material.Object;
Exist : Boolean := False;
begin
Tad_Material.Create_New_Material (The_Object, The_Name.all);
Exist := Material_Tree.Element_Exist
(The_Material_Tree.Object, The_Object);
if Exist then
return False;
else
begin
Current_Actor_Address := 0;
Tad_Material.Get_Actors (The_Object, Tmp_Actor_Tree);
Material_Tree.Insert_Element
(The_Material_Tree.Object, The_Object);
Tmp_Ptr_Material := new Tad_Material.Object'(The_Object);
Put_Line ("Un Nouveau materiel est cree : " & The_Name.all);
return True;
end;
end if;
end Create_New_Material;
function Add_Actor (The_Name : Pstring) return Boolean is
The_Object : Tad_Actor.Object;
Exist : Boolean := False;
begin
Tad_Actor.Create_New_Actor
(The_Object, The_Name.all, Current_Actor_Address);
Exist := Actor_Tree.Element_Exist (Tmp_Actor_Tree, The_Object);
if Exist then
return False;
else
begin
Actor_Tree.Insert_Element (Tmp_Actor_Tree, The_Object);
if Current_Actor_Address = 0 then
Material_Tree.Change_Element
(The_Material_Tree.Object, Tmp_Ptr_Material.all);
end if;
Current_Actor_Address := Current_Actor_Address + 1;
Tmp_Ptr_Actor := new Tad_Actor.Object'(The_Object);
Put_Line ("Un Nouvel acteur est cree : " & The_Name.all);
return True;
end;
end if;
end Add_Actor;
function Add_Actor_Type (The_Type : Token.Object) return Boolean is
Ok : Boolean := False;
begin
case The_Type is
when Token.L_Binaire =>
Tad_Actor.Add_Type (Tmp_Ptr_Actor.all, Tad_Actor.Binaire);
Ok := True;
when Token.L_Discret =>
Tad_Actor.Add_Type (Tmp_Ptr_Actor.all, Tad_Actor.Discret);
Ok := True;
when Token.L_Fugitif =>
Tad_Actor.Add_Type (Tmp_Ptr_Actor.all, Tad_Actor.Fugitif);
Ok := True;
when Token.L_Temporel =>
Tad_Actor.Add_Type (Tmp_Ptr_Actor.all, Tad_Actor.Temporel);
Ok := True;
when others =>
null;
end case;
if Ok then
Put_Line ("le type de l'acteur est : " &
Token.Object'Image (The_Type));
end if;
return Ok;
end Add_Actor_Type;
function Compare_Current_Material_Name
(The_Name : Pstring) return Boolean is
The_Object : Tad_Material.Object;
begin
Tad_Material.Create_New_Material (The_Object, The_Name.all);
if Tad_Material.Compare_Name (The_Object, Tmp_Ptr_Material.all) = 0 then
begin
Put_Line ("comparaison de l'identificateur materiel : " &
The_Name.all);
return True;
end;
else
return False;
end if;
end Compare_Current_Material_Name;
function Create_New_Station (The_Name : Pstring) return Boolean is
The_Object : Tad_Global.Object;
Exist : Boolean := False;
begin
Tad_Global.Create_New_Station (The_Object, The_Name.all);
Exist := Global_Tree.Element_Exist (The_Global_Tree.Object, The_Object);
if Exist then
return False;
else
begin
Global_Tree.Insert_Element (The_Global_Tree.Object, The_Object);
Tmp_Ptr_Global := new Tad_Global.Object'(The_Object);
Put_Line ("Une Nouvelle station est cree : " & The_Name.all);
return True;
end;
end if;
end Create_New_Station;
function Set_Station_Type (The_Type : Pstring) return Boolean is
The_Object : Tad_Material.Object;
Exist : Boolean := False;
begin
Tad_Material.Create_New_Material (The_Object, The_Type.all);
Exist := Material_Tree.Element_Exist
(The_Material_Tree.Object, The_Object);
if Exist then
begin
Tad_Global.Set_Material_Type (Tmp_Ptr_Global.all, The_Object);
Put_Line ("Le type de la station : " & The_Type.all);
return True;
end;
else
return False;
end if;
end Set_Station_Type;
function Set_Station_Number (The_Address : Natural) return Boolean is
begin
Tad_Global.Set_Station_Number (Tmp_Ptr_Global.all, The_Address);
Put_Line ("Le numero de la station est : " &
Natural'Image (The_Address));
return True;
end Set_Station_Number;
function Create_New_Experience (The_Name : Pstring) return Boolean is
The_Object : Tad_Experience.Object;
Exist : Boolean := False;
begin
Create_Tree := True; --creation de l'arbre abstrait
Tad_Experience.Create_New_Experience (The_Object, The_Name.all);
Exist := Experience_Tree.Element_Exist
(The_Experience_Tree.Object, The_Object);
if Exist then
return False;
else
begin
Experience_Tree.Insert_Element
(The_Experience_Tree.Object, The_Object);
Tmp_Param_Tree := Tad_Experience.Get_Parameter (The_Object);
Tmp_Local_Tree := Tad_Experience.Get_Local_Var (The_Object);
Tmp_Code_Tree := Tad_Experience.Get_Code (The_Object);
Current_Param_Order := 1;
Put_Line ("Une Nouvelle experience est cree : " & The_Name.all);
return True;
end;
end if;
end Create_New_Experience;
function Add_Experience_Parameter (The_Name : Pstring) return Boolean is
Para_Object : Tad_Parameter.Object;
begin
Tad_Parameter.Create_New_Param (Para_Object, Current_Param_Order);
Tad_Parameter.Set_Name (Para_Object, The_Name.all);
Parameter_Tree.Insert_Element (Tmp_Param_Tree, Para_Object);
if Set_Local_Variable (The_Name) then
begin
Current_Param_Order := Current_Param_Order + 1;
Put_Line ("On ajoute 1 parametre a l'experience : " &
The_Name.all);
return True;
end;
else
return False;
end if;
end Add_Experience_Parameter;
function Create_New_Scene (The_Name : Pstring) return Boolean is
The_Object : Tad_Scene.Object;
Exist : Boolean := False;
begin
Create_Tree := True; --creation de l'arbre abstrait
Tad_Scene.Create_New_Scene (The_Object, The_Name.all);
Exist := Scene_Tree.Element_Exist (The_Scene_Tree.Object, The_Object);
if Exist then
return False;
else
begin
Scene_Tree.Insert_Element (The_Scene_Tree.Object, The_Object);
Tmp_Local_Tree := Local_Tree.Create_New_Tree;
Tad_Scene.Add_Local_Var (The_Object, Tmp_Local_Tree);
Tmp_Code_Tree := Tad_Scene.Get_Code (The_Object);
Put_Line ("Une Nouvelle Scene est cree : " & The_Name.all);
return True;
end;
end if;
end Create_New_Scene;
function Create_Spectacle return Boolean is
begin
Create_Tree := True; --creation de l'arbre abstrait
Tmp_Code_Tree := Spectacle_Tree.Object;
Put_Line ("Le noeud Spectacle est cree");
return True;
end Create_Spectacle;
function Set_Local_Variable (The_Name : Pstring) return Boolean is
The_Object : Tad_Local.Object;
Exist : Boolean := False;
begin
Tad_Local.Create_New_Local_Var (The_Object, The_Name.all);
Exist := Local_Tree.Element_Exist (Tmp_Local_Tree, The_Object);
if Exist then
return False;
else
begin
Local_Tree.Insert_Element (Tmp_Local_Tree, The_Object);
Put_Line ("Insertion d'une variable locale : " & The_Name.all);
return True;
end;
end if;
end Set_Local_Variable;
function Set_Local_Group (The_Name : Pstring) return Boolean is
The_Object : Tad_Local.Object;
Exist : Boolean := False;
begin
Tad_Local.Create_New_Local_Var (The_Object, The_Name.all);
Exist := Local_Tree.Element_Exist (Tmp_Local_Tree, The_Object);
if Exist then
return False;
else
begin
Tad_Local.Set_Type (The_Object, Tad_Local.Groupe);
Local_Tree.Insert_Element (Tmp_Local_Tree, The_Object);
Tmp_Group_Tree := Tad_Local.Get_Members (The_Object);
Put_Line ("Insertion d'un nom local de groupe : " &
The_Name.all);
return True;
end;
end if;
end Set_Local_Group;
function Add_Local_Group_Member (The_Name : Pstring) return Boolean is
Global_Object : Tad_Global.Object;
Group_Object : Tad_Group.Object;
Exist : Boolean := False;
begin
Tad_Global.Create_New_Station (Global_Object, The_Name.all);
Exist := Global_Tree.Element_Exist
(The_Global_Tree.Object, Global_Object);
if Exist then
begin
Tad_Group.Create_New_Group_Member (Group_Object, The_Name.all);
Exist := Group_Tree.Element_Exist
(Tmp_Group_Tree, Group_Object);
if Exist then
return False;
else
begin
Group_Tree.Insert_Element
(Tmp_Group_Tree, Group_Object);
Put_Line ("On ajoute un membre au groupe local : " &
The_Name.all);
return True;
end;
end if;
end;
else
return False;
end if;
end Add_Local_Group_Member;
--------------------------------------------------------------------------
--------------------------------------------------------------------------
-- primitives de creation de l'arbre abstrait
-- et controle de la semantique statique
--------------------------------------------------------------------------
--------------------------------------------------------------------------
-- certaines gardes semantiques sont mises en commentaire pour montrer
-- que la production des noeuds fonctionne.
-- l'arbre abstrait est genere sans controle sematique complet
function Actor_Of_Station_Exist
(Station : Pstring; Actor : Pstring) return Boolean is
Ok : Boolean := False;
The_Station : Tad_Global.Object;
The_Material : Tad_Material.Object;
The_Actor_Tree : Actor_Tree.Object;
The_Actor : Tad_Actor.Object;
begin
Tad_Global.Create_New_Station (The_Station, Station.all);
if Global_Tree.Element_Exist (The_Global_Tree.Object, The_Station) then
begin
Global_Tree.Search_Element
(The_Global_Tree.Object, The_Station);
Tad_Global.Get_Material_Type (The_Station, The_Material);
Material_Tree.Search_Element
(The_Material_Tree.Object, The_Material);
Tad_Material.Get_Actors (The_Material, The_Actor_Tree);
Tad_Actor.Create_New_Actor (The_Actor, Actor.all);
Ok := True; -- semantique
if Actor_Tree.Element_Exist (The_Actor_Tree, The_Actor) then
Ok := True;
end if;
end;
end if;
return Ok;
end Actor_Of_Station_Exist;
procedure Syntax_Error is
begin
Create_Tree := False;
end Syntax_Error;
function Mknode_Scene (The_Name : Pstring) return Boolean is
Ok : Boolean := False;
The_Scene : Tad_Scene.Object;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Scene);
begin
if Create_Tree then
begin
Tad_Scene.Create_New_Scene (The_Scene, The_Name.all);
if Scene_Tree.Element_Exist
(The_Scene_Tree.Object, The_Scene) then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
The_Node.Left := Tad_Scene.Get_Code (The_Scene);
Put_Line ("creation d'un noeud scene sur : " &
The_Name.all);
Ok := True;
end;
else
Ok := False;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Scene;
function Mknode_Puis return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Puis);
begin
if Create_Tree then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Put_Line ("Creation du noeud PUIS");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Puis;
function Mknode_Attendre
(The_Name : Pstring; The_Type : Token.Object) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Attendre);
The_Leaf : Tad_Abstract.Object :=
Tad_Abstract.Create_Leaf (The_Name, The_Type);
Type_Node : Tad_Abstract.Node_Name;
use Tad_Abstract;
begin
if Create_Tree then
begin
if Tad_Abstract.Type_Of_Node (The_Leaf) =
Node_Name'(Feuille_Id) then
Ok := True;
elsif Tad_Abstract.Type_Of_Node (The_Leaf) =
Node_Name'(Feuille_Temp) then
Ok := True;
else -- garde non deboggee
Ok := True;
end if;
if Ok then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
The_Node.Left := new Tad_Abstract.Object'(The_Leaf);
Put ("Creation d'un noeud ATTENDRE avec : " &
The_Name.all);
Put_Line (" dont le Type est : " &
Token.Object'Image (The_Type));
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Attendre;
function Mknode_Faire return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Faire);
begin
if Create_Tree then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Pointer_Level.Enter (Tmp_Code_Tree);
Tmp_Code_Tree := The_Node.Left;
Put_Line ("Creation du noeud FAIRE");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Faire;
function Mknode_Fin_Faire return Boolean is
Ok : Boolean := False;
begin
if Create_Tree then
begin
Tmp_Code_Tree := Pointer_Level.Release;
Put_Line ("Creation du noeud FIN FAIRE");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Fin_Faire;
function Mknode_Au_Temps
(Value : Pstring; The_Type : Token.Object) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Au_Temps);
The_Leaf : Tad_Abstract.Object :=
Tad_Abstract.Create_Leaf (Value, The_Type);
Type_Node : Tad_Abstract.Node_Name;
use Tad_Abstract;
begin
if Create_Tree then
begin
if Tad_Abstract.Type_Of_Node (The_Leaf) =
Node_Name'(Feuille_Id) then
Ok := True;
elsif Tad_Abstract.Type_Of_Node (The_Leaf) =
Node_Name'(Feuille_Temp) then
Ok := True;
else
Ok := True;
end if;
if Ok then
begin
Put_Line ("autemps");
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
The_Node.Left := new Tad_Abstract.Object'(The_Leaf);
Put ("Creation d'un noeud AU TEMPS avec : " &
Value.all);
Put_Line (" dont le Type est : " &
Token.Object'Image (The_Type));
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Au_Temps;
function Mknode_Si_Cond return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Si);
begin
if Create_Tree then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Pointer_Level.Enter (Tmp_Code_Tree);
Pointer_Level.Enter (The_Node.Right);
Pointer_Level.Enter (The_Node.Left);
Tmp_Code_Tree := null;
Put_Line ("Creation du noeud SI COND");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Si_Cond;
function Mknode_Operateur (Operateur_Type : Token.Object) return Boolean is
Ok : Boolean := False;
Node_Type : Tad_Abstract.Node_Name;
begin
if Create_Tree then
begin
case Operateur_Type is
when Token.L_Egal =>
Node_Type := Tad_Abstract.N_Egal;
Ok := True;
when Token.L_Inf =>
Node_Type := Tad_Abstract.N_Inf;
Ok := True;
when Token.L_Sup =>
Node_Type := Tad_Abstract.N_Sup;
Ok := True;
when Token.L_Inf_Ou_Egal =>
Node_Type := Tad_Abstract.N_Inf_Egal;
Ok := True;
when Token.L_Sup_Ou_Egal =>
Node_Type := Tad_Abstract.N_Sup_Egal;
Ok := True;
when others =>
Ok := False;
end case;
declare
The_Node : Tad_Abstract.Object (Node_Type);
begin
The_Node.Left := Tmp_Code_Tree;
Tmp_Code_Tree := Pointer_Level.Release;
Tmp_Code_Tree := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := The_Node.Right;
end;
Put_Line ("Creation du noeud OPERATEUR");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Operateur;
function Mknode_Si_Alors return Boolean is
Ok : Boolean := False;
begin
if Create_Tree then
begin
Tmp_Code_Tree := Pointer_Level.Release;
Put_Line ("Creation du noeud SI ALORS");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Si_Alors;
function Mknode_Fin_Si return Boolean is
Ok : Boolean := False;
begin
if Create_Tree then
begin
Tmp_Code_Tree := Pointer_Level.Release;
Put_Line ("Creation du noeud FIN SI");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Fin_Si;
function Mknode_Repeter
(Value : Pstring; The_Type : Token.Object) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Repeter);
The_Leaf : Tad_Abstract.Object :=
Tad_Abstract.Create_Leaf (Value, The_Type);
Type_Node : Tad_Abstract.Node_Name;
use Tad_Abstract;
begin
if Create_Tree then
begin
if Tad_Abstract.Type_Of_Node (The_Leaf) =
Node_Name'(Feuille_Id) then
Ok := True;
elsif Tad_Abstract.Type_Of_Node (The_Leaf) =
Node_Name'(Feuille_Entier) then
Ok := True;
else
Ok := True; -- pb sur la garde
end if;
if Ok then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Pointer_Level.Enter (Chain.Right);
Tmp_Code_Tree := The_Node.Right;
The_Node.Left := new Tad_Abstract.Object'(The_Leaf);
Put ("Creation d'un noeud REPETER avec : " & Value.all);
Put_Line (" dont le Type est : " &
Token.Object'Image (The_Type));
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Repeter;
function Mknode_Fin_Repeter return Boolean is
Ok : Boolean := False;
begin
if Create_Tree then
begin
Tmp_Code_Tree := Pointer_Level.Release;
Put_Line ("Creation du noeud FIN REPETER");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Fin_Repeter;
function Mknode_Activer
(Station : Pstring; Actor : Pstring) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Activer);
Station_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Station);
Actor_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Acteur);
The_Station : Tad_Global.Object;
The_Material : Tad_Material.Object;
The_Actor_Tree : Actor_Tree.Object;
The_Actor : Tad_Actor.Object;
begin
if Create_Tree then
begin
if Actor_Of_Station_Exist (Station, Actor) then
begin
Tad_Global.Create_New_Station
(The_Station, Station.all);
Station_Leaf.Station :=
Tad_Global.Get_Station_Number (The_Station);
Tad_Global.Get_Material_Type
(The_Station, The_Material);
Tad_Material.Get_Actors (The_Material, The_Actor_Tree);
Tad_Actor.Create_New_Actor (The_Actor, Actor.all);
Actor_Leaf.Acteur := Tad_Actor.What_Address (The_Actor);
The_Node.Left := new Tad_Abstract.Object'(Station_Leaf);
The_Node.Right := new Tad_Abstract.Object'(Actor_Leaf);
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Ok := True;
Put ("Creation du noeud ACTIVER sur station : " &
Station.all);
Put_Line (" L'acteur : " & Actor.all);
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Activer;
function Mknode_Desactiver
(Station : Pstring; Actor : Pstring) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Desactiver);
Station_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Station);
Actor_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Acteur);
The_Station : Tad_Global.Object;
The_Material : Tad_Material.Object;
The_Actor_Tree : Actor_Tree.Object;
The_Actor : Tad_Actor.Object;
begin
if Create_Tree then
begin
if Actor_Of_Station_Exist (Station, Actor) then
begin
Tad_Global.Create_New_Station
(The_Station, Station.all);
Station_Leaf.Station :=
Tad_Global.Get_Station_Number (The_Station);
Tad_Global.Get_Material_Type
(The_Station, The_Material);
Tad_Material.Get_Actors (The_Material, The_Actor_Tree);
Tad_Actor.Create_New_Actor (The_Actor, Actor.all);
Actor_Leaf.Acteur := Tad_Actor.What_Address (The_Actor);
The_Node.Left := new Tad_Abstract.Object'(Station_Leaf);
The_Node.Right := new Tad_Abstract.Object'(Actor_Leaf);
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Ok := True;
Put ("Creation du noeud DESACTIVER sur station : " &
Station.all);
Put_Line (" L'acteur : " & Actor.all);
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Desactiver;
function Mknode_Experience (The_Name : Pstring) return Boolean is
Ok : Boolean := False;
The_Exp : Tad_Experience.Object;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Exp);
begin
if Create_Tree then
begin
Tad_Experience.Create_New_Experience (The_Exp, The_Name.all);
if Experience_Tree.Element_Exist
(The_Experience_Tree.Object, The_Exp) then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
The_Node.Left := Tad_Experience.Get_Code (The_Exp);
Pointer_Level.Enter (Tmp_Code_Tree);
Tmp_Code_Tree := The_Node.Right;
Put_Line ("Creation du noeud EXPERIENCE sur : " &
The_Name.all);
Ok := True;
end;
else
Ok := False;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Experience;
function Mknode_Param
(Value : Pstring; The_Type : Token.Object) return Boolean is
Ok : Boolean := False;
The_Node : Tad_Abstract.Object (Tad_Abstract.Param);
The_Leaf : Tad_Abstract.Object :=
Tad_Abstract.Create_Leaf (Value, The_Type);
begin
if Create_Tree then
begin
Tmp_Code_Tree := new Tad_Abstract.Object'(The_Node);
The_Node.Left := new Tad_Abstract.Object'(The_Leaf);
Tmp_Code_Tree := The_Node.Right;
Put ("Creation d'un noeud PARAMETRE avec : " & Value.all);
Put_Line (" dont le Type est : " &
Token.Object'Image (The_Type));
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Param;
function Mknode_Fin_Param return Boolean is
Ok : Boolean := False;
begin
if Create_Tree then
begin
Tmp_Code_Tree := Pointer_Level.Release;
Put_Line ("Creation du noeud FIN PARAMETRE");
Ok := True;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Fin_Param;
function Mknode_Fugitif
(Station : Pstring; Actor : Pstring) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Fugitif);
Station_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Station);
Actor_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Acteur);
The_Station : Tad_Global.Object;
The_Material : Tad_Material.Object;
The_Actor_Tree : Actor_Tree.Object;
The_Actor : Tad_Actor.Object;
begin
if Create_Tree then
begin
if Actor_Of_Station_Exist (Station, Actor) then
begin
Tad_Global.Create_New_Station
(The_Station, Station.all);
Station_Leaf.Station :=
Tad_Global.Get_Station_Number (The_Station);
Tad_Global.Get_Material_Type
(The_Station, The_Material);
Tad_Material.Get_Actors (The_Material, The_Actor_Tree);
Tad_Actor.Create_New_Actor (The_Actor, Actor.all);
Actor_Leaf.Acteur := Tad_Actor.What_Address (The_Actor);
The_Node.Left := new Tad_Abstract.Object'(Station_Leaf);
The_Node.Right := new Tad_Abstract.Object'(Actor_Leaf);
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Ok := True;
Put ("Creation du noeud FUGITIF sur station : " &
Station.all);
Put_Line (" L'acteur : " & Actor.all);
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Fugitif;
function Mknode_Temporel (Station : Pstring;
Actor : Pstring;
Value : Pstring;
The_Type : Token.Object;
Time : Pstring;
The_Time_Type : Token.Object) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Temporel);
The_Sec_Node : Tad_Abstract.Object (Tad_Abstract.Qui);
The_Third_Node : Tad_Abstract.Object (Tad_Abstract.Quoi);
Station_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Station);
Actor_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Acteur);
Value_Leaf : Tad_Abstract.Object :=
Tad_Abstract.Create_Leaf (Value, The_Type);
Time_Leaf : Tad_Abstract.Object :=
Tad_Abstract.Create_Leaf (Time, The_Time_Type);
The_Station : Tad_Global.Object;
The_Material : Tad_Material.Object;
The_Actor_Tree : Actor_Tree.Object;
The_Actor : Tad_Actor.Object;
use Token;
begin
if Create_Tree then
begin
if Actor_Of_Station_Exist (Station, Actor) then
-- and ((The_Type = L_Int) or (The_Type = L_Id)) and
-- ((The_Time_Type = L_Id) or (The_Time_Type = L_Time)) then
begin
Tad_Global.Create_New_Station
(The_Station, Station.all);
Station_Leaf.Station :=
Tad_Global.Get_Station_Number (The_Station);
Tad_Global.Get_Material_Type
(The_Station, The_Material);
Tad_Material.Get_Actors (The_Material, The_Actor_Tree);
Tad_Actor.Create_New_Actor (The_Actor, Actor.all);
Actor_Leaf.Acteur := Tad_Actor.What_Address (The_Actor);
The_Node.Left := new Tad_Abstract.Object'(Station_Leaf);
The_Node.Right := new
Tad_Abstract.Object'(The_Sec_Node);
The_Sec_Node.Left :=
new Tad_Abstract.Object'(Actor_Leaf);
The_Sec_Node.Right :=
new Tad_Abstract.Object'(The_Third_Node);
The_Third_Node.Left :=
new Tad_Abstract.Object'(Value_Leaf);
The_Third_Node.Right :=
new Tad_Abstract.Object'(Time_Leaf);
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Put ("Creation du noeud TEMPOREL sur station : " &
Station.all);
Put_Line (" L'acteur : " & Actor.all);
Put ("Avec la valeur : " & Value.all);
Put (" de Type : " & Token.Object'Image (The_Type));
Put (" est La duree : " & Time.all);
Put_Line (" de Type : " &
Token.Object'Image (The_Time_Type));
Ok := True;
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Temporel;
function Mknode_Discret (Station : Pstring;
Actor : Pstring;
Value : Pstring;
The_Type : Token.Object) return Boolean is
Ok : Boolean := False;
Chain : Tad_Abstract.Object (Tad_Abstract.Chainage);
The_Node : Tad_Abstract.Object (Tad_Abstract.Discret);
The_Sec_Node : Tad_Abstract.Object (Tad_Abstract.Qui);
Station_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Station);
Actor_Leaf : Tad_Abstract.Object (Tad_Abstract.Feuille_Acteur);
Value_Leaf : Tad_Abstract.Object :=
Tad_Abstract.Create_Leaf (Value, The_Type);
The_Station : Tad_Global.Object;
The_Material : Tad_Material.Object;
The_Actor_Tree : Actor_Tree.Object;
The_Actor : Tad_Actor.Object;
use Token;
begin
if Create_Tree then
begin
if Actor_Of_Station_Exist (Station, Actor) then
-- and ((The_Type = L_Int) or (The_Type = L_Id)) then
begin
Tad_Global.Create_New_Station
(The_Station, Station.all);
Station_Leaf.Station :=
Tad_Global.Get_Station_Number (The_Station);
Tad_Global.Get_Material_Type
(The_Station, The_Material);
Tad_Material.Get_Actors (The_Material, The_Actor_Tree);
Tad_Actor.Create_New_Actor (The_Actor, Actor.all);
Actor_Leaf.Acteur := Tad_Actor.What_Address (The_Actor);
The_Node.Left := new Tad_Abstract.Object'(Station_Leaf);
The_Node.Right := new
Tad_Abstract.Object'(The_Sec_Node);
The_Sec_Node.Left :=
new Tad_Abstract.Object'(Actor_Leaf);
The_Sec_Node.Right :=
new Tad_Abstract.Object'(Value_Leaf);
Tmp_Code_Tree := new Tad_Abstract.Object'(Chain);
Chain.Left := new Tad_Abstract.Object'(The_Node);
Tmp_Code_Tree := Chain.Right;
Put ("Creation du noeud DISCRET sur station : " &
Station.all);
Put (" L'acteur : " & Actor.all);
Put (" avec la valeur : " & Value.all);
Put_Line (" de Type : " &
Token.Object'Image (The_Type));
Ok := True;
end;
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Discret;
function Mknode_Eval
(Value : Pstring;
The_Type : Token.Object;
Operator : Token.Object := Token.L_Unk) return Boolean is
Ok : Boolean := False;
begin
if Create_Tree then
begin
Put ("Creation du noeud EVALUATION sur la valeur : ");
Put (Value.all & " de type : " & Token.Object'Image (The_Type));
Put_Line (" et l'operateur : " & Token.Object'Image (Operator));
Ok := True;
null;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Eval;
function Mknode_Priorite (Priority : Token.Object) return Boolean is
Ok : Boolean := False;
The_Node : Tad_Abstract.Object (Tad_Abstract.N_Parent);
begin
if Create_Tree then
begin
case Priority is
when Token.L_Parentheseg =>
Tmp_Code_Tree := new Tad_Abstract.Object'(The_Node);
Pointer_Level.Enter (Tmp_Code_Tree);
Tmp_Code_Tree := The_Node.Left;
Ok := True;
when Token.L_Parenthesed =>
Tmp_Code_Tree := Pointer_Level.Release;
Ok := True;
when others =>
Ok := False;
end case;
if Ok then
Put_Line ("Creation du noeud PRIORITE");
end if;
end;
else
Ok := True;
end if;
return Ok;
end Mknode_Priorite;
end Tds;