|
|
DataMuseum.dkPresents historical artifacts from the history of: Rational R1000/400 Tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about Rational R1000/400 Tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: B T
Length: 4705 (0x1261)
Types: TextFile
Names: »B«
└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
└─⟦129cab021⟧ »DATA«
└─⟦this⟧
separate (Semantique)
package body Acteurs is
Type_Courant : Standard_String.Object;
Acteur_Courant : Standard_String.Object;
Adresse_Courante : Integer := 0;
Erreur_Type : Boolean := False;
Erreur_Acteur : Boolean := False;
Erreur_Adresse : Boolean := False;
procedure Ouvrir_Bloc_Acteur is
begin
Nombre_Acteurs := 0;
end Ouvrir_Bloc_Acteur;
procedure Fermer_Bloc_Acteur is
begin
null;
end Fermer_Bloc_Acteur;
function Acteur_Existe
(Un_Acteur : Standard_String.Object) return Boolean is
begin
for I in 1 .. Nombre_Acteurs loop
if Standard_String.Equal
(Tableau_Acteurs (I).L_Acteur, Un_Acteur) then
return True;
end if;
end loop;
return False;
end Acteur_Existe;
procedure Nouvel_Acteur (Un_Acteur : Standard_String.Object) is
begin
Erreur_Acteur := False;
if Acteur_Existe (Un_Acteur) then
Erreurs.Ajouter ("L'acteur '" &
Standard_String.Get_Contents (Un_Acteur) &
"' existe deja.");
Erreur_Acteur := True;
else
Standard_String.Copy (From => Un_Acteur, To => Acteur_Courant);
end if;
end Nouvel_Acteur;
procedure Donner_Type_Acteur (Un_Type : Standard_String.Object) is
begin
if not Erreur_Acteur then
if not Materiels.Type_Existe (Un_Type) then
Erreurs.Ajouter ("Le type '" &
Standard_String.Get_Contents (Un_Type) &
"' n'existe pas.");
Erreur_Type := True;
else
Standard_String.Copy (From => Un_Type, To => Type_Courant);
end if;
end if;
end Donner_Type_Acteur;
function Adresse_Existe (Une_Adresse : Integer) return Boolean is
begin
for I in 1 .. Nombre_Acteurs loop
if Tableau_Acteurs (I).L_Adresse = Une_Adresse then
return True;
end if;
end loop;
return False;
end Adresse_Existe;
procedure Donner_Adresse_Station (Une_Adresse : Integer) is
begin
if not Erreur_Acteur and then not Erreur_Type then
if Une_Adresse >= 0 and then Une_Adresse <= 99 then
if Adresse_Existe (Une_Adresse) then
Erreurs.Ajouter ("L'adresse '" &
Integer'Image (Une_Adresse) &
"' existe deja.");
Erreur_Adresse := True;
else
Adresse_Courante := Une_Adresse;
end if;
else
Erreurs.Ajouter
("L'adresse doit etre comprise entre 00 et 99.");
Erreur_Adresse := True;
end if;
end if;
end Donner_Adresse_Station;
procedure Fin_Nouvel_Acteur is
begin
if Nombre_Acteurs = Max then
Erreurs.Ajouter ("Nombre d'acteurs trop grand");
end if;
if not Erreur_Acteur and then
not Erreur_Type and then not Erreur_Adresse then
Nombre_Acteurs := Nombre_Acteurs + 1;
Standard_String.Copy
(From => Acteur_Courant,
To => Tableau_Acteurs (Nombre_Acteurs).L_Acteur);
Standard_String.Copy
(From => Type_Courant,
To => Tableau_Acteurs (Nombre_Acteurs).Le_Type);
Tableau_Acteurs (Nombre_Acteurs).L_Adresse := Adresse_Courante;
end if;
Erreur_Type := False;
Erreur_Adresse := False;
end Fin_Nouvel_Acteur;
procedure Imprimer_Acteur is
begin
for I in 1 .. Nombre_Acteurs loop
Text_Io.Put_Line
("Nom acteur : " &
Standard_String.Get_Contents (Tableau_Acteurs (I).L_Acteur) &
" Type materiel : " &
(Standard_String.Get_Contents (Tableau_Acteurs (I).Le_Type) &
" Adresse : " &
Integer'Image (Tableau_Acteurs (I).L_Adresse)));
end loop;
end Imprimer_Acteur;
function Donne_Type_Acteur (Un_Acteur : Standard_String.Object)
return Standard_String.Object is
begin
for I in 1 .. Nombre_Acteurs loop
if Standard_String.Equal
(Tableau_Acteurs (I).L_Acteur, Un_Acteur) then
return Tableau_Acteurs (I).Le_Type;
end if;
end loop;
return Standard_String.Empty_String;
end Donne_Type_Acteur;
end Acteurs;