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

⟦a6bd6c9ab⟧ Ada Source

    Length: 9216 (0x2400)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Sticker, seg_011ecc

Derivation

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

with Class_Behavior;
with Collection;
with Instance;

package body Sticker is

    type Sticker_Structure is
        record
            Color : Colors;
            State : States;
        end record;


    package Behavior is new Class_Behavior (Element        => Sticker_Structure,
                                            With_Name      => Class_Name,
                                            With_Dates     => Is_Dated,
                                            With_Date_Mode => Date_Mode);


------------------------------------------------------------------------------
    function Color (O : Object) return Colors is
    begin
        return Behavior.Get (O).Color;
    end Color;

    function State (O : Object) return States is
    begin
        return Behavior.Get (O).State;
    end State;

------------------------------------------------------------------------------
    function Instances (Kind : Existences := All_Stickers)
                       return Collection.Object is
        function White_Sticker_Predicate (O : Object) return Boolean is
        begin
            return Behavior.Get (O).Color = White;
        end White_Sticker_Predicate;
        function White_Stickers is
           new Collection.Restrict (White_Sticker_Predicate);

        function Red_Sticker_Predicate (O : Object) return Boolean is
        begin
            return Behavior.Get (O).Color = Red;
        end Red_Sticker_Predicate;
        function Red_Stickers is
           new Collection.Restrict (Red_Sticker_Predicate);

        function Unused_Predicate (O : Object) return Boolean is
        begin
            return Behavior.Get (O).State = Is_Unused;
        end Unused_Predicate;
        function Unused is new Collection.Restrict (Unused_Predicate);
    begin
        case Kind is
            when All_Stickers =>
                return Behavior.Instances;
            when Unused_Stickers =>
                return Unused (Behavior.Instances);
            when White_Stickers =>
                return White_Stickers (Behavior.Instances);
            when Red_Stickers =>
                return Red_Stickers (Behavior.Instances);
            when others =>
                return Behavior.Instances;
        end case;
    end Instances;


------------------------------------------------------------------------------
    function Instances return Collection.Object is
    begin
        return Behavior.Instances;
    end Instances;

------------------------------------------------------------------------------
    function Exist (With_Color : String; In_Kind_Of_Collection : Existences)
                   return Boolean is
        function Is_Color (O : Object) return Boolean is
        begin
            return Colors'Image (Behavior.Get (O).Color) = With_Color;
        end Is_Color;  
        function Exist_Color is new Collection.Exist (Is_Color);
    begin
        return Exist_Color (Instances (Kind => In_Kind_Of_Collection));
    end Exist;

    function Exist (With_State : States; In_Kind_Of_Collection : Existences)
                   return Boolean is
        function Is_State (O : Object) return Boolean is
        begin
            return Behavior.Get (O).State = With_State;
        end Is_State;  
        function Exist_State is new Collection.Exist (Is_State);
    begin
        return Exist_State (Instances (Kind => In_Kind_Of_Collection));
    end Exist;

------------------------------------------------------------------------------
    function Add (With_Color : Colors := Default_Color;
                  With_State : States := Default_State) return Object is
        A_Sticker : Sticker_Structure;
    begin
        A_Sticker.Color := With_Color;
        A_Sticker.State := With_State;
        return Behavior.Allocate (The_Element => A_Sticker);
    end Add;

------------------------------------------------------------------------------
    procedure Change (O : Object; With_Color : Colors; With_State : States) is
        A_Sticker : Sticker_Structure;
    begin
        A_Sticker       := Behavior.Get (The_Reference => O);
        A_Sticker.Color := With_Color;
        A_Sticker.State := With_State;
        Behavior.Set (The_Reference => O, With_Value => A_Sticker);
    end Change;

    procedure Change (O : Object; With_State : States) is
        A_Sticker : Sticker_Structure;
    begin
        A_Sticker       := Behavior.Get (The_Reference => O);
        A_Sticker.State := With_State;
        Behavior.Set (The_Reference => O, With_Value => A_Sticker);
    end Change;


------------------------------------------------------------------------------
    procedure Delete (O : Object) is
    begin
        Behavior.Dispose (The_Reference => O);
    end Delete;

------------------------------------------------------------------------------
    procedure Mask (O : Object) is
    begin
        Behavior.Mask (The_Reference => O);
    end Mask;

------------------------------------------------------------------------------
    procedure Unmask (O : Object) is
    begin
        Behavior.Unmask (The_Reference => O);
    end Unmask;

------------------------------------------------------------------------------
    procedure Clean is
    begin
        Behavior.Clear;
    end Clean;

------------------------------------------------------------------------------
    procedure Mask_All is
    begin
        Behavior.Mask_All;
    end Mask_All;

------------------------------------------------------------------------------
    procedure Unmask_All is
    begin
        Behavior.Unmask_All;
    end Unmask_All;


end Sticker;

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=21 rec1=00 rec2=01 rec3=074
        [0x01] rec0=05 rec1=00 rec2=06 rec3=048
        [0x02] rec0=19 rec1=00 rec2=02 rec3=066
        [0x03] rec0=1b rec1=00 rec2=03 rec3=020
        [0x04] rec0=04 rec1=00 rec2=07 rec3=038
        [0x05] rec0=17 rec1=00 rec2=04 rec3=016
        [0x06] rec0=1e rec1=00 rec2=05 rec3=020
        [0x07] rec0=13 rec1=00 rec2=08 rec3=000
    tail 0x2170df2ae82466ea9dbe1 0x42a00088462063c03