|
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: 38912 (0x9800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Moteur_Back, seg_0487ed
└─⟦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_Back 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 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 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
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;
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 := (A_Test.Value >
Counters.Get_Value
(Tests.Identifier.Image
(A_Test.Name)));
else
Message_D_Erreur (2);
end if;
when Tests.Is_Less =>
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_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 =>
Text_Io.Put_Line ("----1-----");
Complements.Go_First;
Text_Io.Put_Line ("----2-----");
while not Complements.At_End and
Complements.Get_Current /=
Tests.Identifier.Image (An_Effect.Name) loop
Complements.Go_Next;
end loop;
Text_Io.Put_Line ("----3-----");
if not Complements.At_End then
case Complements.Get_Current_Kind is
when Complements.Personnage =>
Text_Io.Put_Line ("----3 bis-----");
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 =>
Text_Io.Put_Line ("----4-----");
if Rooms.In_State
(Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State)) then
Text_Io.Put_Line ("----5-----");
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;
Text_Io.Put_Line ("----6-----");
when Complements.Item =>
Text_Io.Put_Line ("----7-----");
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 =>
Text_Io.Put_Line ("----8-----");
Text_Io.Put_Line (Tests.Identifier.Image
(An_Effect.Name));
Rooms.First_Communication;
Text_Io.Put_Line ("----8 a-----");
while not Rooms.
At_End_Communication and then
Rooms.Get_Communication_Way /=
Tests.Identifier.Image
(An_Effect.Position) loop
Text_Io.Put_Line ("----8 b-----");
Rooms.Next_Communication;
Text_Io.Put_Line ("----8 c-----");
end loop;
Text_Io.Put_Line ("----8 d-----");
if Rooms.Get_Communication_Way =
Tests.Identifier.Image
(An_Effect.Position) then
Text_Io.Put_Line ("----9-----");
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
Text_Io.Put_Line ("----10-----");
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;
Text_Io.Put_Line ("----11-----");
Rooms.Set_Communication_Comment
(Rooms.Get_Current_Room,
Tests.Identifier.Image
(An_Effect.Name),
Tests.Identifier.Image
(An_Effect.State));
end if;
Text_Io.Put_Line ("----9 a-----");
when Complements.No_One =>
null;
end case;
end if;
when Tests.Position =>
Text_Io.Put_Line ("----12-----");
Complements.Go_First;
while not Complements.At_End and
Complements.Get_Current /=
Tests.Identifier.Image (An_Effect.Name) loop
Complements.Go_Next;
end loop;
Text_Io.Put_Line ("----13-----");
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;
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;
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_Back;
nblk1=25
nid=5
hdr6=48
[0x00] rec0=20 rec1=00 rec2=01 rec3=00c
[0x01] rec0=06 rec1=00 rec2=23 rec3=044
[0x02] rec0=15 rec1=00 rec2=18 rec3=00c
[0x03] rec0=22 rec1=00 rec2=0e rec3=008
[0x04] rec0=11 rec1=00 rec2=08 rec3=00a
[0x05] rec0=03 rec1=00 rec2=19 rec3=008
[0x06] rec0=10 rec1=00 rec2=17 rec3=05c
[0x07] rec0=12 rec1=00 rec2=0b rec3=070
[0x08] rec0=12 rec1=00 rec2=0d rec3=01a
[0x09] rec0=0b rec1=00 rec2=0c rec3=082
[0x0a] rec0=17 rec1=00 rec2=0a rec3=030
[0x0b] rec0=12 rec1=00 rec2=03 rec3=018
[0x0c] rec0=15 rec1=00 rec2=04 rec3=042
[0x0d] rec0=02 rec1=00 rec2=07 rec3=006
[0x0e] rec0=0e rec1=00 rec2=02 rec3=08c
[0x0f] rec0=10 rec1=00 rec2=11 rec3=058
[0x10] rec0=15 rec1=00 rec2=10 rec3=008
[0x11] rec0=0f rec1=00 rec2=1c rec3=020
[0x12] rec0=0f rec1=00 rec2=25 rec3=04c
[0x13] rec0=10 rec1=00 rec2=1d rec3=00a
[0x14] rec0=0f rec1=00 rec2=24 rec3=02e
[0x15] rec0=0f rec1=00 rec2=20 rec3=06a
[0x16] rec0=07 rec1=00 rec2=1b rec3=076
[0x17] rec0=10 rec1=00 rec2=1f rec3=046
[0x18] rec0=11 rec1=00 rec2=1e rec3=072
[0x19] rec0=13 rec1=00 rec2=22 rec3=06e
[0x1a] rec0=02 rec1=00 rec2=21 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=1b rec1=00 rec2=12 rec3=048
[0x20] rec0=18 rec1=00 rec2=0f rec3=05c
[0x21] rec0=11 rec1=00 rec2=1a rec3=03c
[0x22] rec0=1f rec1=00 rec2=06 rec3=028
[0x23] rec0=0a rec1=00 rec2=15 rec3=001
[0x24] rec0=cf rec1=23 rec2=42 rec3=400
tail 0x21545c220865a335f21a8 0x42a00088462060003
Free Block Chain:
0x5: 0000 00 00 00 91 80 25 20 20 20 20 20 20 20 20 20 20 ┆ % ┆