DataMuseum.dk

Presents historical artifacts from the history of:

Rational R1000/400 Tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about Rational R1000/400 Tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - download
Index: ┃ B T

⟦6afbd287b⟧ TextFile

    Length: 4705 (0x1261)
    Types: TextFile
    Names: »B«

Derivation

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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;