⟦43594cc04⟧

TextFile

with Text_Io;

package body Toto is

    Max : constant := 255;


    type Un_Acteur is
        record
            L_Acteur : Standard_String.Object;
            L_Adresse : Integer;
            Le_Type : Standard_String.Object;
        end record;

    type Une_Action is
        record
            L_Action : Standard_String.Object;
            Le_Type : Standard_String.Object;
            Le_Code : Integer;
        end record;

    Tableau_Actions : array (1 .. Max) of Une_Action;
    Tableau_Acteurs : array (1 .. Max) of Un_Acteur;

    Nombre_Actions : Integer range 0 .. Max;
    Nombre_Acteurs : Integer range 0 .. Max;


    package Materiels is

        procedure Ouvrir_Bloc_Materiel;
        procedure Fermer_Bloc_Materiel;
        function Type_Existe (Un_Type : Standard_String.Object) return Boolean;
        procedure Nouveau_Type (Un_Type : Standard_String.Object);
        procedure Fin_Nouveau_Type;
        procedure Nouvelle_Action (Une_Action : Standard_String.Object);
        procedure Donner_Code_Action (Un_Code : Integer);
        procedure Fin_Nouvelle_Action;
        procedure Ouvrir_Champ_Option;
        procedure Fermer_Champ_Option;  
        procedure Imprimer_Materiel;

    end Materiels;


    procedure Ouvrir_Bloc_Materiel is  
    begin
        Materiels.Ouvrir_Bloc_Materiel;
    end Ouvrir_Bloc_Materiel;


    procedure Fermer_Bloc_Materiel is
    begin
        Materiels.Fermer_Bloc_Materiel;
    end Fermer_Bloc_Materiel;


    procedure Nouveau_Type (Un_Type : Standard_String.Object) is
    begin
        Materiels.Nouveau_Type (Un_Type);
    end Nouveau_Type;


    procedure Fin_Nouveau_Type is
    begin
        Materiels.Fin_Nouveau_Type;
    end Fin_Nouveau_Type;


    procedure Nouvelle_Action (Une_Action : Standard_String.Object) is
    begin
        Materiels.Nouvelle_Action (Une_Action);
    end Nouvelle_Action;


    procedure Donner_Code_Action (Un_Code : Integer) is
    begin
        Materiels.Donner_Code_Action (Un_Code);
    end Donner_Code_Action;


    procedure Fin_Nouvelle_Action is
    begin
        Materiels.Fin_Nouvelle_Action;
    end Fin_Nouvelle_Action;


    procedure Ouvrir_Champ_Option is
    begin
        Materiels.Ouvrir_Champ_Option;
    end Ouvrir_Champ_Option;


    procedure Fermer_Champ_Option is
    begin
        Materiels.Fermer_Champ_Option;
    end Fermer_Champ_Option;


    procedure Imprimer_Materiel is
    begin
        Materiels.Imprimer_Materiel;
    end Imprimer_Materiel;


    package body Materiels is

        Index_Courant : Integer range 1 .. Max;
        Type_Courant : Standard_String.Object;
        Action_Courante : Standard_String.Object;
        Code_Courant : Integer;
        Erreur_Type : Boolean := False;
        Erreur_Action : Boolean := False;
        Erreur_Code : Boolean := False;


        procedure Ouvrir_Bloc_Materiel is
        begin
            Index_Courant := 1;
        end Ouvrir_Bloc_Materiel;


        procedure Fermer_Bloc_Materiel is
        begin
            Nombre_Actions := Index_Courant - 1;
        end Fermer_Bloc_Materiel;


        function Type_Existe
                    (Un_Type : Standard_String.Object) return Boolean is
        begin  
            for I in 1 .. (Index_Courant - 1) loop
                if Standard_String."="
                      (Tableau_Actions (I).Le_Type, Un_Type) then
                    return True;
                end if;
            end loop;
            return False;
        end Type_Existe;


        procedure Nouveau_Type (Un_Type : Standard_String.Object) is
        begin
            Erreur_Type := False;
            if Type_Existe (Un_Type) then
                Text_Io.Put_Line ("Le type '" &
                                  Standard_String.Get_Contents (Un_Type) &
                                  "' existe deja.");
                Erreur_Type := True;
            else
                Standard_String.Copy (From => Un_Type, To => Type_Courant);
            end if;  
        end Nouveau_Type;


        procedure Fin_Nouveau_Type is
        begin
            null;
        end Fin_Nouveau_Type;


        function Action_Existe
                    (Un_Type : Standard_String.Object;
                     Une_Action : Standard_String.Object) return Boolean is
        begin  
            for I in 1 .. (Index_Courant - 1) loop
                if (Standard_String."="
                       (Tableau_Actions (I).Le_Type, Un_Type)) and then
                   (Standard_String."="
                       (Tableau_Actions (I).L_Action, Une_Action)) then
                    return True;
                end if;
            end loop;
            return False;
        end Action_Existe;


        procedure Nouvelle_Action (Une_Action : Standard_String.Object) is
        begin
            if not (Erreur_Type) then
                if Action_Existe (Type_Courant, Une_Action) then
                    Text_Io.Put_Line
                       ("L'action '" &
                        Standard_String.Get_Contents (Une_Action) &
                        "' existe deja pour le type '" &
                        Standard_String.Get_Contents (Type_Courant) & "'.");
                    Erreur_Action := True;
                else
                    Standard_String.Copy (From => Une_Action,
                                          To => Action_Courante);
                end if;
            end if;
        end Nouvelle_Action;


        function Code_Existe
                    (Un_Type : Standard_String.Object; Un_Code : Integer)
                    return Boolean is
        begin  
            for I in 1 .. (Index_Courant - 1) loop
                if (Standard_String."="
                       (Tableau_Actions (I).Le_Type, Un_Type)) and then
                   (Tableau_Actions (I).Le_Code = Un_Code) then
                    return True;
                end if;
            end loop;
            return False;
        end Code_Existe;


        procedure Donner_Code_Action (Un_Code : Integer) is
        begin
            if (not Erreur_Type) and then (not Erreur_Action) then
                if Code_Existe (Type_Courant, Un_Code) then
                    Text_Io.Put_Line
                       ("Le code '" & Integer'Image (Un_Code) &
                        "' est identique pour 2 actions differentes pour le type '" &
                        Standard_String.Get_Contents (Type_Courant) & "'.");
                    Erreur_Code := True;
                else
                    Code_Courant := Un_Code;
                end if;
            end if;
        end Donner_Code_Action;


        procedure Fin_Nouvelle_Action is
        begin
            if Index_Courant = Max then
                Text_Io.Put_Line ("Depassement_Index");
            end if;

            if (not Erreur_Type) and then
               (not Erreur_Action) and then (not Erreur_Code) then
                Standard_String.Copy
                   (From => Action_Courante,
                    To => Tableau_Actions (Index_Courant).L_Action);
                Standard_String.Copy
                   (From => Type_Courant,
                    To => Tableau_Actions (Index_Courant).Le_Type);
                Tableau_Actions (Index_Courant).Le_Code := Code_Courant;
                Index_Courant := Index_Courant + 1;
            end if;
            Erreur_Action := False;
            Erreur_Code := False;  
        end Fin_Nouvelle_Action;


        procedure Ouvrir_Champ_Option is
        begin
            null;
        end Ouvrir_Champ_Option;


        procedure Fermer_Champ_Option is
        begin
            null;
        end Fermer_Champ_Option;


        procedure Imprimer_Materiel is  
        begin
            for I in 1 .. Nombre_Actions loop
                Text_Io.Put_Line
                   ("Nom action : " & Standard_String.Get_Contents
                                         (Tableau_Actions (I).L_Action) &
                    "  Type materiel : " &
                    (Standard_String.Get_Contents
                        (Tableau_Actions (I).Le_Type) & "  Code bitbus : " &
                     Integer'Image (Tableau_Actions (I).Le_Code)));
            end loop;  
            Text_Io.Put_Line ("");
            Text_Io.Put_Line ("");
        end Imprimer_Materiel;


    end Materiels;


    package Acteurs is
        procedure Ouvrir_Bloc_Acteur;
        procedure Fermer_Bloc_Acteur;
        procedure Nouvel_Acteur (Un_Acteur : Standard_String.Object);
        procedure Fin_Nouvel_Acteur;
        procedure Donner_Type_Acteur (Un_Type : Standard_String.Object);
        procedure Donner_Adresse_Station (Une_Adresse : Integer);  
        procedure Imprimer_Acteur;
    end Acteurs;


    procedure Ouvrir_Bloc_Acteur is
    begin
        Acteurs.Ouvrir_Bloc_Acteur;
    end Ouvrir_Bloc_Acteur;


    procedure Fermer_Bloc_Acteur is
    begin
        Acteurs.Fermer_Bloc_Acteur;
    end Fermer_Bloc_Acteur;


    procedure Nouvel_Acteur (Un_Acteur : Standard_String.Object) is
    begin
        Acteurs.Nouvel_Acteur (Un_Acteur);
    end Nouvel_Acteur;


    procedure Fin_Nouvel_Acteur is
    begin
        Acteurs.Fin_Nouvel_Acteur;
    end Fin_Nouvel_Acteur;


    procedure Donner_Type_Acteur (Un_Type : Standard_String.Object) is
    begin
        Acteurs.Donner_Type_Acteur (Un_Type);
    end Donner_Type_Acteur;


    procedure Donner_Adresse_Station (Une_Adresse : Integer) is
    begin
        Acteurs.Donner_Adresse_Station (Une_Adresse);
    end Donner_Adresse_Station;


    procedure Imprimer_Acteur is
    begin
        Acteurs.Imprimer_Acteur;
    end Imprimer_Acteur;



    package body Acteurs is


        Index_Courant : Integer range 1 .. Max;
        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
            Index_Courant := 1;  
        end Ouvrir_Bloc_Acteur;


        procedure Fermer_Bloc_Acteur is
        begin
            Nombre_Acteurs := Index_Courant - 1;
        end Fermer_Bloc_Acteur;


        function Acteur_Existe
                    (Un_Acteur : Standard_String.Object) return Boolean is
        begin  
            for I in 1 .. (Index_Courant - 1) loop
                if Standard_String."="
                      (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
                Text_Io.Put_Line ("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;


        function Type_Existe
                    (Un_Type : Standard_String.Object) return Boolean is  
        begin
            for I in 1 .. Nombre_Actions loop
                if Standard_String."="
                      (Tableau_Actions (I).Le_Type, Un_Type) then
                    return True;
                end if;
            end loop;
            return False;
        end Type_Existe;


        procedure Donner_Type_Acteur (Un_Type : Standard_String.Object) is
        begin
            if not Erreur_Acteur then
                if not Type_Existe (Un_Type) then
                    Text_Io.Put_Line ("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 .. (Index_Courant - 1) 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 Adresse_Existe (Une_Adresse) then  
                    Text_Io.Put_Line ("L'adresse '" &
                                      Integer'Image (Une_Adresse) &
                                      "' existe deja.");
                    Erreur_Adresse := True;
                else
                    Adresse_Courante := Une_Adresse;
                end if;
            end if;
        end Donner_Adresse_Station;


        procedure Fin_Nouvel_Acteur is
        begin
            if not Erreur_Acteur and then
               not Erreur_Type and then not Erreur_Adresse then
                Standard_String.Copy
                   (From => Acteur_Courant,
                    To => Tableau_Acteurs (Index_Courant).L_Acteur);
                Standard_String.Copy
                   (From => Type_Courant,
                    To => Tableau_Acteurs (Index_Courant).Le_Type);
                Tableau_Acteurs (Index_Courant).L_Adresse := Adresse_Courante;
                Index_Courant := Index_Courant + 1;  
            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;
    end Acteurs;


end Toto;
DataMuseum.dk

Rational R1000/400 Tapes

⟦43594cc04⟧ TextFile

Derivation

TextFile
