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

⟦a6290eda7⟧ Ada Source

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

Derivation

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

with Expertsystem;
use Expertsystem;

package body Ball is

    type Ball_Structure is
        record
            Size  : Natural;
            Color : Colors;
            Place : Places;
        end record;


    package Behavior is new Classbehavior (Ball_Structure, "BALLS     ");


    function Size (O : Object) return Natural is
    begin
        return Behavior.Get (O).Size;
    end Size;


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


    function Place (O : Object) return Places is
    begin
        return Behavior.Get (O).Place;
    end Place;


    function Instances (Kind : Existences := All_Balls)
                       return Collection.Object is
        function White_Ball_Predicate (O : Object) return Boolean is
        begin
            return Behavior.Get (O).Color = White;
        end White_Ball_Predicate;
        function White_Balls isnew Collection.Restrict (White_Ball_Predicate);

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

        function Ball_On_Heap_Predicate (O : Object) return Boolean is
        begin
            return Behavior.Get (O).Place = Is_On_Heap;
        end Ball_On_Heap_Predicate;
        function Balls_On_Heap is
           new Collection.Restrict (Ball_On_Heap_Predicate);

    begin
        case Kind is
            when All_Balls =>
                return Behavior.Instances;  
            when White_Balls =>
                return White_Balls (Behavior.Instances);
            when Red_Balls =>  
                return Red_Balls (Behavior.Instances);
            when Balls_On_Heap =>
                return Balls_On_Heap (Behavior.Instances);
            when others =>
                return Behavior.Instances;
        end case;
    end Instances;


    function Exist (With_Place : Places; In_Kind_Of_Collection : Existences)
                   return Boolean is
        function Is_Place (O : Object) return Boolean is
        begin
            return Behavior.Get (O).Place = With_Place;
        end Is_Place;  
        function Exist_Place is new Collection.Exist (Is_Place);
    begin
        return Exist_Place (Instances (Kind => In_Kind_Of_Collection));
    end Exist;

    function Exist (With_Color : String; In_Kind_Of_Collection : Existences)
                   return Boolean is
        function Is_Color (O : Object) return Boolean is
        begin
            return Ball.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 (Greater_Than : Natural; In_Kind_Of_Collection : Existences)
                   return Boolean is
        function Ball_Greater_Than (O : Object) return Boolean is
        begin
            return Behavior.Get (O).Size > Greater_Than;
        end Ball_Greater_Than;  
        function Exist_Greater_Ball is new Collection.Exist (Ball_Greater_Than);
    begin
        return Exist_Greater_Ball (Instances (Kind => In_Kind_Of_Collection));
    end Exist;


    function Exist (Between               : Natural;
                    And_Size              : Natural;
                    In_Kind_Of_Collection : Existences) return Boolean is
    begin
        [statement]
    end Exist;


    function Add (With_Size  : Natural := Default_Size;
                  With_Color : Colors  := Default_Color;
                  With_Place : Places  := Default_Place) return Object is
        A_Ball : Ball_Structure;
    begin
        A_Ball.Size  := With_Size;
       A_Ball.Color := With_Color;
        A_Ball.Place := With_Place;
        return Behavior.Allocate (Initvalue => A_Ball);
    end Add;


    procedure Change (O          : Object;
                      With_Size  : Natural;
                      With_Color : Colors;
                      With_Place : Places) is
        A_Ball : Ball_Structure;
    begin
        A_Ball       := Behavior.Get (Aref => O);
        A_Ball.Size  := With_Size;
        A_Ball.Color := With_Color;
        A_Ball.Place := With_Place;
        Behavior.Set (Aref => O, Withvalue => A_Ball);
    end Change;

    procedure Change (O : Object; With_Place : Places) is
        A_Ball : Ball_Structure;
    begin
        A_Ball       := Behavior.Get (Aref => O);
        A_Ball.Place := With_Place;
        Behavior.Set (Aref => O, Withvalue => A_Ball);
    end Change;


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


    procedure Clean is
    begin
        Behavior.Clear;
    end Clean;


end Ball;

    nblk1=8
    nid=0
    hdr6=10
        [0x00] rec0=2a rec1=00 rec2=01 rec3=03e
        [0x01] rec0=00 rec1=00 rec2=08 rec3=002
        [0x02] rec0=1a rec1=00 rec2=02 rec3=004
        [0x03] rec0=1b rec1=00 rec2=03 rec3=00e
        [0x04] rec0=1a rec1=00 rec2=04 rec3=006
        [0x05] rec0=00 rec1=00 rec2=07 rec3=002
        [0x06] rec0=21 rec1=00 rec2=05 rec3=000
        [0x07] rec0=08 rec1=00 rec2=06 rec3=000
    tail 0x2170afd92821d7cab0916 0x42a00088462063c03