|
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 - metrics - download
Length: 13312 (0x3400)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Interpreteur, seg_047710
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Document, Nos_Chaines, Player_Dictionary, Text_Io,
Gestion_De_Tables, Interface_Structure, Display;
package body Interpreteur is
Verbe_Table : Gestion_De_Tables.Tableau;
Preposition_Table : Gestion_De_Tables.Tableau;
Complement_Table : Gestion_De_Tables.Tableau;
Complement2_Table : Gestion_De_Tables.Tableau;
Compteur : Natural := 1;
procedure File_Interprete (File_Name : in String) is
Read_Word : Mots.Mot;
Num_Line : Mots.Number;
function Equal (Chaine1, Chaine2 : String) return Boolean
renames Standard."=";
begin
Document.Fopen (File_Name);
while not Document.En_Fin_De_Fichier loop
Document.File_Get (Read_Word, Num_Line);
--Text_Io.Put_Line (Mots.Valeur (Read_Word));
if Mots.Valeur (Read_Word) = "Debut_Verbes" then
loop
Document.File_Get (Read_Word, Num_Line);
exit when Equal (Mots.Valeur (Read_Word), "Fin_Verbes");
Verbe_Table (Compteur) :=
new String'(Mots.Valeur (Read_Word));
Compteur := Compteur + 1;
Text_Io.Put_Line (Mots.Valeur (Read_Word));
end loop;
Verbe_Table (Compteur .. 80) := (others => (new String'(" ")));
end if;
end loop;
Document.Fclose;
Compteur := 1;
Document.Fopen (File_Name);
while not Document.En_Fin_De_Fichier loop
Document.File_Get (Read_Word, Num_Line);
if Mots.Valeur (Read_Word) = "Debut_Prepositions" then
loop
Document.File_Get (Read_Word, Num_Line);
exit when Equal (Mots.Valeur (Read_Word),
"Fin_Prepositions");
Preposition_Table (Compteur) :=
new String'(Mots.Valeur (Read_Word));
Compteur := Compteur + 1;
Text_Io.Put_Line (Mots.Valeur (Read_Word));
end loop;
Preposition_Table (Compteur .. 80) :=
(others => (new String'(" ")));
end if;
end loop;
Document.Fclose;
Compteur := 1;
Document.Fopen (File_Name);
while not Document.En_Fin_De_Fichier loop
Document.File_Get (Read_Word, Num_Line);
if Mots.Valeur (Read_Word) = "Debut_Complements" then
loop
Document.File_Get (Read_Word, Num_Line);
exit when Equal (Mots.Valeur (Read_Word),
"Fin_Complements");
Complement_Table (Compteur) :=
new String'(Mots.Valeur (Read_Word));
Compteur := Compteur + 1;
Text_Io.Put_Line (Mots.Valeur (Read_Word));
end loop;
Complement_Table (Compteur .. 80) :=
(others => (new String'(" ")));
end if;
end loop;
Document.Fclose;
Compteur := 1;
Document.Fopen (File_Name);
while not Document.En_Fin_De_Fichier loop
Document.File_Get (Read_Word, Num_Line);
if Mots.Valeur (Read_Word) = "Debut_Complements2" then
loop
Document.File_Get (Read_Word, Num_Line);
exit when Equal (Mots.Valeur (Read_Word),
"Fin_Complements2");
Complement2_Table (Compteur) :=
new String'(Mots.Valeur (Read_Word));
Compteur := Compteur + 1;
Text_Io.Put_Line (Mots.Valeur (Read_Word));
end loop;
Complement2_Table (Compteur .. 80) :=
(others => (new String'(" ")));
end if;
end loop;
Document.Fclose;
Compteur := 1;
end File_Interprete;
--------------------------------------------------------------------------------------
procedure Player_Error is
begin
Display.Write_On_World ("*** ACHTUNG ! *** " &
"Syntax Error or Unknow Command.");
-- Text_Io.Put_Line ("*** ACHTUNG ! *** " &
-- "Syntax Error or Unknow Command.");
end Player_Error;
procedure Interprete (Commande : out T_Commande) is
Table_Of_Word : T_Tab_Commande;
Num_Word : Mots.Number;
Player_Order : Boolean := False;
B_Test : Boolean := True;
begin
--Document.Open;
loop
Display.Write_On_World ("World Message : ");
--Text_Io.Put ("/:> ");
Document.Get (Table_Of_Word, Num_Word);
if (Num_Word > Mots.Max_Number_Words) then
-- Text_Io.Put_Line
Display.Write_On_World
("Une instruction ne comporte pas plus de quatre mots !");
elsif Num_Word = 0 then
--Text_Io.Put_Line
Display.Write_On_World ("Il n y aucune instruction.");
else
for I in 1 .. Num_Word loop
if Mots.String_Value (Table_Of_Word, I) = "quit" then
raise End_Of_Play;
elsif Mots.String_Value (Table_Of_Word, I) = "nothing" then
exit;
elsif B_Test = True then
------------------------------------------------------------------------------------------------------
--
-- PHASE DE TEST :
--
if Gestion_De_Tables.Chercher_Dans_Table
(Verbe_Table, Mots.String_Value
(Table_Of_Word, I)) then
-- Text_Io.Put_Line
Display.Write_On_World ("Mot correct");
elsif Gestion_De_Tables.Chercher_Dans_Table
(Preposition_Table, Mots.String_Value
(Table_Of_Word, I)) then
--Text_Io.Put_Line
Display.Write_On_World ("Mot correct");
elsif Gestion_De_Tables.Chercher_Dans_Table
(Complement_Table, Mots.String_Value
(Table_Of_Word, I)) then
--Text_Io.Put_Line
Display.Write_On_World ("Mot correct");
elsif Gestion_De_Tables.Chercher_Dans_Table
(Complement2_Table, Mots.String_Value
(Table_Of_Word, I)) then
--Text_Io.Put_Line
Display.Write_On_World ("Mot correct");
else
--Text_Io.Put_Line
Display.Write_On_World ("Mot incorrect");
end if;
--
--
------------------------------------------------------------------------------------------------------
elsif Player_Dictionary.Player_Sens (Table_Of_Word (I)) then
Player_Order := True;
else
Player_Order := False;
end if;
end loop;
if Player_Order then
if Player_Dictionary.Player_Syntax
(Table_Of_Word, Num_Word) then
Commande := Make_Commande (Table_Of_Word, Num_Word);
else
Player_Error;
end if;
else
Player_Error;
end if;
end if;
Num_Word := 0;
end loop;
Document.Close;
exception
when End_Of_Play =>
return;
end Interprete;
function Make_Commande
(List_Of_Order : T_Tab_Commande; Number_Of_Order : Natural)
return T_Commande is
Tmp_Command : T_Commande;
Tmp_List_Of_Order : T_Tab_Commande;
begin
for Num_Of_Order in 1 .. Number_Of_Order loop
Tmp_List_Of_Order (Num_Of_Order) :=
Interface_Structure.Get_Signification
(List_Of_Order (Num_Of_Order));
end loop;
Tmp_Command.Size_Of_Commande := Number_Of_Order;
Tmp_Command.Tab_Commande := Tmp_List_Of_Order;
return Tmp_Command;
end Make_Commande;
end Interpreteur;
nblk1=c
nid=9
hdr6=16
[0x00] rec0=1d rec1=00 rec2=01 rec3=026
[0x01] rec0=14 rec1=00 rec2=05 rec3=046
[0x02] rec0=15 rec1=00 rec2=03 rec3=05a
[0x03] rec0=17 rec1=00 rec2=07 rec3=03e
[0x04] rec0=1e rec1=00 rec2=08 rec3=024
[0x05] rec0=16 rec1=00 rec2=0a rec3=070
[0x06] rec0=01 rec1=00 rec2=0c rec3=00c
[0x07] rec0=0e rec1=00 rec2=06 rec3=08c
[0x08] rec0=15 rec1=00 rec2=04 rec3=016
[0x09] rec0=1f rec1=00 rec2=02 rec3=00e
[0x0a] rec0=02 rec1=00 rec2=0b rec3=000
[0x0b] rec0=07 rec1=00 rec2=0b rec3=000
tail 0x215447d2286544f1dc3eb 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 00 00 16 80 0a 72 69 6e 67 5f 56 61 6c 75 65 ┆ ring_Value┆