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

⟦47ba6d461⟧ Ada Source

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

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 Semaine_68 is

    package Us renames Util_String;

    procedure Create_Semaine_Pleine (O : in out Object) is
    begin
        O.Semaine := (Lundi .. Dimanche => True);
    end Create_Semaine_Pleine;


    procedure Create_Semaine_Vide (O : in out Object) is
    begin
        O.Semaine := (Lundi .. Dimanche => False);
    end Create_Semaine_Vide;


    procedure Ajout_Jour (O : in out Object; Jour : T_Jour_Semaine) is
    begin
        O.Semaine (Jour) := True;
    end Ajout_Jour;


    procedure Suppr_Jour (O : in out Object; Jour : T_Jour_Semaine) is
    begin
        O.Semaine (Jour) := False;
    end Suppr_Jour;


    function Image (O : Object) return String is
        S : String (1 .. 7);
        S1 : constant String (1 .. 7) := "_______";
        S2 : constant String (1 .. 7) := "LMMJVSD";
        J : T_Jour_Semaine := T_Jour_Semaine'First;
    begin
        for I in S'Range loop  
            if O.Semaine (J) then
                S (I) := S2 (I);
            else
                S (I) := S1 (I);
            end if;  
            if J /= Dimanche then
                J := T_Jour_Semaine'Succ (J);
            end if;
        end loop;
        return (Debut_Semaine & S & Sep_Semaine & Fin_Semaine);
    end Image;

    function Value (S : String) return Object is
        O : Object;
        Der_Car : Natural;
    begin  
        Value (S, O, Der_Car);
        return O;
    end Value;

    function String_To_Object (S : String) return Object is
        O : Object;
        J : T_Jour_Semaine := T_Jour_Semaine'First;
    begin
        if S'Length > 7 then
            raise Jour_Semaine_Error;
        else  
            Create_Semaine_Vide (O);
            for I in S'Range loop  
                O.Semaine (J) := (S (I) /= '_');
                if J /= Dimanche then
                    J := T_Jour_Semaine'Succ (J);
                end if;
            end loop;
        end if;
        return O;
    end String_To_Object;

    procedure Value (S : String; O : in out Object; Der_Car : in out Natural) is
        P1, P2, P3 : Natural;
    begin  
        Us.String_Contient (S, Debut_Semaine, P1);
        Us.Position (S (P1 + 1 .. S'Last), Sep_Semaine, P2);
        Us.String_Contient (S (P2 + 1 .. S'Last), Fin_Semaine, P3);

        O := String_To_Object (S (P1 + 1 .. P2 - 1));
        Der_Car := P3;
    end Value;

    function Jour_Is_In (O : Object; Jour : T_Jour_Semaine) return Boolean is
    begin
        return O.Semaine (Jour);
    end Jour_Is_In;

end Semaine_68;

    nblk1=4
    nid=3
    hdr6=6
        [0x00] rec0=27 rec1=00 rec2=01 rec3=008
        [0x01] rec0=20 rec1=00 rec2=02 rec3=01a
        [0x02] rec0=17 rec1=00 rec2=04 rec3=000
        [0x03] rec0=12 rec1=00 rec2=02 rec3=000
    tail 0x2154a10e0876c30c30503 0x42a00088462060003
Free Block Chain:
  0x3: 0000  00 00 00 04 80 01 20 01 20 20 20 05 20 49 20 69  ┆             I i┆