|
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: 14336 (0x3800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Interpreteur, seg_04920d, seg_04924e, seg_049440
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Document, Nos_Chaines, Player_Dictionary,
Text_Io, Interface_Structure, Display;
package body Interpreteur is
type Kind_Of_Var is (Communication, Compteur, Lieu, Objet,
Personnage, Verbe, Preposition, Sans_Type);
----------------------------------------------------------------------------------
procedure Dictionnary renames Interface_Structure.Print_Verbes;
--------------------------------------------------------------------------------------
--
-- Procedure Player_Error est utilisee par la procedure Interprete pour afficher
-- un message d'erreur en cas de commande inconnue ou erronee.
--
----------------------------------------------------------------------------------
procedure Player_Error is
begin
Display.Write_On_World (" Je ne comprends pas votre commande");
end Player_Error;
----------------------------------------------------------------------------------
--- Fonction Make_Commande employee par interprete pour construire la trame de
-- commande qui sera appelee par le moteur.
--
----------------------------------------------------------------------------------
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
case Kind_Of_Var'Val (Interface_Structure.Type_Of_Var'Pos
(Interface_Structure.Get_Type
(List_Of_Order (Num_Of_Order)))) is
when Verbe | Preposition =>
Tmp_List_Of_Order (Num_Of_Order) :=
Interface_Structure.Get_Signification
(List_Of_Order (Num_Of_Order));
when others =>
Tmp_List_Of_Order (Num_Of_Order) :=
List_Of_Order (Num_Of_Order);
end case;
end loop;
Tmp_Command.Size_Of_Commande := Number_Of_Order;
Tmp_Command.Tab_Commande := Tmp_List_Of_Order;
return Tmp_Command;
end Make_Commande;
----------------------------------------------------------------------------------
procedure Interprete (Commande : in out T_Commande) is
Table_Of_Word : T_Tab_Commande;
Num_Word : Mots.Number;
Player_Order : Boolean := False;
Ok : Boolean := True;
begin
Display.Write_On_World (" ");
Display.Write_On_World ("World Message : ");
Display.Write_On_World (" ");
Document.Get (Table_Of_Word, Num_Word);
if (Num_Word > Mots.Max_Number_Words) then
Display.Write_On_World
(" Une instruction ne comporte pas plus de quatre mots !");
Mots.Copy_Nul_Command (Commande);
Num_Word := 0;
Interprete (Commande);
elsif Num_Word = 0 then
Display.Write_On_World
(" Il n y a aucune instruction.");
Mots.Copy_Nul_Command (Commande);
Interprete (Commande);
elsif Mots.String_Value (Table_Of_Word, 1) = "quit" then
raise End_Of_Play;
elsif Mots.String_Value (Table_Of_Word, 1) = "dico_verbes" then
Dictionnary;
Mots.Copy_Nul_Command (Commande);
Num_Word := 0;
Interprete (Commande);
else
for I in 1 .. Num_Word loop
if (Ok and then Player_Dictionary.Player_Sens
(Table_Of_Word (I), I)) then
Player_Order := True;
else
Player_Order := False;
Ok := False;
end if;
end loop;
if Player_Order then
if Player_Dictionary.Player_Syntax
(Table_Of_Word, Num_Word) then
Mots.Copy_Commande
(Commande, Make_Commande (Table_Of_Word, Num_Word));
else
Player_Error;
Mots.Copy_Nul_Command (Commande);
Num_Word := 0;
Interprete (Commande);
end if;
else
Player_Error;
Mots.Copy_Nul_Command (Commande);
Num_Word := 0;
Interprete (Commande);
end if;
end if;
Num_Word := 0;
exception
when End_Of_Play =>
raise End_Of_Play;
when others =>
Text_Io.Put_Line ("erreur interpreteur");
end Interprete;
--------------------------------------------------------------------------------
end Interpreteur;
nblk1=d
nid=9
hdr6=c
[0x00] rec0=1d rec1=00 rec2=01 rec3=002
[0x01] rec0=14 rec1=00 rec2=04 rec3=01c
[0x02] rec0=18 rec1=00 rec2=0c rec3=098
[0x03] rec0=06 rec1=00 rec2=0a rec3=056
[0x04] rec0=18 rec1=00 rec2=0b rec3=02c
[0x05] rec0=1a rec1=00 rec2=06 rec3=000
[0x06] rec0=17 rec1=00 rec2=04 rec3=000
[0x07] rec0=18 rec1=00 rec2=09 rec3=092
[0x08] rec0=00 rec1=00 rec2=0b rec3=004
[0x09] rec0=17 rec1=00 rec2=06 rec3=054
[0x0a] rec0=17 rec1=00 rec2=04 rec3=000
[0x0b] rec0=1a rec1=00 rec2=0b rec3=000
[0x0c] rec0=24 rec1=00 rec2=11 rec3=182
tail 0x215467aba865b4e286efb 0x42a00088462060003
Free Block Chain:
0x9: 0000 00 08 00 3b 80 0a 65 5f 4f 6e 5f 57 6f 72 6c 64 ┆ ; e_On_World┆
0x8: 0000 00 07 00 08 00 05 20 20 20 20 20 05 20 20 20 20 ┆ ┆
0x7: 0000 00 03 03 fc 80 2c 20 20 20 20 20 20 20 6e 65 77 ┆ , new┆
0x3: 0000 00 05 03 fc 00 39 20 20 20 20 20 20 20 20 20 20 ┆ 9 ┆
0x5: 0000 00 02 03 f9 80 32 20 20 69 66 20 4d 6f 74 73 2e ┆ 2 if Mots.┆
0x2: 0000 00 0d 03 fc 80 32 2f 2f 2f 2f 2f 2f 2f 2f 2f 2f ┆ 2//////////┆
0xd: 0000 00 00 00 05 80 02 6f 6f 02 00 00 00 00 f0 00 01 ┆ oo ┆