DataMuseum.dk

top - download

    Length: 5831 (0x16c7)
    Types: TextFile
    Names: »B«

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

TextFile

separate (Semantique)
package body Materiels is

    Type_Courant : Standard_String.Object;
    Action_Courante : Standard_String.Object;
    Code_Courant : Integer;
    Option_De_Courante : Lexical.Token := L_Unk;
    Option_Vers_Courante : Lexical.Token := L_Unk;
    Option_En_Courante : Lexical.Token := L_Unk;
    Erreur_Type : Boolean := False;
    Erreur_Action : Boolean := False;
    Erreur_Code : Boolean := False;


    procedure Ouvrir_Bloc_Materiel is
    begin
        Nombre_Actions := 0;
    end Ouvrir_Bloc_Materiel;


    procedure Fermer_Bloc_Materiel is
    begin
        null;
    end Fermer_Bloc_Materiel;


    function Type_Existe (Un_Type : Standard_String.Object) return Boolean is
    begin  
        for I in 1 .. (Nombre_Actions) loop
            if Standard_String.Equal (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
            Erreurs.Ajouter ("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 .. (Nombre_Actions) loop
            if (Standard_String.Equal
                   (Tableau_Actions (I).Le_Type, Un_Type)) and then
               (Standard_String.Equal
                   (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
                Erreurs.Ajouter
                   ("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;


    procedure Donner_Code_Action (Un_Code : Integer) is
    begin
        if not Erreur_Type and then not Erreur_Action then
            if Un_Code >= 0 and then Un_Code <= 999999 then
                Code_Courant := Un_Code;
            else
                Erreurs.Ajouter
                   ("Le code de l'action doit etre compris entre 00 et 999999");
                Erreur_Code := True;  
            end if;
        end if;
    end Donner_Code_Action;
    procedure Fin_Nouvelle_Action is
    begin
        if Nombre_Actions = Max then
            Erreurs.Ajouter ("Nombre d'actions trop grand");
        end if;

        if (not Erreur_Type) and then
           (not Erreur_Action) and then (not Erreur_Code) then
            Nombre_Actions := Nombre_Actions + 1;
            Standard_String.Copy
               (From => Action_Courante,
                To => Tableau_Actions (Nombre_Actions).L_Action);
            Standard_String.Copy
               (From => Type_Courant,
                To => Tableau_Actions (Nombre_Actions).Le_Type);
            Tableau_Actions (Nombre_Actions).Le_Code := Code_Courant;
            Tableau_Actions (Nombre_Actions).De := Option_De_Courante;
            Tableau_Actions (Nombre_Actions).Vers := Option_Vers_Courante;
            Tableau_Actions (Nombre_Actions).En := Option_En_Courante;
        end if;
        Erreur_Action := False;
        Erreur_Code := False;  
    end Fin_Nouvelle_Action;


    procedure Ouvrir_Champ_Option is
    begin
        null;
    end Ouvrir_Champ_Option;


    procedure Option (Une_Option : Lexical.Token) is
    begin
        case Une_Option is
            when L_De =>
                Option_De_Courante := Lexical.L_Ok;
            when L_Vers =>
                Option_Vers_Courante := Lexical.L_Ok;
            when L_En =>
                Option_En_Courante := Lexical.L_Ok;
            when others =>
                null;
        end case;
    end 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)) &
                              " de : " & Lexical.Token'Image
                                            (Tableau_Actions (I).De) &
                              " vers : " & Lexical.Token'Image
                                              (Tableau_Actions (I).Vers) &
                              " en : " & Lexical.Token'Image
                                            (Tableau_Actions (I).En));
        end loop;  
        Text_Io.Put_Line ("");
        Text_Io.Put_Line ("");
    end Imprimer_Materiel;


end Materiels;