DataMuseum.dk

top - download

    Length: 5014 (0x1396)
    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 Product is
    package Int_Io is new Text_Io.Integer_Io (Integer);

    F : Text_Io.File_Type;

    procedure Openoutputfile (Filename : String := "outfile") is
    begin
        Text_Io.Create (File => F, Mode => Text_Io.Out_File, Name => Filename);
    end Openoutputfile;

    procedure Closeoutputfile is
    begin
        Text_Io.Close (F);
    end Closeoutputfile;

    procedure Sendtofile (Value1, Value2, Value3, Value4, Value5 : Integer) is
    begin
        Int_Io.Put (F, Value1);
        Int_Io.Put (F, Value2);
        Int_Io.Put (F, Value3);
        Int_Io.Put (F, Value4);
        Int_Io.Put (F, Value5);
        Text_Io.New_Line (F);
    end Sendtofile;

    procedure Productactiver (Ptr : Reduct.Preductnode) is
        Periph, Actor, Time : Integer;
    begin
        Periph := Ptr.Act_Periph;
        Actor := Ptr.Act_Actor;
        Time := Ptr.Thetime;
        Sendtofile (Periph, Actor, Time, 1, 0);
    end Productactiver;

    procedure Productdesactiver (Ptr : Reduct.Preductnode) is
        Periph, Actor, Time : Integer;
    begin
        Periph := Ptr.Des_Periph;
        Actor := Ptr.Des_Actor;
        Time := Ptr.Thetime;
        Sendtofile (Periph, Actor, Time, 0, 0);
    end Productdesactiver;

    procedure Productmodifier (Ptr : Reduct.Preductnode) is
        Periph, Actor, Value1, Time : Integer;
    begin
        Periph := Ptr.Mod_Periph;
        Actor := Ptr.Mod_Actor;
        Value1 := Ptr.Mod_Nbre;
        Time := Ptr.Thetime;
        Sendtofile (Periph, Actor, Time, Value1, 0);
    end Productmodifier;

    procedure Productevoluer (Ptr : Reduct.Preductnode) is
        Periph, Actor, Value1, Value2, Time : Integer;
    begin
        Periph := Ptr.Evo_Periph;
        Actor := Ptr.Evo_Actor;
        Value1 := Ptr.Evo_Nbre1;
        Value2 := Ptr.Evo_Nbre2;
        Time := Ptr.Thetime;
        Sendtofile (Periph, Actor, Time, Value1, Value2);
    end Productevoluer;

    procedure Producttree (Ptrareducttree : Reduct.Preductnode) is
        use Reduct;
        Ptr : Reduct.Preductnode;
    begin
        Ptr := Ptrareducttree;
        while Ptr /= null loop
            case Ptr.Thetype is
                when Act =>
                    Productactiver (Ptr);
                when Des =>
                    Productdesactiver (Ptr);
                when Modi =>
                    Productmodifier (Ptr);
                when Evo =>
                    Productevoluer (Ptr);
                when None =>
                    null;
            end case;
            Ptr := Ptr.Next;
        end loop;
    end Producttree;

-- Tests affichage
    procedure Printactiver (Ptr : Reduct.Preductnode) is
        Periph, Actor, Time : Integer;
    begin
        Periph := Ptr.Act_Periph;
        Actor := Ptr.Act_Actor;
        Time := Ptr.Thetime;
        Text_Io.Put_Line (Integer'Image (Periph) & " " & Integer'Image (Actor) &
                          " " & Integer'Image (Time) & " 1 0");
    end Printactiver;

    procedure Printdesactiver (Ptr : Reduct.Preductnode) is
        Periph, Actor, Time : Integer;
    begin
        Periph := Ptr.Des_Periph;
        Actor := Ptr.Des_Actor;
        Time := Ptr.Thetime;
        Text_Io.Put_Line (Integer'Image (Periph) & " " & Integer'Image (Actor) &
                          " " & Integer'Image (Time) & " 0 0");
    end Printdesactiver;

    procedure Printmodifier (Ptr : Reduct.Preductnode) is
        Periph, Actor, Value1, Time : Integer;
    begin
        Periph := Ptr.Mod_Periph;
        Actor := Ptr.Mod_Actor;
        Value1 := Ptr.Mod_Nbre;
        Time := Ptr.Thetime;
        Text_Io.Put_Line (Integer'Image (Periph) & " " & Integer'Image (Actor) &
                          " " & Integer'Image (Time) & " " &
                          Integer'Image (Value1) & " 0");
    end Printmodifier;

    procedure Printevoluer (Ptr : Reduct.Preductnode) is
        Periph, Actor, Value1, Value2, Time : Integer;
    begin
        Periph := Ptr.Evo_Periph;
        Actor := Ptr.Evo_Actor;
        Value1 := Ptr.Evo_Nbre1;
        Value2 := Ptr.Evo_Nbre2;
        Time := Ptr.Thetime;
        Text_Io.Put_Line (Integer'Image (Periph) & " " & Integer'Image (Actor) &
                          " " & Integer'Image (Time) & Integer'Image (Value1) &
                          " " & Integer'Image (Value2));
    end Printevoluer;

    procedure Printtree (Ptrareducttree : Reduct.Preductnode) is
        use Reduct;
        Ptr : Reduct.Preductnode;
    begin
        Ptr := Ptrareducttree;
        while Ptr /= null loop
            case Ptr.Thetype is
                when Act =>
                    Printactiver (Ptr);
                when Des =>
                    Printdesactiver (Ptr);
                when Modi =>
                    Printmodifier (Ptr);
                when Evo =>
                    Printevoluer (Ptr);
                when None =>
                    null;
            end case;
            Ptr := Ptr.Next;
        end loop;
    end Printtree;

end Product;