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 - download

⟦dee542873⟧ Ada Source

    Length: 5120 (0x1400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Player_Lex, seg_04136f

Derivation

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

with Screen;
use Screen;
package body Player_Lex is

    Max_Mot : constant Natural := 4;

    subtype Digit is Character range '0' .. '9';
    subtype Lowercase is Character range 'a' .. 'z';
    subtype Uppercase is Character range 'A' .. 'Z';


    function Get_Command (Nb_Mot : in out Natural; Tab_Mot : in out Tableau_Mot)
                         return Boolean is
        Une_Chaine : String (1 .. 80);
        Nb_Car_Lu, Cpt : Natural;
        Nouveau_Mot : Boolean := True;
        Success : Boolean := True;
    begin
        Read_Player (Une_Chaine, Nb_Car_Lu);
        Tab_Mot := (1 .. Max_Mot => Ubs.Nil);
        Cpt := 1;
        Nb_Mot := 0;
        while (Cpt <= Nb_Car_Lu) and Success loop
            case Une_Chaine (Cpt) is
                when Digit | Lowercase | Uppercase | '_' =>
                    if not Nouveau_Mot then
                        Ubs.Append (Tab_Mot (Nb_Mot), Une_Chaine (Cpt));
                        Cpt := Cpt + 1;
                    else
                        Nb_Mot := Nb_Mot + 1;
                        Ubs.Free (Tab_Mot (Nb_Mot));
                        Nouveau_Mot := False;
                    end if;
                when ' ' =>
                    while Une_Chaine (Cpt) = ' ' loop
                        Cpt := Cpt + 1;
                    end loop;
                    Nouveau_Mot := True;
                when others =>
                    Success := False;
            end case;
        end loop;
        return Success;
    end Get_Command;

    procedure Control_Command is
        Success : Boolean;
        Tab : Tableau_Mot;
        Nb_Mots : Natural;
    begin
        Open_All_Win;
        loop
            if not Get_Command (Nb_Mots, Tab) then
                Write_World ("Une erreur de syntaxe a ete detecte !!");
            elsif Nb_Mots > Max_Mots then
                Write_World ("Il y a trop de mots dans la phrase !!");
            else
                exit when Ubs.Image (Tab (1)) = "quit";
                for I in Tab'Range loop
                    Write_World (Ubs.Image (Tab (I)));
                end loop;
            end if;
        end loop;
        Close_All_Win;
    end Control_Command;

end Player_Lex;

    nblk1=4
    nid=2
    hdr6=6
        [0x00] rec0=1d rec1=00 rec2=01 rec3=048
        [0x01] rec0=1d rec1=00 rec2=03 rec3=01c
        [0x02] rec0=0b rec1=00 rec2=04 rec3=000
        [0x03] rec0=0d rec1=00 rec2=02 rec3=000
    tail 0x21741487c86127f5ea982 0x42a00088462060003
Free Block Chain:
  0x2: 0000  00 00 00 05 80 02 20 2b 02 03 6f 70 3b 07 00 10  ┆       +  op;   ┆