|
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: 24576 (0x6000)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Sc, seg_048764
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Interface_Structure;
with Variables;
with Interpreteur;
with Error;
with Text_Io;
package body Sc is
--- renvoie la valeur effective d'une variable
--- =>la variables retornee 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 then
return True;
end if;
when Personnage => -- | Joueur =>
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 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 : Interpreteur.T_Commande;
I : Integer;
The_Destination, The_Direction, The_Communication, The_Place :
Nos_Chaines.String_Text;
use Interface_Structure;
begin
Text_Io.Put_Line ("----------- go to evalue an " &
T_Evaluation'Image (The_Condition.Typ));
case The_Condition.Typ is
when Type_Action =>
if The_Commande.Size_Of_Commande /=
The_Condition.Number_Of_Parameters then
Ok := False;
else
Ok := True;
The_Commande := Interpreteur.Get_Commande;
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 Wich_Type (The_Commande.Tab_Commande (2)) =
The_Condition.Parameters (2).Typ then
Variables.Var_Generic
(Variables.Get_Index
(The_Condition.Parameters (2).
Value)) :=
The_Commande.Tab_Commande (2);
end if;
else
I := 3;
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;
I := I + 1;
end if;
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
The_Destination :=
Convert (The_Condition.Parameters (3).Value);
The_Place := Convert
(The_Condition.Parameters (1).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
The_Communication :=
Convert (The_Condition.Parameters (1).Value);
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
The_Destination :=
Convert (The_Condition.Parameters (4).Value);
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
The_Direction :=
Convert (The_Condition.Parameters (4).Value);
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
return Compare_Etat
(Convert (The_Condition.Member1 (1).Value),
Convert (The_Condition.Member2 (1).Value));
elsif The_Condition.Member1 (2).Typ = Possession then
return Compare_Possession
(Convert (The_Condition.Member1 (1).Value),
Convert (The_Condition.Member2 (1).Value));
else
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
if P.Left.Typ /= Type_Node then
Text_Io.Put_Line (" ----GAUCHE value --- ");
P.Left_Value := Evaluate (P.Left.Expression);
else
Text_Io.Put_Line (" ----GAUCHE node --- ");
Evaluate_Tree (P.Left);
P.Left_Value := P.Left.Result;
end if;
if P.Right /= null then
if P.Right.Typ /= Type_Node then
Text_Io.Put_Line (" ----DROITE node --- ");
P.Right_Value := Evaluate (P.Right.Expression);
else
Text_Io.Put_Line (" ----DROITE value --- ");
Evaluate_Tree (P.Right);
P.Right_Value := P.Right.Result;
end if;
end if;
case P.Operator is
when Et =>
P.Result := P.Left_Value and P.Right_Value;
Text_Io.Put_Line (Boolean'Image (P.Result) & " = " &
Boolean'Image (P.Left_Value) & " and " &
Boolean'Image (P.Right_Value));
when Ou =>
P.Result := P.Left_Value or P.Right_Value;
Text_Io.Put_Line (Boolean'Image (P.Result) & " = " &
Boolean'Image (P.Left_Value) & " or " &
Boolean'Image (P.Right_Value));
when Non =>
P.Result := not P.Left_Value;
Text_Io.Put_Line (Boolean'Image (P.Result) & " = non " &
Boolean'Image (P.Left_Value));
end case;
else
P.Result := Evaluate_Tree (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 Sc;
nblk1=17
nid=f
hdr6=28
[0x00] rec0=1c rec1=00 rec2=01 rec3=010
[0x01] rec0=1f rec1=00 rec2=16 rec3=076
[0x02] rec0=1a rec1=00 rec2=15 rec3=03c
[0x03] rec0=0e rec1=00 rec2=0d rec3=016
[0x04] rec0=20 rec1=00 rec2=11 rec3=018
[0x05] rec0=1e rec1=00 rec2=10 rec3=012
[0x06] rec0=19 rec1=00 rec2=08 rec3=008
[0x07] rec0=0c rec1=00 rec2=0b rec3=040
[0x08] rec0=10 rec1=00 rec2=05 rec3=02e
[0x09] rec0=15 rec1=00 rec2=13 rec3=012
[0x0a] rec0=12 rec1=00 rec2=07 rec3=03e
[0x0b] rec0=12 rec1=00 rec2=09 rec3=01c
[0x0c] rec0=11 rec1=00 rec2=0e rec3=090
[0x0d] rec0=19 rec1=00 rec2=04 rec3=060
[0x0e] rec0=09 rec1=00 rec2=02 rec3=05c
[0x0f] rec0=12 rec1=00 rec2=0a rec3=03e
[0x10] rec0=1b rec1=00 rec2=06 rec3=080
[0x11] rec0=16 rec1=00 rec2=03 rec3=060
[0x12] rec0=1f rec1=00 rec2=12 rec3=024
[0x13] rec0=17 rec1=00 rec2=0c rec3=000
[0x14] rec0=20 rec1=00 rec2=0c rec3=00e
[0x15] rec0=14 rec1=00 rec2=12 rec3=000
[0x16] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2174c12468658411b9c2a 0x42a00088462060003
Free Block Chain:
0xf: 0000 00 17 01 ff 80 07 6f 6e 20 20 22 20 26 07 00 44 ┆ on " & D┆
0x17: 0000 00 14 01 aa 80 10 65 74 75 72 6e 20 42 6f 6f 6c ┆ eturn Bool┆
0x14: 0000 00 00 01 37 80 0b 49 6d 61 67 65 20 28 41 29 20 ┆ 7 Image (A) ┆