|
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: 29696 (0x7400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Condition, seg_0499f5
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Mots;
with Interface_Structure;
with Variables;
with Main_Player;
with Error;
with Text_Io;
package body Condition is
--- renvoie la valeur effective d'une variable
--- =>la variable 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;
-- variables qui est affectee dans les evaluations de deplacement
Current_Sens : Integer renames Variables.Var_Sens;
procedure Copy_Tab (T1 : in out T_Tab_Of_Parameter;
T2 : T_Tab_Of_Parameter) is
begin
for I in T1'Range loop
Nos_Chaines.Copy (T1 (I).Value, T2 (I).Value);
T1 (I).Typ := T2 (I).Typ;
end loop;
end Copy_Tab;
-- converti le type d'une variable en type parametre
function Type_Of_Value (T : Nos_Chaines.String_Text) return T_Parameter is
Typ : T_Parameter; begin
Typ := T_Parameter'Value (Nos_Chaines.Infinite_String.Image (T));
if Typ = Positioncourante then
Typ := Lieu;
elsif Typ = Joueur then
Typ := Personnage;
end if;
return Typ;
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_In_Table (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;
-- verifie la compatiblite de deux parametres successifs
function Compatible (A : T_Parameter; B : T_Parameter) return Boolean is
use Condition;
begin
case A is
when Objet =>
if B = Existe or B = Contenu or B = Etat or
B = Position or B = Preposition then
return True;
end if;
when Personnage =>
if B = Existe or B = Possession or B = Etat or B = Position then
return True;
end if;
when Lieu =>
if B = Reliea or B = Etat or B = Equal or B = Sortie then
return True;
end if;
-- when Positioncourante =>
-- if B = Sortie then
-- return True;
-- end if;
when Communication =>
if B = Est or B = Equal or B = Etat then
return True;
end if;
when Est =>
if B = Dans then return True;
end if;
when Vers =>
if B = Lieu or B = Texte or B = Direction then
return True;
end if;
when Dans =>
if B = Lieu or B = Positioncourante then
return True;
end if;
when Position =>
if B = Lieu then
return True;
end if;
when Reliea =>
if B = Positioncourante or B = Lieu 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 Sortie =>
if B = Vers then
return True;
end if;
when Preposition =>
if B = Objet or B = Personnage then
return True;
end if;
when Compteur =>
if B = Greater_Than or B = Less_Than or B = Equal then
return True;
end if;
when Greater_Than | Less_Than =>
if B = Number then
return True;
end if;
when Equal =>
if B = Number or B = Lieu or B = Personnage or B = Objet then
return True;
end if;
when Verbe =>
if B = Communication or B = Lieu or B = Personnage or
B = Objet or B = Texte or B = Direction then
return True;
end if;
when others =>
return False;
end case;
return False;
end Compatible;
--- regarde si un identificateur est un operateur booleen
function Is_Comparateur (P : Nos_Chaines.String_Text) return Boolean is
begin
if Nos_Chaines.Equal (P, Nos_Chaines.Infinite_String.Value (">")) or
Nos_Chaines.Equal (P, Nos_Chaines.Infinite_String.Value ("<")) or
Nos_Chaines.Equal (P, Nos_Chaines.Infinite_String.Value ("=")) then
return True;
else
return False;
end if;
end Is_Comparateur;
--- renvoie le type comparateur d une variable
function To_Type_Comparateur
(P : Nos_Chaines.String_Text) return T_Comparateur is
begin
if Nos_Chaines.Equal (P, Nos_Chaines.Infinite_String.Value (">")) then
return Greater;
elsif Nos_Chaines.Equal (P,
Nos_Chaines.Infinite_String.Value ("<")) then
return Less;
else
return Equal_As;
end if;
end To_Type_Comparateur;
--- evalue une expression
function Evaluate (The_Condition : T_Expression) return Boolean is
Ok : Boolean;
The_Commande : Main_Player.T_Commande;
I : Integer;
The_Destination, The_Direction, The_Communication, The_Place :
Nos_Chaines.String_Text;
use Interface_Structure;
begin
Mots.Copy_Nul_Command (The_Commande);
case The_Condition.Typ is
when Type_Action =>
Mots.Copy_Commande (The_Commande, Main_Player.Get_Commande);
if The_Commande.Size_Of_Commande /=
The_Condition.Number_Of_Parameters then
Ok := False;
else
Ok := True;
if Nos_Chaines.Equal (The_Condition.Parameters (1).Value,
The_Commande.Tab_Commande (1)) then
if The_Commande.Size_Of_Commande > 1 then
if Variables.Is_Generic
(The_Condition.Parameters (2).Value) then
if The_Condition.Parameters (2).Typ =
Direction then
Nos_Chaines.Copy
(Variables.Var_Generic
(Variables.Get_Index
(The_Condition.Parameters (2).
Value)),
The_Commande.Tab_Commande (2));
else
if Wich_Type
(The_Commande.Tab_Commande (2)) =
The_Condition.Parameters (2).Typ then
Nos_Chaines.Copy
(Variables.Var_Generic
(Variables.Get_Index
(The_Condition.Parameters
(2).Value)),
The_Commande.Tab_Commande (2));
end if;
end if;
else
I := 2;
loop
exit when I > The_Commande.Size_Of_Commande;
if not Nos_Chaines.Equal
(The_Condition.Parameters (I).
Value, The_Commande.Tab_Commande
(I)) then
Ok := False;
end if;
I := I + 1;
end loop;
end if;
end if;
else
Ok := False;
end if;
end if;
return Ok;
when Type_Recherche =>
if The_Condition.Number_Of_Parameters = 2 then
return Search_For_Variable
(Var => Convert
(The_Condition.Parameters (1).Value));
elsif The_Condition.Number_Of_Parameters = 3 then
if The_Condition.Parameters (1).Typ /= Lieu then
if The_Condition.Parameters (1).Typ = Communication then
return
Search_For
(Var =>
Convert
(The_Condition.Parameters (1).Value),
Sens => Current_Sens,
Field => The_Condition.Parameters (2).Value,
Value =>
Convert
(The_Condition.Parameters (3).Value));
else
return
Search_For
(Var =>
Convert
(The_Condition.Parameters (1).Value),
Field => The_Condition.Parameters (2).Value,
Value =>
Convert
(The_Condition.Parameters (3).Value));
end if;
else
Nos_Chaines.Copy
(The_Destination,
Convert (The_Condition.Parameters (1).Value));
Nos_Chaines.Copy
(The_Place, Convert
(The_Condition.Parameters (3).Value));
Search_Link_To_Place (Place => The_Place,
Destination => The_Destination,
Sortie => Variables.Var_Sortie,
Sens => Current_Sens,
Is_Found => Ok);
return Ok;
end if;
else
if The_Condition.Parameters (2).Typ = Est then
Nos_Chaines.Copy
(The_Communication,
Convert (The_Condition.Parameters (1).Value));
Nos_Chaines.Copy
(The_Place, Convert
(The_Condition.Parameters (4).Value));
Search_Communication
(Place => The_Place,
Communication => The_Communication,
Sortie => Variables.Var_Sortie,
Sens => Current_Sens,
Is_Found => Ok);
return Ok;
elsif The_Condition.Parameters (4).Typ = Lieu then
Nos_Chaines.Copy
(The_Destination,
Convert (The_Condition.Parameters (4).Value));
Nos_Chaines.Copy
(The_Place, Convert
(The_Condition.Parameters (1).Value));
Search_Exit_To_Place (Place => The_Place,
Destination => The_Destination,
Sortie => Variables.Var_Sortie,
Sens => Current_Sens,
Is_Found => Ok);
return Ok;
else
Nos_Chaines.Copy
(The_Direction,
Convert (The_Condition.Parameters (4).Value));
Nos_Chaines.Copy
(The_Place, Convert
(The_Condition.Parameters (1).Value));
Search_Exit_To_Direction
(Place => The_Place,
Direction => The_Direction,
Sortie => Variables.Var_Sortie,
Sens => Current_Sens,
Is_Found => Ok);
return Ok;
end if;
end if;
when Type_Egalite =>
if The_Condition.Size_Of_Member1 /=
The_Condition.Size_Of_Member2 then
return Nos_Chaines.Equal
(Get_Position
(Convert (The_Condition.Member1 (1).Value)),
Convert (The_Condition.Member2 (1).Value));
else
if The_Condition.Member1 (2).Typ = Etat then
Text_Io.Put_Line ("ETAT");
return Compare_Etat
(Convert (The_Condition.Member1 (1).Value),
Convert (The_Condition.Member2 (1).Value));
elsif The_Condition.Member1 (2).Typ = Possession then
Text_Io.Put_Line ("POSSESSION ");
return Compare_Possession
(Convert (The_Condition.Member1 (1).Value),
Convert (The_Condition.Member2 (1).Value));
else
Text_Io.Put_Line ("POSITION 2");
return Compare_Position
(Convert (The_Condition.Member1 (1).Value),
Convert (The_Condition.Member2 (1).Value));
end if;
end if;
when Type_Comparaison =>
case The_Condition.Operator is
when Greater =>
return Get_Value_Of_Counter (The_Condition.Id) >
The_Condition.Value;
when Less =>
return Get_Value_Of_Counter (The_Condition.Id) <
The_Condition.Value;
when Equal_As =>
return Get_Value_Of_Counter (The_Condition.Id) =
The_Condition.Value;
end case;
end case;
return True;
end Evaluate;
-- evalue un arbre
procedure Evaluate_Tree (P : P_Node) is
begin
if P.Typ = Type_Node then
Evaluate_Tree (P.Left);
if P.Right /= null then
Evaluate_Tree (P.Right);
end if;
case P.Operator is
when Et =>
P.Result := P.Left.Result and P.Right.Result;
when Ou =>
P.Result := P.Left.Result or P.Right.Result;
when Non =>
P.Result := not P.Left.Result;
end case;
else
P.Result := Evaluate (P.Expression);
end if;
end Evaluate_Tree;
-- evalue une condition et renvoie le resultat
function Evaluate (P : T_Condition) return Boolean is
begin
Evaluate_Tree (P);
return P.Result;
end Evaluate;
-- cree une nouvelle feuille
function Make_Node (The_Expression : T_Expression) return P_Node is
New_Node : P_Node;
begin
New_Node := new T_Node (Type_Leaf);
New_Node.Expression := The_Expression;
return New_Node;
end Make_Node;
-- cree un nouveau noeud avec operateur binaire
function Make_Node
(Op : Boolean_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;
-- cree un nouveau noeud avec operateur unaire
function Make_Node
(Op : Boolean_Operator; Neg_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 := Neg_Node;
New_Node.Right := null;
return New_Node;
end Make_Node;
end Condition;
nblk1=1c
nid=d
hdr6=2a
[0x00] rec0=1c rec1=00 rec2=01 rec3=002
[0x01] rec0=1f rec1=00 rec2=05 rec3=068
[0x02] rec0=1b rec1=00 rec2=11 rec3=002
[0x03] rec0=1d rec1=00 rec2=1c rec3=024
[0x04] rec0=23 rec1=00 rec2=08 rec3=006
[0x05] rec0=18 rec1=00 rec2=0b rec3=020
[0x06] rec0=17 rec1=00 rec2=1a rec3=010
[0x07] rec0=10 rec1=00 rec2=19 rec3=07c
[0x08] rec0=11 rec1=00 rec2=18 rec3=042
[0x09] rec0=16 rec1=00 rec2=13 rec3=06c
[0x0a] rec0=11 rec1=00 rec2=17 rec3=020
[0x0b] rec0=12 rec1=00 rec2=03 rec3=064
[0x0c] rec0=03 rec1=00 rec2=12 rec3=008
[0x0d] rec0=12 rec1=00 rec2=09 rec3=016
[0x0e] rec0=17 rec1=00 rec2=16 rec3=014
[0x0f] rec0=12 rec1=00 rec2=0e rec3=080
[0x10] rec0=13 rec1=00 rec2=1b rec3=038
[0x11] rec0=21 rec1=00 rec2=0c rec3=00a
[0x12] rec0=04 rec1=00 rec2=02 rec3=020
[0x13] rec0=1f rec1=00 rec2=0f rec3=000
[0x14] rec0=05 rec1=00 rec2=06 rec3=000
[0x15] rec0=15 rec1=00 rec2=0d rec3=020
[0x16] rec0=1f rec1=00 rec2=0f rec3=000
[0x17] rec0=05 rec1=00 rec2=06 rec3=000
[0x18] rec0=1b rec1=00 rec2=03 rec3=020
[0x19] rec0=1e rec1=00 rec2=0f rec3=078
[0x1a] rec0=0c rec1=00 rec2=06 rec3=000
[0x1b] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x215471114866063a73eb7 0x42a00088462060003
Free Block Chain:
0xd: 0000 00 04 02 d0 80 13 20 6e 6f 74 20 50 2e 4c 65 66 ┆ not P.Lef┆
0x4: 0000 00 07 00 73 80 3b 20 20 20 20 20 20 20 20 20 20 ┆ s ; ┆
0x7: 0000 00 0a 00 46 80 07 6f 6d 6d 61 6e 64 65 07 00 39 ┆ F ommande 9┆
0xa: 0000 00 15 03 fa 80 02 74 3b 02 00 32 20 20 20 20 20 ┆ t; 2 ┆
0x15: 0000 00 14 03 fc 80 01 6e 01 00 49 20 20 20 20 20 20 ┆ n I ┆
0x14: 0000 00 10 01 6b 80 0b 66 5f 43 6f 6d 6d 61 6e 64 65 ┆ k f_Commande┆
0x10: 0000 00 00 03 fc 80 0f 20 50 72 65 70 6f 73 69 74 69 ┆ Prepositi┆