DataMuseum.dk

top - download

    Length: 6046 (0x179e)
    Types: TextFile
    Names: »B«

└─⟦a7d1ea751⟧ Bits:30000550 8mm tape, Rational 1000, !users!projects 94_04_11
    └─ ⟦129cab021⟧ »DATA« 
        └─⟦this⟧ 

TextFile

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;