|
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: 26624 (0x6800)
Types: Ada Source
Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Effet, seg_04783e
└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
└─ ⟦cfc2e13cd⟧ »Space Info Vol 2«
└─⟦this⟧
with Complements;
with Tests;
with Une_Position;
with String_Utilities;
with Syntax_Error;
with Lexical;
with Compiler_Token;
use Compiler_Token;
package body Effet is
procedure Parse is
Nom : Lexical.Our_String.Variable_String;
Commentaire : Lexical.Our_String.Variable_String;
Etat_Initial : Lexical.Our_String.Variable_String;
Etat_Final : Lexical.Our_String.Variable_String;
Valeur : Integer;
Entier : Boolean;
Un_Effet : Tests.Type_Effect;
Une_Position_Synth : Lexical.Our_String.Variable_String;
Une_Position_Ok : Boolean;
begin
case Lexical.Get_Token is
when L_Incrementer =>
Lexical.Next;
if Lexical.Get_Token = L_Id then
Nom := Lexical.Our_String.Value (Lexical.Get_Value);
Lexical.Next;
if Lexical.Get_Token = L_De then
Lexical.Next;
if Lexical.Get_Token = L_Nbr then
String_Utilities.String_To_Number
(Lexical.Get_Value, Valeur, Entier);
if Entier then
Un_Effet.Kind := Tests.Increase;
Un_Effet.Name :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Nom));
Un_Effet.Value := Valeur;
Tests.Add_Effect (Un_Effet);
else
Syntax_Error.Semantique
("Les compteurs n'acceptent que les valeurs entieres");
end if;
Lexical.Next;
else
Syntax_Error.Syntaxique (R_Effet, "L_Nbr");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_De");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Id");
end if;
when L_Decrementer =>
Lexical.Next;
if Lexical.Get_Token = L_Id then
Nom := Lexical.Our_String.Value (Lexical.Get_Value);
Lexical.Next;
if Lexical.Get_Token = L_De then
Lexical.Next;
if Lexical.Get_Token = L_Nbr then
String_Utilities.String_To_Number
(Lexical.Get_Value, Valeur, Entier);
if Entier then
Un_Effet.Kind := Tests.Decrease;
Un_Effet.Name :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Nom));
Un_Effet.Value := Valeur;
Tests.Add_Effect (Un_Effet);
else
Syntax_Error.Semantique
("Les compteurs n'acceptent que les valeurs entieres");
end if;
Lexical.Next;
else
Syntax_Error.Syntaxique (R_Effet, "L_Nbr");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_De");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Id");
end if;
when L_Valeur =>
Lexical.Next;
if Lexical.Get_Token = L_Id then
Nom := Lexical.Our_String.Value (Lexical.Get_Value);
Lexical.Next;
if Lexical.Get_Token = L_Est then
Lexical.Next;
if Lexical.Get_Token = L_Nbr then
String_Utilities.String_To_Number
(Lexical.Get_Value, Valeur, Entier);
if Entier then
Un_Effet.Kind := Tests.Value;
Un_Effet.Name :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Nom));
Un_Effet.Value := Valeur;
Tests.Add_Effect (Un_Effet);
else
Syntax_Error.Semantique
("Les compteurs n'acceptent que les valeurs entieres");
end if;
Lexical.Next;
else
Syntax_Error.Syntaxique (R_Effet, "L_Nbr");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Est");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Id");
end if;
when L_Afficher =>
Lexical.Next;
if Lexical.Get_Token = L_Str then
Commentaire := Lexical.Our_String.Value (Lexical.Get_Value);
Un_Effet.Kind := Tests.Print;
Un_Effet.Name :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Commentaire));
Tests.Add_Effect (Un_Effet);
Lexical.Next;
else
Syntax_Error.Syntaxique (R_Effet, "L_Str");
end if;
when L_Commentaire =>
Lexical.Next;
if Lexical.Get_Token = L_Id then
Nom := Lexical.Our_String.Value (Lexical.Get_Value);
Lexical.Next;
if Lexical.Get_Token = L_Est then
Lexical.Next;
if Lexical.Get_Token = L_Str then
Commentaire := Lexical.Our_String.Value
(Lexical.Get_Value);
if Complements.Exists
(Lexical.Our_String.Image (Nom)) then
case Complements.Kind_Of
(Lexical.Our_String.Image (Nom)) is
when Complements.Personnage |
Complements.Item | Complements.Way |
Complements.Room =>
Un_Effet.Kind := Tests.Comment;
Un_Effet.Name :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Nom));
Un_Effet.State :=
Tests.Identifier.Value
(Lexical.Our_String.Image
(Commentaire));
Tests.Add_Effect (Un_Effet);
when Complements.No_One =>
Syntax_Error.Semantique
(Lexical.Our_String.Image (Nom) &
" n'est ni une personne, ni un objet, ni une piece, ni un acces");
end case;
else
Syntax_Error.Semantique
(Lexical.Our_String.Image (Nom) &
" n'existe pas");
end if;
Lexical.Next;
else
Syntax_Error.Syntaxique (R_Effet, "L_Str");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Est");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Id");
end if;
when L_Fin_De_Jeu =>
Lexical.Next;
Un_Effet.Kind := Tests.Game_Over;
Tests.Add_Effect (Un_Effet);
when L_Changer =>
Lexical.Next;
if Lexical.Get_Token = L_Id then
Nom := Lexical.Our_String.Value (Lexical.Get_Value);
Lexical.Next;
if Lexical.Get_Token = L_Id or
Lexical.Get_Token = L_Ferme or
Lexical.Get_Token = L_Ouvert or
Lexical.Get_Token = L_Visible or
Lexical.Get_Token = L_Invisible then
Etat_Initial := Lexical.Our_String.Value
(Lexical.Get_Value);
Lexical.Next;
if Lexical.Get_Token = L_En then
Lexical.Next;
if Lexical.Get_Token = L_Id or
Lexical.Get_Token = L_Ferme or
Lexical.Get_Token = L_Ouvert or
Lexical.Get_Token = L_Visible or
Lexical.Get_Token = L_Invisible then
Etat_Final := Lexical.Our_String.Value
(Lexical.Get_Value);
if Complements.Exists
(Lexical.Our_String.Image (Nom)) then
case Complements.Kind_Of
(Lexical.Our_String.Image (Nom)) is
when Complements.Personnage |
Complements.Item |
Complements.Room =>
Lexical.Next;
Une_Position.Parse
(Une_Position_Synth,
Une_Position_Ok);
Un_Effet.Kind := Tests.Change;
Un_Effet.Name :=
Tests.Identifier.Value
(Lexical.Our_String.Image
(Nom));
Un_Effet.State :=
Tests.Identifier.Value
(Lexical.Our_String.Image
(Etat_Initial));
Un_Effet.Other_State :=
Tests.Identifier.Value
(Lexical.Our_String.Image
(Etat_Final));
if Une_Position_Ok then
Un_Effet.Position := Tests.Identifier.Value
(Lexical.Our_String.Image
(Une_Position_Synth));
end if;
Tests.Add_Effect (Un_Effet);
when Complements.Way =>
if Lexical.Get_Token = L_Ferme or
Lexical.Get_Token = L_Ouvert or
Lexical.Get_Token = L_Visible or
Lexical.Get_Token =
L_Invisible then
Lexical.Next;
Une_Position.Parse (Une_Position_Synth, Une_Position_Ok);
if Une_Position_Ok then
Un_Effet.Kind := Tests.Change;
Un_Effet.Name := Tests.Identifier.Value
(Lexical.Our_String.Image (Nom));
Un_Effet.State :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Etat_Initial));
Un_Effet.Other_State :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Etat_Final));
Un_Effet.Position := Tests.Identifier.Value
(Lexical.Our_String.Image
(Une_Position_Synth));
Tests.Add_Effect (Un_Effet);
else
Syntax_Error.Semantique
("Pour changer l'etat d'un acces, on DOIT dire dans quelle piece");
end if;
else
Syntax_Error.Semantique
(Lexical.Our_String.Image (Etat_Final) &
" est impossible, car un acces ne peut qu'etre rendu Ferme, Ouvert, Invisible ou Visible");
Lexical.Next;
end if;
when Complements.No_One =>
Syntax_Error.Semantique
(Lexical.Our_String.Image (Nom) &
" n'est ni une personne, ni un objet, ni une piece");
Lexical.Next;
Une_Position.Parse
(Une_Position_Synth,
Une_Position_Ok);
end case;
else
Syntax_Error.Semantique
(Lexical.Our_String.Image (Nom) &
" n'existe pas");
Lexical.Next;
end if;
else
Syntax_Error.Syntaxique
(R_Effet,
"L_Id ou L_Ferme ou L_Ouvert ou L_Visible ou L_Invisible");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_En");
end if;
else
Syntax_Error.Syntaxique
(R_Effet,
"L_Id ou L_Ferme ou L_Ouvert ou L_Visible ou L_Invisible");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Id");
end if;
when L_Positionner =>
Lexical.Next;
if Lexical.Get_Token = L_Id then
Nom := Lexical.Our_String.Value (Lexical.Get_Value);
Lexical.Next;
Une_Position.Parse (Une_Position_Synth, Une_Position_Ok);
if Complements.Exists (Lexical.Our_String.Image (Nom)) then
if Une_Position_Ok then
case Complements.Kind_Of
(Lexical.Our_String.Image (Nom)) is
when Complements.Personnage |
Complements.Item =>
Un_Effet.Kind := Tests.Position;
Un_Effet.Name :=
Tests.Identifier.Value
(Lexical.Our_String.Image (Nom));
Un_Effet.Position :=
Tests.Identifier.Value
(Lexical.Our_String.Image
(Une_Position_Synth));
Tests.Add_Effect (Un_Effet);
when Complements.Way =>
Syntax_Error.Semantique
("Un acces ne peut pas avoir de position");
when Complements.Room =>
Syntax_Error.Semantique
("Une piece ne peut pas avoir de position");
when Complements.No_One =>
Syntax_Error.Semantique
(Lexical.Our_String.Image (Nom) &
" n'est ni une personne, ni un objet");
end case;
else
Syntax_Error.Semantique
("Dans quel personnage, objet ou piece voulez-vous positionner " &
Lexical.Our_String.Image (Nom) & " ?");
end if;
else
Syntax_Error.Semantique
(Lexical.Our_String.Image (Nom) & " n'existe pas");
end if;
else
Syntax_Error.Syntaxique (R_Effet, "L_Id");
end if;
when others =>
Syntax_Error.Syntaxique
(R_Effet,
"L_Incrementer ou L_Decrementer ou L_Valeur ou L_Afficher ou L_Commentaire ou L_Fin_De_Jeu ou L_Changer ou L_Positionner");
end case;
end Parse;
end Effet;
nblk1=19
nid=18
hdr6=30
[0x00] rec0=1f rec1=00 rec2=01 rec3=030
[0x01] rec0=02 rec1=00 rec2=11 rec3=058
[0x02] rec0=12 rec1=00 rec2=06 rec3=084
[0x03] rec0=17 rec1=00 rec2=04 rec3=060
[0x04] rec0=19 rec1=00 rec2=09 rec3=00a
[0x05] rec0=00 rec1=00 rec2=16 rec3=002
[0x06] rec0=11 rec1=00 rec2=08 rec3=08e
[0x07] rec0=1d rec1=00 rec2=07 rec3=056
[0x08] rec0=0b rec1=00 rec2=0c rec3=02c
[0x09] rec0=0e rec1=00 rec2=02 rec3=07a
[0x0a] rec0=18 rec1=00 rec2=03 rec3=024
[0x0b] rec0=16 rec1=00 rec2=05 rec3=014
[0x0c] rec0=03 rec1=00 rec2=0d rec3=00c
[0x0d] rec0=0e rec1=00 rec2=10 rec3=06c
[0x0e] rec0=0f rec1=00 rec2=0b rec3=020
[0x0f] rec0=0d rec1=00 rec2=14 rec3=06e
[0x10] rec0=13 rec1=00 rec2=19 rec3=00a
[0x11] rec0=07 rec1=00 rec2=17 rec3=02c
[0x12] rec0=12 rec1=00 rec2=15 rec3=020
[0x13] rec0=0c rec1=00 rec2=12 rec3=038
[0x14] rec0=11 rec1=00 rec2=0e rec3=02c
[0x15] rec0=06 rec1=00 rec2=0a rec3=02c
[0x16] rec0=10 rec1=00 rec2=13 rec3=072
[0x17] rec0=10 rec1=00 rec2=0f rec3=000
[0x18] rec0=00 rec1=00 rec2=00 rec3=000
tail 0x2174b0bb486546745db59 0x42a00088462060003
Free Block Chain:
0x18: 0000 00 00 00 28 80 25 20 20 55 6e 5f 45 66 66 65 74 ┆ ( % Un_Effet┆