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

⟦80c7f4736⟧ Ada Source

    Length: 11264 (0x2c00)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Pen_Class, seg_036640

Derivation

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

with Text_Io;
with Object;
with Bounded_String;
with String_Utilities;
with Error_Broadcaster;
package body Pen_Class is
    type Unary_Message is (Tonx, Tony, Large, Moyen, Fin,
                           Entexte, Detruit, Clone);

-- iterateur de la classe pen_class

    procedure Init (Iter : out Iterator; Coll : in Collection) is
    begin
        Iter := Iterator'First;
    end Init;

    procedure Next (Iter : in out Iterator) is
    begin
        Iter := Iter + 1;
    end Next;

    function Done (Iter : in Iterator) return Boolean is
    begin
        return (Iterator'Last = Iter);
    end Done;

    function Value (Iter : in Iterator) return Index is
    begin
        return Iter;
    end Value;

    function Clone (To_Object : Object.Reference) return Object.Reference is
    begin
        Next (Pen_Collection.Iter);
        Pen_Collection.Table (Pen_Collection.Iter) :=
           Pen_Collection.Table (To_Object.Identity);
        return (Object.Tiny_Pen, Pen_Collection.Iter);
    end Clone;
    function Entexte (To_Object : Object.Reference) return String is


    begin
        return ("Stylo numero:" &

                String_Utilities.Number_To_String (To_Object.Identity, 10, 2) &
                " Ma Position:" &
                String_Utilities.Number_To_String
                   (Pen_Collection.Table (To_Object.Identity).X, 10, 4) & "," &
                String_Utilities.Number_To_String
                   (Pen_Collection.Table (To_Object.Identity).Y, 10, 4) &


                " Ma Taille:" &
                Graphic_Object.Font'Image
                   ((Pen_Collection.Table (To_Object.Identity).Font)));


    end Entexte;


    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return String is
        Message : Unary_Message;
    begin
        Message := Unary_Message'Value (Bounded_String.Image (The_Message));
        case Message is

            when Tonx | Tony | Large | Moyen | Fin | Detruit | Clone =>
                return ("");
            when Entexte =>
                return Entexte (To_Object);
        end case;
    end Send;
    function Send (To_Object : Object.Reference; The_Message : Object.Message)
                  return Object.Reference is

        Message : Unary_Message;
        Obj : Object.Reference;
        My_Pen : Pen;
    begin
        Message := Unary_Message'Value (Bounded_String.Image (The_Message));
        Obj := To_Object;
        case Message is

            when Tonx =>

                Obj.Identity := Pen_Collection.Table (To_Object.Identity).X;
                Obj.Class := Object.Tiny_Integer;

            when Tony =>
                Obj.Identity := Pen_Collection.Table (To_Object.Identity).Y;  
                Obj.Class := Object.Tiny_Integer;

            when Large =>
                Obj.Identity := To_Object.Identity;
                Obj.Class := Object.Tiny_Pen;
                Pen_Collection.Table (To_Object.Identity).Font :=
                   Graphic_Object.Large_Font;
            when Moyen =>
                Obj.Identity := To_Object.Identity;
                Obj.Class := Object.Tiny_Pen;
                Pen_Collection.Table (To_Object.Identity).Font :=
                   Graphic_Object.Medium_Font;
            when Fin =>
                Obj.Identity := To_Object.Identity;
                Obj.Class := Object.Tiny_Pen;
                Pen_Collection.Table (To_Object.Identity).Font :=
                   Graphic_Object.Small_Font;

            when Entexte =>
                Obj.Identity := To_Object.Identity;
                Obj.Class := Object.Tiny_Pen;

            when Detruit =>
                My_Pen.X := 0;
                My_Pen.Y := 0;
                Obj.Identity := To_Object.Identity;
                Obj.Class := Object.Tiny_Pen;
            when Clone =>
                Obj := Clone (To_Object);
        end case;
        return Obj;
    exception
        when Constraint_Error =>
            raise Error_Broadcaster.Unknown_Unary_Message;

    end Send;

    function Send (To_Object : Object.Reference;
                   The_Argument : Object.Parameters.List)
                  return Object.Reference is

        Message : Object.Message;
        Obj : Object.Reference;
        My_Pen : Pen;
        Local_Argument : Object.Parameters.List := The_Argument;
    begin

        if String_Utilities.Equal
              (Bounded_String.Image
                  (Object.Parameters.Selector (Local_Argument)),
               "vaEnX:", True) then
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;
            Graphic_Object.Move (Pen_Collection.Table (To_Object.Identity).X,
                                 Pen_Collection.Table (To_Object.Identity).Y);

        elsif String_Utilities.Equal
                 (Bounded_String.Image
                     (Object.Parameters.Selector (Local_Argument)),
                  "vaEnY:", True) then
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;

        elsif String_Utilities.Equal
                 (Bounded_String.Image
                     (Object.Parameters.Selector (Local_Argument)),
                  "tonX:", True) then
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;

        elsif String_Utilities.Equal
                 (Bounded_String.Image
                     (Object.Parameters.Selector (Local_Argument)),
                  "tonY:", True) then
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;

        elsif String_Utilities.Equal
                 (Bounded_String.Image
                     (Object.Parameters.Selector (Local_Argument)),
                  "tonX:Y:", True) then
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;


        elsif String_Utilities.Equal
                 (Bounded_String.Image
                     (Object.Parameters.Selector (Local_Argument)),
                  "vaEnX:Y:", True) then
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).X := Obj.Identity;
            Object.Parameters.Get (Local_Argument, Obj);
            Pen_Collection.Table (To_Object.Identity).Y := Obj.Identity;

        elsif String_Utilities.Equal
                 (Bounded_String.Image
                     (Object.Parameters.Selector (Local_Argument)),
                  "ecrit:", True) then
            Object.Parameters.Get (Local_Argument, Obj);
            Bounded_String.Copy (Message, "entexte");


            Graphic_Object.Draw_With_Font
               (Pen_Collection.Table (To_Object.Identity).X,
                Pen_Collection.Table (To_Object.Identity).Y,
                Object.Send (Obj, Message),
                Pen_Collection.Table (To_Object.Identity).Font);
        else
            raise Error_Broadcaster.Unknown_Keyword_Message;
        end if;
        return Obj;
    end Send;
end Pen_Class;

    nblk1=a
    nid=3
    hdr6=12
        [0x00] rec0=25 rec1=00 rec2=01 rec3=068
        [0x01] rec0=01 rec1=00 rec2=0a rec3=02c
        [0x02] rec0=1d rec1=00 rec2=08 rec3=02e
        [0x03] rec0=1d rec1=00 rec2=09 rec3=044
        [0x04] rec0=18 rec1=00 rec2=02 rec3=00c
        [0x05] rec0=1a rec1=00 rec2=07 rec3=05c
        [0x06] rec0=15 rec1=00 rec2=06 rec3=06c
        [0x07] rec0=16 rec1=00 rec2=04 rec3=008
        [0x08] rec0=13 rec1=00 rec2=05 rec3=000
        [0x09] rec0=09 rec1=09 rec2=a0 rec3=4ef
    tail 0x2152fdabc84de8f6359e2 0x42a00088462060003
Free Block Chain:
  0x3: 0000  00 00 01 da 80 29 6c 65 63 74 69 6f 6e 2e 54 61  ┆     )lection.Ta┆