|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - download
Length: 20480 (0x5000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Expression_Fonction, seg_048dfc
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Interface_Structure;
with Text_Io;
with Variables;
with Error;
with Display;
package body Expression_Fonction is
--- nom des fonctions predefinies
type T_Name_Function is (Afficher, Ajouter, Creer, Decrire, Deplacer,
Detruire, Findujeu, Informer, Inventaire,
Joueur, Modifierdescription, Supprimer);
--- renvoie la valeur effective d'une variable
--- =>la variables retournee existe dans l'arbre de sauvegarde des variables
function Convert (P : Nos_Chaines.String_Text)
return Nos_Chaines.String_Text renames Variables.Get_Value;
function Type_Of_Value (T : Nos_Chaines.String_Text) return T_Parameter is
begin
return T_Parameter'Value (Nos_Chaines.Infinite_String.Image (T));
exception
when Constraint_Error =>
return Unknown;
end Type_Of_Value;
-- renvoie le type du parametre d'une valeur
function Wich_Type (T : Nos_Chaines.String_Text) return T_Parameter is
Tmp_Type : T_Parameter;
begin
if Interface_Structure.Is_A_Variable (T) then
Tmp_Type := T_Parameter'Val (Interface_Structure.Type_Of_Var'Pos
(Interface_Structure.Get_Type (T)));
else
Tmp_Type := Type_Of_Value (T);
end if;
return Tmp_Type;
end Wich_Type;
-- converti une chaine de caracteres en type numeric_operator
function To_Numeric_Operator
(P : Nos_Chaines.String_Text) return Numeric_Operator is
begin
if Nos_Chaines.Equal (P, Nos_Chaines.Infinite_String.Value ("/")) then
return Div;
elsif Nos_Chaines.Equal (P,
Nos_Chaines.Infinite_String.Value ("+")) then
return Plus;
elsif Nos_Chaines.Equal (P,
Nos_Chaines.Infinite_String.Value ("-")) then
return Moins;
elsif Nos_Chaines.Equal (P,
Nos_Chaines.Infinite_String.Value ("*")) then
return Mult;
else
return Modulo;
end if;
end To_Numeric_Operator;
-- verifie la compatiblite de deux parametres successifs
function Compatible (A : Expression_Fonction.T_Parameter;
B : Expression_Fonction.T_Parameter) return Boolean is
use Expression_Fonction;
begin
case A is
when Objet =>
if B = Vers or B = Contenu or B = Etat then
return True;
end if;
when Personnage | Joueur =>
if B = Vers or B = Possession or B = Etat then
return True;
end if;
when Lieu =>
if B = Etat then
return True;
end if;
when Communication =>
if B = Sens1 or B = Sens2 or B = Etat then
return True;
end if;
when Est =>
if B = Personnage then
return True;
end if;
when Vers =>
if B = Lieu or B = Sortie then
return True;
end if;
when Sens1 | Sens2 =>
if B = Etat then
return True;
end if;
when Possession | Contenu =>
if B = Objet then
return True;
end if;
when Etat =>
if B = Texte then
return True;
end if;
when others =>
return False;
end case;
return False;
end Compatible;
--- renvoie le nom type d'une fonction predefinie
function Get_Type_Of_Function
(Name : Nos_Chaines.String_Text) return T_Name_Function is
begin
return T_Name_Function'Value (Nos_Chaines.Infinite_String.Image (Name));
end Get_Type_Of_Function;
--- execute une fonction predefinie
procedure Execute_Function (The_Function : T_Fonction_Predefinie) is
Typ : T_Name_Function;
use Interface_Structure;
I : Integer := 1;
begin
Typ := Get_Type_Of_Function (The_Function.Name);
Text_Io.Put_Line ("-------------------------------------");
Text_Io.Put (T_Name_Function'Image (Typ) & " ");
loop
exit when I > The_Function.Number_Of_Parameters;
Nos_Chaines.Print (The_Function.Parameters (I).Value);
I := I + 1;
end loop;
Nos_Chaines.Print_Line (Variables.Var_Sortie);
Text_Io.Put_Line ("-------------------------------------");
case Typ is
when Afficher =>
if The_Function.Parameters (1).Typ = Texte then
Display.Write_On_World (The_Function.Parameters (1).Value);
else
Display.Write_On_World
(Integer'Image (Interface_Structure.Get_Value_Of_Counter
(The_Function.Parameters (1).Value)));
end if;
when Ajouter =>
if The_Function.Number_Of_Parameters = 3 then
if The_Function.Parameters (2).Typ = Possession then
Add_Possession
(Var => Convert (The_Function.Parameters (1).Value),
Possession =>
Convert (The_Function.Parameters (3).Value));
elsif The_Function.Parameters (2).Typ = Contenu then
Add_Contenu
(Var => Convert (The_Function.Parameters (1).Value),
Contenu => Convert
(The_Function.Parameters (3).Value));
elsif The_Function.Parameters (2).Typ = Etat then
if The_Function.Parameters (1).Typ /= Communication then
Add_Etat
(Var => Convert
(The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (3).Value);
else
Add_Etat_Sens1
(Var => Convert
(The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (3).Value);
end if;
end if;
else
if The_Function.Parameters (2).Typ = Sens1 then
Add_Etat_Sens1
(Var => Convert (The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (4).Value);
else
Add_Etat_Sens2
(Var => Convert (The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (4).Value);
end if;
end if;
when Creer =>
Create_Var (Var => The_Function.Parameters (1).Value);
when Decrire =>
if The_Function.Number_Of_Parameters = 1 then
if The_Function.Parameters (1).Typ /= Communication then
Print_Description
(Var => Convert (The_Function.Parameters (1).Value));
else
Print_Description_Sens1
(Var => Convert (The_Function.Parameters (1).Value));
end if;
else
if The_Function.Parameters (2).Typ = Sens1 then
Print_Description_Sens1
(Var => Convert (The_Function.Parameters (1).Value));
else
Print_Description_Sens2
(Var => Convert (The_Function.Parameters (1).Value));
end if;
end if;
when Deplacer =>
if The_Function.Parameters (1).Typ = Joueur then
if not Variables.Deplacement_Is_Done then
Move_To (Var =>
Convert (The_Function.Parameters (1).Value),
To => Convert
(The_Function.Parameters (3).Value));
Variables.Deplacement_Is_Done := True;
Text_Io.Put_Line ("JOUEUR EST DEPLACE");
end if;
else
Move_To (Var => The_Function.Parameters (1).Value,
To => Convert (The_Function.Parameters (3).Value));
Text_Io.Put_Line ("UN PERSONNAGE EST DEPLACE");
end if;
when Detruire =>
Kill_Var (Var => The_Function.Parameters (1).Value);
when Findujeu =>
Variables.Fin_Du_Jeu := True;
when Informer =>
if The_Function.Number_Of_Parameters = 1 then
Print_Etat (Var => Convert
(The_Function.Parameters (1).Value));
else
if The_Function.Parameters (2).Typ = Sens1 then
Print_Etat_Sens1
(Var => Convert (The_Function.Parameters (1).Value));
else
Print_Etat_Sens2
(Var => Convert (The_Function.Parameters (1).Value));
end if;
end if;
when Inventaire =>
if The_Function.Parameters (1).Typ = Personnage then
Print_Possession
(Var => Convert (The_Function.Parameters (1).Value));
else
Print_Contenu
(Var => Convert (The_Function.Parameters (1).Value));
end if;
when Joueur =>
Nos_Chaines.Copy (Variables.Var_Joueur,
The_Function.Parameters (2).Value);
Interface_Structure.Create_Var
(The_Function.Parameters (2).Value);
when Modifierdescription =>
if The_Function.Number_Of_Parameters = 2 then
if The_Function.Parameters (1).Typ /= Communication then
Modify_Description
(Var => Convert (The_Function.Parameters (1).Value),
Description => The_Function.Parameters (2).Value);
else
Modify_Description_Sens1
(Var => Convert (The_Function.Parameters (1).Value),
Description => The_Function.Parameters (2).Value);
end if;
else
if The_Function.Parameters (2).Typ = Sens1 then
Modify_Description_Sens1
(Var => Convert (The_Function.Parameters (1).Value),
Description => The_Function.Parameters (3).Value);
else
Modify_Description_Sens2
(Var => Convert (The_Function.Parameters (1).Value),
Description => The_Function.Parameters (3).Value);
end if;
end if;
when Supprimer =>
if The_Function.Number_Of_Parameters = 3 then
if The_Function.Parameters (2).Typ = Possession then
Delete_Possession
(Var => Convert (The_Function.Parameters (1).Value),
Possession =>
Convert (The_Function.Parameters (3).Value));
elsif The_Function.Parameters (2).Typ = Contenu then
Delete_Contenu
(Var => Convert (The_Function.Parameters (1).Value),
Contenu => Convert
(The_Function.Parameters (3).Value));
elsif The_Function.Parameters (2).Typ = Etat then
if The_Function.Parameters (1).Typ /= Communication then
Delete_Etat
(Var => Convert
(The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (3).Value);
else
Delete_Etat_Sens1
(Var => Convert
(The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (3).Value);
end if;
end if;
else
if The_Function.Parameters (2).Typ = Sens1 then
Delete_Etat_Sens1
(Var => Convert (The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (4).Value);
else
Delete_Etat_Sens2
(Var => Convert (The_Function.Parameters (1).Value),
Etat => The_Function.Parameters (4).Value);
end if;
end if;
end case;
end Execute_Function;
--- evalue un arbre numerique
procedure Evaluate_Tree (P : T_Numeric_Function) is
begin
if P.Typ = Type_Node then
Evaluate_Tree (P.Left);
Evaluate_Tree (P.Right);
case P.Operator is
when Plus =>
P.Result := P.Left.Result + P.Right.Result;
when Moins =>
P.Result := P.Left.Result - P.Right.Result;
when Mult =>
P.Result := P.Left.Result * P.Right.Result;
when Div =>
P.Result := P.Left.Result / P.Right.Result;
when Modulo =>
P.Result := P.Left.Result mod P.Right.Result;
end case;
else
if P.Typ = Type_Leaf_Numeric then
P.Result := P.Value;
else
P.Result := Interface_Structure.Get_Value_Of_Counter (P.Id);
end if;
end if;
end Evaluate_Tree;
--- evalue une expression numerique et renvoie le resultat
function Evaluate (P : T_Numeric_Function) return Integer is
begin
Evaluate_Tree (P);
return P.Result;
end Evaluate;
--- cree une nouvelle feuille
function Make_Node (Typ : Selecteur; Val : Nos_Chaines.String_Text)
return P_Node is
New_Node : P_Node;
begin
New_Node := new T_Node (Typ);
case Typ is
when Type_Node =>
null;
when Type_Leaf_Numeric =>
New_Node.Value := Integer'Value
(Nos_Chaines.Infinite_String.Image (Val));
when Type_Leaf_Id =>
Nos_Chaines.Copy (New_Node.Id, Val);
end case;
return New_Node;
end Make_Node;
--- cree un nouveau noeud
function Make_Node
(Op : Numeric_Operator; Left_Node : P_Node; Right_Node : P_Node)
return P_Node is
New_Node : P_Node;
begin
New_Node := new T_Node (Type_Node);
New_Node.Operator := Op;
New_Node.Left := Left_Node;
New_Node.Right := Right_Node;
return New_Node;
end Make_Node;
end Expression_Fonction;
nblk1=13
nid=0
hdr6=26
[0x00] rec0=1d rec1=00 rec2=01 rec3=060
[0x01] rec0=17 rec1=00 rec2=06 rec3=084
[0x02] rec0=1f rec1=00 rec2=0a rec3=006
[0x03] rec0=21 rec1=00 rec2=10 rec3=012
[0x04] rec0=19 rec1=00 rec2=04 rec3=02a
[0x05] rec0=01 rec1=00 rec2=02 rec3=054
[0x06] rec0=13 rec1=00 rec2=09 rec3=048
[0x07] rec0=12 rec1=00 rec2=11 rec3=04c
[0x08] rec0=15 rec1=00 rec2=0b rec3=028
[0x09] rec0=14 rec1=00 rec2=12 rec3=01e
[0x0a] rec0=17 rec1=00 rec2=13 rec3=060
[0x0b] rec0=16 rec1=00 rec2=0c rec3=04c
[0x0c] rec0=01 rec1=00 rec2=03 rec3=078
[0x0d] rec0=14 rec1=00 rec2=08 rec3=02c
[0x0e] rec0=0f rec1=00 rec2=0d rec3=076
[0x0f] rec0=16 rec1=00 rec2=0f rec3=028
[0x10] rec0=1b rec1=00 rec2=05 rec3=008
[0x11] rec0=1d rec1=00 rec2=0e rec3=016
[0x12] rec0=0b rec1=00 rec2=07 rec3=000
tail 0x2174d17c4865a7e42c103 0x42a00088462060003