|
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: 44032 (0xac00)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Moteur, seg_048a8f
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─⟦5a81ac88f⟧ »Space Info Vol 1«
└─⟦this⟧
with Text_Io;
with Tests;
with Verbs, Complements;
with Personnages, Items, Rooms, Counters;
with Actions, Message_D_Erreur, Le_Heros;
with String_Utilities;
package body Moteur is
function Est (Chaine_A, Chaine_B : String) return Boolean is
begin
if String_Utilities.Lower_Case (Chaine_A &
(1 .. Chaine_B'Length => ' ')) =
String_Utilities.Lower_Case (Chaine_B &
(1 .. Chaine_A'Length => ' ')) then
return True;
else
return False;
end if;
end Est;
function Est_La_Commande (The_Name : String) return Boolean is
Test_Ok : Boolean := False;
begin
Actions.At_Begin;
while not Actions.At_End and not Test_Ok loop
if Est (The_Name, Actions.Current_Name) then
Test_Ok := True;
else
Test_Ok := False;
end if;
Actions.Next;
end loop;
return Test_Ok;
end Est_La_Commande;
function Est_Dans_La_Piece (Objet, Piece, Heros : String) return Boolean is
Piece_Courante : My_String.Variable_String;
Est_Dans : Boolean;
begin
case Complements.Kind_Of (Objet) is
when Complements.Personnage =>
return Est (Personnages.Get_Position (Objet), Piece);
when Complements.Way =>
My_String.Append (Piece_Courante, Rooms.Get_Current_Room);
Rooms.Set_Current_Room (Piece);
Rooms.First_Communication;
Recherche_Voie:
while not Rooms.At_End_Communication loop
if Est (Rooms.Get_Communication_Way, Objet) then
exit Recherche_Voie;
end if;
Rooms.Next_Communication;
end loop Recherche_Voie;
Est_Dans := not Rooms.At_End_Communication and then
Est (Rooms.Get_Communication_Way, Objet);
Rooms.Set_Current_Room (My_String.Image (Piece_Courante));
return Est_Dans;
when Complements.Room =>
return False;
when Complements.Item =>
return Items.Get_Position (Objet) = Piece or
Items.Get_Position (Objet) = Heros;
when Complements.No_One =>
return False;
end case;
end Est_Dans_La_Piece;
function Traite_Action return Etat_Jeu is
A_Test : Tests.Type_Test;
An_Effect : Tests.Type_Effect;
Global_Test : Boolean;
Etat_Suivant : Etat_Jeu;
Piece_Courante : My_String.Variable_String;
begin
Etat_Suivant := Continuer;
Tests.Beginner;
while not Tests.At_End loop
Tests.First_Test;
Global_Test := True;
while not Tests.At_End_Sup and Global_Test loop
A_Test := Tests.Get_Test;
case A_Test.Kind is
when Tests.Is_A_Verb =>
Global_Test := Est_La_Commande (Tests.Identifier.Image
(A_Test.Name));
when Tests.Is_A_Complement =>
if Est_La_Commande (Tests.Identifier.Image
(A_Test.Name)) then
Global_Test :=
Est_Dans_La_Piece
(Tests.Identifier.Image (A_Test.Name),
Rooms.Get_Current_Room, Le_Heros);
if not Global_Test then
Text_Io.Put_Line
(Tests.Identifier.Image (A_Test.Name) &
" n'est pas dans " &
Rooms.Get_Current_Room);
end if;
else
Global_Test := False;
end if;
when Tests.Is_In_State =>
case Complements.Kind_Of
(Tests.Identifier.Image (A_Test.Name)) is
when Complements.Personnage =>
Global_Test :=
Personnages.In_State
(Tests.Identifier.Image (A_Test.Name),
Tests.Identifier.Image (A_Test.State));
when Complements.Room =>
Global_Test :=
Rooms.In_State
(Tests.Identifier.Image (A_Test.Name),
Tests.Identifier.Image (A_Test.State));
when Complements.Item =>
Global_Test :=
Items.In_State
(Tests.Identifier.Image (A_Test.Name),
Tests.Identifier.Image (A_Test.State));
when Complements.Way =>
null;
when Complements.No_One =>
null;
end case;
when Tests.Is_Equal =>
if Counters.Exists (Tests.Identifier.Image
(A_Test.Name)) then
Global_Test := (A_Test.Value =
Counters.Get_Value
(Tests.Identifier.Image
(A_Test.Name)));
else
Message_D_Erreur (2);
end if;
when Tests.Is_Greater =>
if Counters.Exists (Tests.Identifier.Image
(A_Test.Name)) then
Global_Test :=
(Counters.Get_Value
(Tests.Identifier.Image (A_Test.Name)) >
A_Test.Value);
else
Message_D_Erreur (2);
end if;
when Tests.Is_Less =>
if Counters.Exists (Tests.Identifier.Image
(A_Test.Name)) then
Global_Test :=
(Counters.Get_Value
(Tests.Identifier.Image (A_Test.Name)) <
A_Test.Value);
else
Message_D_Erreur (2);
end if;
when Tests.Is_In_Position =>
case Complements.Kind_Of
(Tests.Identifier.Image (A_Test.Name)) is
when Complements.Personnage =>
Global_Test :=
Est (Personnages.Get_Position
(Tests.Identifier.Image
(A_Test.Name)),
Tests.Identifier.Image (A_Test.State));
when Complements.Item =>
Global_Test := (Items.Get_Position
(Tests.Identifier.Image
(A_Test.Name)) =
Tests.Identifier.Image
(A_Test.State));
when Complements.Room =>
null;
when Complements.Way =>
null;
when Complements.No_One =>
null;
end case;
when Tests.Always =>
Global_Test := True;
end case;
Tests.Test_Sup;
end loop;
Tests.First_Effect;
while not Tests.At_End_Effect and Global_Test loop
An_Effect := Tests.Get_Effect;
case An_Effect.Kind is
when Tests.Increase =>
if Counters.Exists (Tests.Identifier.Image
(An_Effect.Name)) then
Counters.Set_Value
(Tests.Identifier.Image (An_Effect.Name),
Counters.Get_Value
(Tests.Identifier.Image (An_Effect.Name)) +
An_Effect.Value);
end if;
when Tests.Decrease =>
if Counters.Exists (Tests.Identifier.Image
(An_Effect.Name)) then
Counters.Set_Value
(Tests.Identifier.Image (An_Effect.Name),
Counters.Get_Value
(Tests.Identifier.Image (An_Effect.Name)) -
An_Effect.Value);
end if;
when Tests.Value =>
if Counters.Exists (Tests.Identifier.Image
(An_Effect.Name)) then
Counters.Set_Value
(Tests.Identifier.Image (An_Effect.Name),
An_Effect.Value);
end if;
when Tests.Print =>
Text_Io.Put_Line (Tests.Identifier.Image
(An_Effect.Name));
when Tests.Comment =>
Complements.Go_First;
while not Complements.At_End and
Complements.Get_Current /=
Tests.Identifier.Image (An_Effect.Name) loop
Complements.Go_Next;
end loop;
if not Complements.At_End then
case Complements.Get_Current_Kind is
when Complements.Personnage =>
Personnages.Set_Comment
(Tests.Identifier.Image (An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
when Complements.Room =>
Rooms.Set_Comment
(Tests.Identifier.Image (An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
when Complements.Way =>
Rooms.First_Communication;
while not Rooms.At_End_Communication and
Rooms.Get_Communication_Way /=
Tests.Identifier.Image
(An_Effect.Name) loop
Rooms.Next_Communication;
end loop;
if Rooms.Get_Communication_Way =
Tests.Identifier.Image
(An_Effect.Name) then
Rooms.Set_Communication_Comment
(Rooms.Get_Current_Room,
Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
end if;
when Complements.Item =>
Items.Set_Comment
(Tests.Identifier.Image (An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
when Complements.No_One =>
null;
end case;
end if;
when Tests.Game_Over =>
Etat_Suivant := Terminer;
when Tests.Change =>
Complements.Go_First;
while not Complements.At_End and
Complements.Get_Current /=
Tests.Identifier.Image (An_Effect.Name) loop
Complements.Go_Next;
end loop;
if not Complements.At_End then
case Complements.Get_Current_Kind is
when Complements.Personnage =>
if Personnages.In_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State)) then
Personnages.Remove_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
Personnages.Add_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.Other_State));
end if;
when Complements.Room =>
if Rooms.In_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State)) then
Rooms.Remove_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
Rooms.Add_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.Other_State));
end if;
when Complements.Item =>
if Items.In_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State)) then
Items.Remove_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
Items.Add_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.Other_State));
end if;
when Complements.Way =>
Piece_Courante :=
My_String.Value (Rooms.Get_Current_Room);
Rooms.Set_Current_Room
(Tests.Identifier.Image
(An_Effect.Position));
Rooms.First_Communication;
while not Rooms.
At_End_Communication and then
Rooms.Get_Communication_Way /=
Tests.Identifier.Image
(An_Effect.Name) loop
Rooms.Next_Communication;
end loop;
if Rooms.Get_Communication_Way =
Tests.Identifier.Image (An_Effect.Name)
then
if Est (Tests.Identifier.Image
(An_Effect.Other_State),
"ferme") then
Rooms.Set_Communication_Mode
(Tests.Identifier.Image
(An_Effect.Position),
Tests.Identifier.Image
(An_Effect.Name),
Rooms.Lock);
else
if Est (Tests.Identifier.Image
(An_Effect.Other_State),
"ouvert") then
Rooms.Set_Communication_Mode
(Tests.Identifier.Image (An_Effect.Position),
Tests.Identifier.Image (An_Effect.Name), Rooms.Unlock);
else
if Est (Tests.Identifier.Image (An_Effect.Other_State),
"visible") then
Rooms.Set_Communication_Visibility
(Tests.Identifier.Image (An_Effect.Position),
Tests.Identifier.Image (An_Effect.Name), Rooms.Visible);
else
if Est (Tests.Identifier.Image (An_Effect.Other_State),
"invisible") then
Rooms.Set_Communication_Visibility
(Tests.Identifier.Image (An_Effect.Position),
Tests.Identifier.Image (An_Effect.Name),
Rooms.Unvisible);
end if;
end if;
end if;
end if;
end if;
Rooms.Set_Current_Room
(My_String.Image (Piece_Courante));
when Complements.No_One =>
null;
end case;
end if;
when Tests.Position =>
Complements.Go_First;
while not Complements.At_End and
Complements.Get_Current /=
Tests.Identifier.Image (An_Effect.Name) loop
Complements.Go_Next;
end loop;
if not Complements.At_End then
if Complements."=" (Complements.Get_Current_Kind,
Complements.Personnage) then
Personnages.Set_Position
(Tests.Identifier.Image (An_Effect.Name),
Tests.Identifier.Image
(An_Effect.Position));
else
if Complements."="
(Complements.Get_Current_Kind,
Complements.Item) then
Items.Set_Position
(Tests.Identifier.Image (An_Effect.Name),
Tests.Identifier.Image
(An_Effect.Position));
else
Message_D_Erreur (2);
end if;
end if;
end if;
end case;
Tests.Next_Effect;
end loop;
Tests.Next;
end loop;
return Etat_Suivant;
end Traite_Action;
procedure Traite_Question is
Existe : Boolean := False;
Verifie : Boolean := False;
begin
Actions.At_Begin;
if Est (Actions.Current_Name, "aller") and not Verifie then
Verifie := True;
Actions.Next;
if not Actions.At_End then
Rooms.First_Communication;
while not Rooms.At_End_Communication and not Existe loop
if Est (Actions.Current_Name,
Rooms.Get_Communication_Way) then
if Rooms."=" (Rooms.Get_Communication_Mode,
Rooms.Unlock) then
Rooms.Set_Current_Room
(Rooms.Get_Communication_Destination);
Complements.Go_First;
Recherche_Heros_2:
while not Complements.At_End loop
if Complements."="
(Complements.Get_Current_Kind,
Complements.Personnage) and then
Personnages.In_State
(Complements.Get_Current, "heros")
then
Personnages.Set_Position
(Complements.Get_Current,
Rooms.Get_Current_Room);
exit Recherche_Heros_2;
end if;
Complements.Go_Next;
end loop Recherche_Heros_2;
else
Message_D_Erreur (3);
end if;
Existe := True;
end if;
Rooms.Next_Communication;
end loop;
else
Message_D_Erreur (4);
end if;
end if;
if Est (Actions.Current_Name, "prendre") and not Verifie then
Verifie := True;
Actions.Next;
if not Actions.At_End then
if Items.Exists (Actions.Current_Name) then
if Items.Get_Position (Actions.Current_Name) =
Rooms.Get_Current_Room then
Items.Set_Position (Actions.Current_Name, Le_Heros);
else
Message_D_Erreur (7);
end if;
else
Message_D_Erreur (9);
end if;
else
Message_D_Erreur (5);
end if;
end if;
if Est (Actions.Current_Name, "deposer") and not Verifie then
Verifie := True;
Actions.Next;
if not Actions.At_End then
if Items.Exists (Actions.Current_Name) then
if Items.Get_Position (Actions.Current_Name) = Le_Heros then
Items.Set_Position (Actions.Current_Name,
Rooms.Get_Current_Room);
else
Message_D_Erreur (8);
end if;
else
Message_D_Erreur (9);
end if;
else
Message_D_Erreur (5);
end if;
end if;
if Est (Actions.Current_Name, "lister") and not Verifie then
Verifie := True;
Actions.Next;
if not Actions.At_End then
if Est (Actions.Current_Name, "verbes") then
Verbs.Go_First;
while not Verbs.At_End loop
Text_Io.Put_Line (Verbs.Get_Current);
Verbs.Go_Next;
end loop;
else
if Est (Actions.Current_Name, "complements") then
Complements.Go_First;
while not Complements.At_End loop
Text_Io.Put_Line (Complements.Get_Current);
Complements.Go_Next;
end loop;
else
Message_D_Erreur (5);
end if;
end if;
else
Message_D_Erreur (6);
end if;
end if;
if not Verifie and Complements."="
(Complements.Kind_Of (Actions.Current_Name),
Complements.Way) then
Verifie := True;
Rooms.First_Communication;
while not Rooms.At_End_Communication and not Existe loop
if Est (Actions.Current_Name, Rooms.Get_Communication_Way) then
if Rooms."=" (Rooms.Get_Communication_Mode,
Rooms.Unlock) then
Rooms.Set_Current_Room (Rooms.
Get_Communication_Destination);
Complements.Go_First;
Recherche_Heros:
while not Complements.At_End loop
if Complements."="
(Complements.Get_Current_Kind,
Complements.Personnage) and then
Personnages.In_State
(Complements.Get_Current, "heros") then
Personnages.Set_Position
(Complements.Get_Current,
Rooms.Get_Current_Room);
exit Recherche_Heros;
end if;
Complements.Go_Next;
end loop Recherche_Heros;
else
Message_D_Erreur (3);
end if;
Existe := True;
end if;
Rooms.Next_Communication;
end loop;
end if;
if not Verifie then
Message_D_Erreur (1);
end if;
end Traite_Question;
procedure Traiter (Q : Type_De_Demande; E : out Etat_Jeu) is
begin
case Q is
when Action =>
E := Traite_Action;
when Predefinie =>
Traite_Question;
E := Traite_Action;
when Fin_De_Jeu =>
E := Arreter;
when Sans =>
Message_D_Erreur (1);
E := Continuer;
end case;
end Traiter;
end Moteur;
nblk1=2a
nid=22
hdr6=4a
[0x00] rec0=20 rec1=00 rec2=01 rec3=016
[0x01] rec0=18 rec1=00 rec2=23 rec3=048
[0x02] rec0=03 rec1=00 rec2=18 rec3=00c
[0x03] rec0=21 rec1=00 rec2=0e rec3=03c
[0x04] rec0=02 rec1=00 rec2=05 rec3=008
[0x05] rec0=11 rec1=00 rec2=08 rec3=00a
[0x06] rec0=03 rec1=00 rec2=19 rec3=008
[0x07] rec0=10 rec1=00 rec2=17 rec3=05c
[0x08] rec0=12 rec1=00 rec2=0b rec3=06c
[0x09] rec0=14 rec1=00 rec2=26 rec3=01c
[0x0a] rec0=09 rec1=00 rec2=2a rec3=082
[0x0b] rec0=17 rec1=00 rec2=0a rec3=030
[0x0c] rec0=13 rec1=00 rec2=03 rec3=012
[0x0d] rec0=00 rec1=00 rec2=20 rec3=006
[0x0e] rec0=15 rec1=00 rec2=04 rec3=042
[0x0f] rec0=02 rec1=00 rec2=07 rec3=006
[0x10] rec0=0e rec1=00 rec2=02 rec3=08c
[0x11] rec0=10 rec1=00 rec2=11 rec3=058
[0x12] rec0=14 rec1=00 rec2=10 rec3=072
[0x13] rec0=0f rec1=00 rec2=1c rec3=07e
[0x14] rec0=10 rec1=00 rec2=25 rec3=04a
[0x15] rec0=11 rec1=00 rec2=1d rec3=010
[0x16] rec0=0f rec1=00 rec2=28 rec3=044
[0x17] rec0=0f rec1=00 rec2=24 rec3=01e
[0x18] rec0=10 rec1=00 rec2=1f rec3=04c
[0x19] rec0=16 rec1=00 rec2=1e rec3=06c
[0x1a] rec0=04 rec1=00 rec2=27 rec3=01e
[0x1b] rec0=10 rec1=00 rec2=16 rec3=01e
[0x1c] rec0=1a rec1=00 rec2=13 rec3=04a
[0x1d] rec0=10 rec1=00 rec2=14 rec3=04a
[0x1e] rec0=19 rec1=00 rec2=09 rec3=028
[0x1f] rec0=1c rec1=00 rec2=21 rec3=020
[0x20] rec0=03 rec1=00 rec2=12 rec3=048
[0x21] rec0=18 rec1=00 rec2=0f rec3=05c
[0x22] rec0=11 rec1=00 rec2=1a rec3=03c
[0x23] rec0=1f rec1=00 rec2=06 rec3=028
[0x24] rec0=0a rec1=00 rec2=15 rec3=000
[0x25] rec0=11 rec1=00 rec2=1a rec3=03c
[0x26] rec0=1f rec1=00 rec2=06 rec3=028
[0x27] rec0=0a rec1=00 rec2=15 rec3=000
[0x28] rec0=88 rec1=16 rec2=bf rec3=078
[0x29] rec0=00 rec1=09 rec2=ea rec3=0c7
tail 0x21545fac8865a5db810e3 0x42a00088462060003
Free Block Chain:
0x22: 0000 00 0d 00 50 80 0b 73 2e 41 64 64 5f 53 74 61 74 ┆ P s.Add_Stat┆
0xd: 0000 00 1b 03 fc 80 0a 73 74 2e 4e 61 6d 65 29 29 3b ┆ st.Name));┆
0x1b: 0000 00 0c 00 11 80 0e 20 20 20 20 20 20 20 20 20 20 ┆ ┆
0xc: 0000 00 29 00 04 80 01 20 01 02 03 04 05 06 07 08 09 ┆ ) ┆
0x29: 0000 00 00 01 84 80 3a 20 20 20 20 20 20 20 20 20 20 ┆ : ┆