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

⟦b45cd5f15⟧ Ada Source

    Length: 12288 (0x3000)
    Types: Ada Source
    Notes: 03_class, FILE, R1k_Segment, e3_tag, package body Class_Printer, seg_037f18

Derivation

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

with Class_Integer;
with Class_Boolean;
with Class_String;
with Class_Block;
with Class_Pen;
with Class_Turtle;
with Class_Window;
with Message;
with Requester;
with Bounded_String;
with Easy_Y;
with Object;
with Text_Io;

package body Class_Printer is

    type Flag is (Off, On);
    Tab_Flag : Flag := On;

    procedure Create is
    begin
        Position := 1;
        Tab_Flag := On;
    end Create;


    procedure Open (X, Y : Object.Index; Screen : String) is
        use Object;
    begin
        Easy_Y.Put_Title (Window => Unparse_Window,
                          Title => Bounded_String.Value ("Unparse", 80));
        Easy_Y.Put_Left (Window => Unparse_Window, Left => X);
        Easy_Y.Put_Right (Window => Unparse_Window, Right => Y);
        Easy_Y.Put_Width (Window => Unparse_Window, Width => The_Width);
        Easy_Y.Put_Height (Window => Unparse_Window, Height => The_Height);
        Easy_Y.Open (Display => Screen, Window => Unparse_Window);

        Easy_Y.Put_Font (To => Easy_Y.Small_Font);
        Easy_Y.Put_Size (Window => Unparse_Window, Size => 1);

        Easy_Y.Update;

        Flag_Window_Unparse := True;
        Line_Max := The_Height / 16;
    end Open;


    procedure Close is
        Button : Message.Unary;
        Result : Object.Index;
    begin
        if Flag_Window_Unparse = True then
            if Flag_Window_Requester = True then  
                Requester.Close;
            end if;

            Message.Free (Button);
            Message.Put (This_Name => Bounded_String.Value ("Fin", 80),
                         Into => Button);
            Requester.Open (250, 750, Bounded_String.Image
                                         (Class_Window.Get_Terminal_Name),
                            Button, Bounded_String.Value
                                       ("Cliquez pour finir", 80));
            Result := Requester.Choice (Button);
            Message.Free (Button);

            Easy_Y.Close (Window => Unparse_Window);
            Requester.Close;  
        end if;
    end Close;


    procedure Forward (Number : in Object.Index) is
        use Object;
    begin
        if Number > 0 then
            Position := Position + Number;
        end if;
    end Forward;


    procedure Backward (Number : in Object.Index) is
        use Object;
    begin
        if Number > 0 then
            Position := Position - Number;
        end if;
        if Position < 0 then
            Position := 0;
        end if;
    end Backward;


    procedure New_Line (Number : Object.Index := 1) is
        use Object;
        Blanck : String (1 .. Positive (The_Width / 8)) :=
           (1 .. Positive (The_Width / 8) => ' ');
        Button : Message.Unary;
        Result : Object.Index;
    begin
        if Flag_Window_Unparse = False then
            for I in 1 .. Number loop
                Text_Io.New_Line;
            end loop;
        else
            Column := 0;
            Line_Number := Line_Number + Number;
            if Line_Number >= Line_Max then
                Line_Number := 1;

                Message.Put (This_Name => Bounded_String.Value ("Suite", 80),
                             Into => Button);
                if Flag_Window_Requester = False then
                    Requester.Open
                       (250, 750,
                        Bounded_String.Image (Class_Window.Get_Terminal_Name),
                        Button,
                        Bounded_String.Value ("Cliquez pour la suite", 80));
                    Flag_Window_Requester := True;
                end if;

                Result := Requester.Choice (Button);
                Message.Free (Button);

                for I in 0 .. Line_Max * 2 loop
                    Easy_Y.Set_Display (Window => Unparse_Window);
                    Easy_Y.Print (0, I * 10, Bounded_String.Value (Blanck, 80));
                end loop;
            end if;
        end if;
        Tab_Flag := On;
    end New_Line;


    procedure Put (The_String : String) is
        use Object;
    begin
        if Tab_Flag = On then
            Put_Tab (The_String);
        else  
            if Flag_Window_Unparse = False then
                Text_Io.Put (The_String);
            else
                Easy_Y.Set_Display (Window => Unparse_Window);
                Easy_Y.Print (Column * 8, Line_Number * 16,
                              Bounded_String.Value (The_String, 80));
                Column := Column + Object.Index (The_String'Length);
            end if;
        end if;
        Tab_Flag := Off;
    end Put;


    procedure Put_Tab (The_String : String) is
        use Object;  
        Tabulation : String (1 .. Positive (Position)) :=
           (1 .. Positive (Position) => ' ');
    begin  
        if Flag_Window_Unparse = False then
            Text_Io.Put (Tabulation & The_String);
        else
            Easy_Y.Set_Display (Window => Unparse_Window);
            Easy_Y.Print ((Column + Position) * 8, Line_Number * 16,
                          Bounded_String.Value (The_String, 80));
            Column := Column + Position + Object.Index (The_String'Length);
        end if;
        Tab_Flag := Off;
    end Put_Tab;


    procedure Put (This_Object : Object.Reference) is
    begin
        case Object.Get (Class_From => This_Object) is
            when Object.Integer_Class =>
                Class_Integer.Put (This_Object);
            when Object.Boolean_Class =>
                Class_Boolean.Put (This_Object);
            when Object.String_Class =>
                Class_String.Put (This_Object);
            when Object.Turtle_Class =>
                Class_Turtle.Put (This_Object);
            when Object.Pen_Class =>
                Class_Pen.Put (This_Object);
            when Object.Block_Class =>
                Class_Block.Put (This_Object);
            when Object.Window_Class =>
                Class_Window.Put (This_Object);
            when Object.Void_Class =>
                null;
        end case;
        null;
    end Put;

end Class_Printer;

    nblk1=b
    nid=9
    hdr6=12
        [0x00] rec0=25 rec1=00 rec2=01 rec3=052
        [0x01] rec0=1d rec1=00 rec2=08 rec3=004
        [0x02] rec0=08 rec1=00 rec2=04 rec3=03a
        [0x03] rec0=23 rec1=00 rec2=06 rec3=056
        [0x04] rec0=1b rec1=00 rec2=05 rec3=030
        [0x05] rec0=1c rec1=00 rec2=07 rec3=048
        [0x06] rec0=00 rec1=00 rec2=03 rec3=040
        [0x07] rec0=19 rec1=00 rec2=0a rec3=048
        [0x08] rec0=08 rec1=00 rec2=02 rec3=000
        [0x09] rec0=0a rec1=00 rec2=03 rec3=000
        [0x0a] rec0=c4 rec1=8d rec2=a0 rec3=000
    tail 0x2173587a284e657f4acb5 0x42a00088462060003
Free Block Chain:
  0x9: 0000  00 0b 00 2a 80 0f 6e 70 61 72 73 65 5f 57 69 6e  ┆   *  nparse_Win┆
  0xb: 0000  00 00 00 29 80 04 29 29 29 3b 04 00 10 20 20 20  ┆   )  )));      ┆