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 - 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;