DataMuseum.dk

top - download

    Length: 3400 (0xd48)
    Types: TextFile
    Names: »B«

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

TextFile

with Text_Io;
package body Etape is
    package Int_Io is new Text_Io.Integer_Io (Integer);
    procedure Afficheruneetape (E : Etape) is
        Untemps : Temps;
        Uneaction : Action;
    begin
        if E /= Etapeinexistante then
            Untemps := Letempsdeletape (E);
            Uneaction := Lactiondeletape (E);
            Text_Io.Put ("Temps : ");
            Int_Io.Put (Untemps);
            Text_Io.Put (" Action : ");
            Int_Io.Put (Uneaction.Valeur1);
            Text_Io.Put (" ");
            Int_Io.Put (Uneaction.Valeur2);
            Text_Io.New_Line;
        else
            Text_Io.Put_Line ("Pointeur NIL , erreur");
        end if;
    end Afficheruneetape;


    function Creeruneetape
                (Untemps : Temps; Uneaction : Action; Uneetape : Etape)
                return Etape is
        Etapeaux : Etape;
    begin
        Etapeaux := new Celluleetape;
        Etapeaux.Letemps := Untemps;
        Etapeaux.Laction := Uneaction;
        Etapeaux.Lasuite := Uneetape;
        return Etapeaux;
    end Creeruneetape;

    function Letempsdeletape (Uneetape : Etape) return Temps is
    begin
        return Uneetape.Letemps;
    end Letempsdeletape;

    function Lactiondeletape (Uneetape : Etape) return Action is
    begin
        return Uneetape.Laction;
    end Lactiondeletape;

    function Lasuitedeletape (Uneetape : Etape) return Etape is
    begin
        return Uneetape.Lasuite;
    end Lasuitedeletape;

    procedure Changerletempsdeletape
                 (Uneetape : in out Etape; Untemps : Temps) is
    begin
        Uneetape.Letemps := Untemps;
    end Changerletempsdeletape;

    procedure Changerlactiondeletape
                 (Uneetape : in out Etape; Uneaction : Action) is
    begin
        Uneetape.Laction := Uneaction;
    end Changerlactiondeletape;

-- rmq : L'etape E qui est retournee est la meme que celle transmise
-- elle n'est pas modifiee mais doit etre passee par adresse pour que
-- des affectations ( insertions) puissent se faire pdt la recursion arriere
    procedure Caseruneactiondanslesetapes
                 (T : Temps; A : Action; E : in out Etape) is
    begin
        if E = Etapeinexistante then  -- OK
            E := Creeruneetape (T, A, E);
        else
            if T = Letempsdeletape (E) then  -- OK
                Changerlactiondeletape (E, A);
            else
                if T > Letempsdeletape (E) then -- OK
                    Caseruneactiondanslesetapes (T, A, E.Lasuite);
                else
                    E := Creeruneetape (T, A, E);    -- OK
                end if;
            end if;
        end if;
    end Caseruneactiondanslesetapes;

    procedure Detruireletape (E : in out Etape) is
    begin
        E := Etapeinexistante;
    end Detruireletape;

    procedure Exclureuneactiondesetapes (E : in out Etape; T : Temps) is
        A_Jeter : Etape;
    begin
        if E /= Etapeinexistante then  -- OK
            if T = Letempsdeletape (E) then
                begin
                    A_Jeter := E;
                    E := E.Lasuite;
                    Detruireletape (A_Jeter);   -- OK
                end;
            else
                if T > Letempsdeletape (E) then  -- OK
                    Exclureuneactiondesetapes (E.Lasuite, T);
                end if;
            end if;
        end if;
    end Exclureuneactiondesetapes;
end Etape;