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

⟦617db4296⟧ Ada Source

    Length: 6144 (0x1800)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Trame_Ihm_68, seg_04e3e9

Derivation

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

with Util_String;

package body Trame_Ihm_68 is

    package Us renames Util_String;

    procedure Create (O : in out Object; Action : T_Action) is
    begin
        if Action in T_Action_Sur_Objet then
            raise Trame_Ihm_68_Error;
        else
            declare
                O2 : Object (Action);
            begin
                O := O2;
            end;
        end if;
    end Create;


    procedure Create (O : in out Object;
                      Action : T_Action;
                      Type_Objet : T_Type_Objet;
                      S : String) is
    begin
        if Action in T_Action_Sur_Objet then
            declare
                O2 : Object (Action);
            begin
                O2.Type_Objet := Type_Objet;
                if S'Length > Max_Taille_String then
                    O2.Chaine := S (S'First .. S'First + Max_Taille_String - 1);
                else
                    O2.Chaine
                       (O2.Chaine'First .. O2.Chaine'First + S'Length - 1) := S;
                    O2.Chaine (O2.Chaine'First + S'Length .. O2.Chaine'Last) :=
                       (O2.Chaine'First + S'Length .. O2.Chaine'Last => ' ');
                end if;
                O := O2;
            end;
        else
            raise Trame_Ihm_68_Error;
        end if;
    end Create;


    function Get_Action (O : Object) return T_Action is
    begin
        return O.Action;
    end Get_Action;


    function Get_Type_Objet (O : Object) return T_Type_Objet is
    begin
        if O.Action in T_Action_Sur_Objet then
            return O.Type_Objet;
        else
            raise Trame_Ihm_68_Error;
        end if;
    end Get_Type_Objet;


    function Get_Chaine (O : Object) return String is
    begin
        if O.Action in T_Action_Sur_Objet then
            return Us.Suppression_Espace_Right (O.Chaine);
        else
            raise Trame_Ihm_68_Error;
        end if;
    end Get_Chaine;


    function Image (O : Object) return String is
    begin  
        if Get_Action (O) in T_Action_Sur_Objet then
            declare
                S : constant String := Get_Chaine (O);
            begin
                return (Debut_Trame &
                        T_Action'Image (Get_Action (O)) & Sep_Trame &
                        T_Type_Objet'Image (Get_Type_Objet (O)) & Sep_Trame &
                        Us.Suppression_Espace_Left (Natural'Image (S'Length)) &
                        Sep_Trame & S &
                        Sep_Trame & Fin_Trame);
            end;
        else
            return (Debut_Trame & T_Action'Image (Get_Action (O)) &
                    Sep_Trame & Fin_Trame);
        end if;  
    end Image;


    function Value (S : String) return Object is
        Action : T_Action;
        Type_Objet : T_Type_Objet;
        Taille : Natural;  
        P1, P2, P3, P4, P5 : Natural;
        O : Object;
    begin
        Us.String_Contient (S, Debut_Trame, P1);
        Us.Position (S (P1 + 1 .. S'Last), Sep_Trame, P2); -- Action

        Action := T_Action'Value (S (P1 + 1 .. P2 - 1));

        if Action in T_Action_Sur_Objet then
            Us.Position (S (P2 + 1 .. S'Last), Sep_Trame, P3); -- Type Objet
            Type_Objet := T_Type_Objet'Value (S (P2 + 1 .. P3 - 1));
            Us.Position (S (P3 + 1 .. S'Last), Sep_Trame, P4); -- Taille
            Taille := Natural'Value (S (P3 + 1 .. P4 - 1));
            Us.String_Contient (S (P4 + Taille + 2 .. S'Last), Fin_Trame, P5);
            Create (O, Action, Type_Objet, S (P4 + 1 .. P4 + Taille));
        else  
            Us.String_Contient (S (P2 + 1 .. S'Last), Fin_Trame, P3);
            Create (O, Action);  
        end if;  
        return O;
    end Value;

end Trame_Ihm_68;

    nblk1=5
    nid=3
    hdr6=8
        [0x00] rec0=24 rec1=00 rec2=01 rec3=014
        [0x01] rec0=21 rec1=00 rec2=05 rec3=038
        [0x02] rec0=1d rec1=00 rec2=04 rec3=044
        [0x03] rec0=17 rec1=00 rec2=02 rec3=000
        [0x04] rec0=0d rec1=00 rec2=02 rec3=000
    tail 0x21549fd74876b55c9fe26 0x42a00088462060003
Free Block Chain:
  0x3: 0000  00 00 03 fc 80 42 20 20 20 20 20 20 20 20 20 28  ┆     B         (┆