DataMuseum.dk Presents historical artifacts from the history of: Rational R1000/400

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 Excavated with: AutoArchaeologist - Free & Open Source Software.

top - metrics - download

⟦0a496ba92⟧ Ada Source

    Length: 13312 (0x3400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Maitre, seg_05c1ac

Derivation

└─⟦8527c1e9b⟧ Bits:30000544 8mm tape, Rational 1000, Arrival backup of disks in PAM's R1000
    └─⟦cfc2e13cd⟧ »Space Info Vol 2« 
        └─⟦this⟧ 

with Mon_Terminal;  
with Services;
package body Maitre is


    Dernier_X : Gen.Tcoordonnees := 80;
    Dernier_Y : Gen.Tcoordonnees := 24;
    Dernier_Terminal : Integer := 2;

    De_Tir : Duration := 3.0;

    Terminaux : array (1 .. Dernier_Terminal) of Mon_Terminal.Handle;

    Al_Energ : Gen.Tenergie := 10;
    Ch_Energ : Gen.Tenergie := 30;
    Ra_Energ : Gen.Tenergie := 10;
    Va_Energ : Gen.Tenergie := 100;
    Ba_Energ : Gen.Tenergie := Gen.Tenergie'Last;

    Cy_Base : Integer := 10;

    Dernier_Asteroide : Integer := 4;

    subtype S10 is String (1 .. 10);
    S10_Nulle : constant S10 := (others => ' ');

    Buffer_En_Vie : Boolean := True;

    task Buffer is
        entry Put (C : in Character);
        entry Get (S : out S10);
    end Buffer;

    task body Buffer is  
        Plein : Boolean := False;
        Reponse : S10 := (others => ' ');
        Index : Integer := 1;
    begin
        while Buffer_En_Vie loop
            select
                when not Plein =>
                    accept Put (C : in Character) do
                        if C = Ascii.Cr then
                            Plein := True;
                        else
                            Reponse (Index) := C;
                            if Index < S10'Length then
                                Index := Index + 1;
                            else
                                Plein := True;
                            end if;
                        end if;
                    end Put;
            or
                when Plein =>
                    accept Get (S : out S10) do
                        S := Reponse;
                        Reponse := (others => ' ');
                        Index := 1;
                        Plein := False;
                    end Get;
            or
                delay 1.0;
            end select;
        end loop;
    exception
        when others =>
            null;
    end Buffer;

    procedure Ecrire  
                 (X, Y : in Gen.Tcoordonnees;
                  S : in String;
                  T : in Integer;
                  Blink : in Boolean := False) is
        X0 : Gen.Tcoordonnees := X;
    begin
        for I in S'Range loop
            Mon_Terminal.Ecrire (Terminal => Terminaux (T),
                                 C => S (I),
                                 X => X0,
                                 Y => Y,
                                 Blink => Blink);
            X0 := X0 + 1;
        end loop;
    end Ecrire;

    function Question (S : in String) return Character is
        R : S10 := (others => ' ');  
        B : constant String (1 .. S'Length) := (others => ' ');
    begin
        Ecrire (X => 1, Y => 15, S => S, T => 1);
        Buffer.Get (S => R);  
        Ecrire (X => 1, Y => 15, S => B, T => 1);
        return R (1);
    end Question;
   function Question
                (S : in String; Min, Max, Defaut : in Integer) return Integer is
        I : Integer;
        R : S10 := (others => ' ');
        Q : constant String := S & " [" & Integer'Image (Min) & ".." &
                                  Integer'Image (Max) & "] (defaut = " &
                                  Integer'Image (Defaut) & ") ?";
        B : constant String (1 .. Q'Length) := (others => ' ');
    begin
        loop
            Ecrire (X => 1, Y => 15, S => Q, T => 1);
            R := (others => ' ');
            Buffer.Get (S => R);
            begin
                if R = S10_Nulle then
                    I := Defaut;
                    exit;
                else  
                    I := Integer'Value (R);
                    if (I >= Min) and (I <= Max) then
                        exit;
                    end if;
                end if;
            exception
                when others =>
                    null;
            end;
        end loop;  
        Ecrire (X => 1, Y => 15, S => B, T => 1);
        return I;
    end Question;

    procedure Init_Configuration is  
        C : Character;
        Choix_Config : Character := ' ';
    begin
        Mon_Terminal.Init_Configuration;
        Terminaux (1) := Mon_Terminal.Creer (No => 1);
        for I in 2 .. Dernier_Terminal loop
            Terminaux (I) := Mon_Terminal.Creer (No => I);
        end loop;
        Ecrire (X => 20, Y => 15, S => "MAITRE", T => 1);
        delay 2.0;
        Ecrire (X => 20, Y => 15, S => "      ", T => 1);
        Choix_Config := Question ("Valeurs par defaut : d");
        if Choix_Config /= 'd' then
            Dernier_Terminal := Question ("Nombre de terminaux",
                                          2, 8, Dernier_Terminal);
            Dernier_Asteroide := Question ("Nombre d'asteroide", 1,
                                           15, Dernier_Asteroide);
            Cy_Base := Question ("cycle de base (1/10)", 0, 10, Cy_Base);
            De_Tir := Duration (Question ("intervale entre 2 tirs",
                                          1, 9, Integer (De_Tir)));
            Al_Energ := Gen.Tenergie (Question ("seuil d'alarme d'energie", 1,
                                                Integer (Gen.Tenergie'Last),
                                                Integer (Al_Energ)));
            Ch_Energ := Gen.Tenergie (Question ("energie perdue lors d'un choc",
                                                1, Integer (Gen.Tenergie'Last),
                                                Integer (Ch_Energ)));
            Ra_Energ := Gen.Tenergie
                           (Question ("energie gagnee lors d'un ravitaillement",
                                      1, Integer (Gen.Tenergie'Last),
                                      Integer (Ra_Energ)));
            Va_Energ := Gen.Tenergie
                           (Question ("energie initiale d'un vaisseau",
                                      1, Integer (Gen.Tenergie'Last),
                                      Integer (Va_Energ)));
            Ba_Energ := Gen.Tenergie (Question ("energie initiale de la base",
                                                1, Integer (Gen.Tenergie'Last),
                                                Integer (Ba_Energ)));
        end if;
    end Init_Configuration;

    function Dernier_Term return Integer is
    begin
        return Dernier_Terminal;
    end Dernier_Term;

    function Terms (I : in Integer) return Mon_Terminal.Handle is
    begin
        return Terminaux (I);
    end Terms;

    function Alerte_Energie return Gen.Tenergie is
    begin
        return Al_Energ;
    end Alerte_Energie;

    function Energie_Choc return Gen.Tenergie is
    begin
        return Ch_Energ;
    end Energie_Choc;

    function Energie_Ravitaillement return Gen.Tenergie is
    begin
        return Ra_Energ;
    end Energie_Ravitaillement;

    function Energie_Vaisseau return Gen.Tenergie is
    begin
        return Va_Energ;
    end Energie_Vaisseau;

    function Energie_Base return Gen.Tenergie is
    begin
        return Ba_Energ;
    end Energie_Base;

    function Last_X return Gen.Tcoordonnees is
    begin
        return Dernier_X;
    end Last_X;

    function Last_Y return Gen.Tcoordonnees is
    begin
        return Dernier_Y;
    end Last_Y;

    function Nb_Asteroide return Integer is
    begin
        return Dernier_Asteroide;
    end Nb_Asteroide;

    function Delai_Tir return Duration is
    begin
        return De_Tir;
    end Delai_Tir;

    function Cycle_Base return Duration is
    begin
        return Duration (Cy_Base) / 10;
    end Cycle_Base;

    procedure Terminer (Raison : in String) is
    begin  
        for I in 1 .. Dernier_Terminal loop
            Ecrire (X => 20, Y => 15, S => "FINI " & Raison, T => I);
        end loop;
        delay 5.0;
        for I in 2 .. Dernier_Terminal loop
            Mon_Terminal.Fermer (Terminal => Terminaux (I));
        end loop;
        Mon_Terminal.Fermer (Terminal => Terminaux (1));
        Buffer_En_Vie := False;
    end Terminer;

    procedure Repondre (C : in Character) is
    begin
        Buffer.Put (C => C);  
    end Repondre;

end Maitre;

    nblk1=c
    nid=8
    hdr6=16
        [0x00] rec0=28 rec1=00 rec2=01 rec3=02c
        [0x01] rec0=1c rec1=00 rec2=04 rec3=00e
        [0x02] rec0=1f rec1=00 rec2=0b rec3=002
        [0x03] rec0=02 rec1=00 rec2=09 rec3=020
        [0x04] rec0=1b rec1=00 rec2=0c rec3=022
        [0x05] rec0=16 rec1=00 rec2=03 rec3=06c
        [0x06] rec0=02 rec1=00 rec2=0a rec3=022
        [0x07] rec0=0e rec1=00 rec2=05 rec3=07c
        [0x08] rec0=24 rec1=00 rec2=02 rec3=052
        [0x09] rec0=27 rec1=00 rec2=07 rec3=028
        [0x0a] rec0=0a rec1=00 rec2=06 rec3=000
        [0x0b] rec0=0b rec1=00 rec2=06 rec3=000
    tail 0x2176b684c89594208d5ee 0x42a00088462060003
Free Block Chain:
  0x8: 0000  00 00 00 06 80 03 72 5f 45 03 04 05 06 07 08 09  ┆      r_E       ┆