terminal_interface-curses-text_io.adb

# File : terminal_interface-curses-text_io.adb

    ------------------------------------------------------------------------------
    --                                                                          --
    --                           GNAT ncurses Binding                           --
    --                                                                          --
    --                     Terminal_Interface.Curses.Text_IO                    --
    --                                                                          --
    --                                 B O D Y                                  --
    --                                                                          --
    ------------------------------------------------------------------------------
    -- Copyright (c) 1998-2011,2014 Free Software Foundation, Inc.              --
    --                                                                          --
    -- Permission is hereby granted, free of charge, to any person obtaining a  --
    -- copy of this software and associated documentation files (the            --
    -- "Software"), to deal in the Software without restriction, including      --
    -- without limitation the rights to use, copy, modify, merge, publish,      --
    -- distribute, distribute with modifications, sublicense, and/or sell       --
    -- copies of the Software, and to permit persons to whom the Software is    --
    -- furnished to do so, subject to the following conditions:                 --
    --                                                                          --
    -- The above copyright notice and this permission notice shall be included  --
    -- in all copies or substantial portions of the Software.                   --
    --                                                                          --
    -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
    -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
    -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
    -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
    -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
    -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
    -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
    --                                                                          --
    -- Except as contained in this notice, the name(s) of the above copyright   --
    -- holders shall not be used in advertising or otherwise to promote the     --
    -- sale, use or other dealings in this Software without prior written       --
    -- authorization.                                                           --
    ------------------------------------------------------------------------------
    --  Author:  Juergen Pfeifer, 1996
    --  Version Control:
    --  @Revision: 1.22 @
    --  @Date: 2014/05/24 21:32:18 @
    --  Binding Version 01.00
    ------------------------------------------------------------------------------
    package body Terminal_Interface.Curses.Text_IO is

       Default_Window : Window := Null_Window;

       procedure Set_Window (Win : Window)
       is
       begin
          Default_Window := Win;
       end Set_Window;

       function Get_Window return Window
       is
       begin
          if Default_Window = Null_Window then
             return Standard_Window;
          else
             return Default_Window;
          end if;
       end Get_Window;
       pragma Inline (Get_Window);

       procedure Flush (Win : Window)
       is
       begin
          Refresh (Win);
       end Flush;

       procedure Flush
       is
       begin
          Flush (Get_Window);
       end Flush;

       --------------------------------------------
       -- Specification of line and page lengths --
       --------------------------------------------

       --  There are no set routines in this package. I assume, that you allocate
       --  the window with an appropriate size.
       --  A scroll-window is interpreted as an page with unbounded page length,
       --  i.e. it returns the conventional 0 as page length.

       function Line_Length (Win : Window) return Count
       is
          N_Lines : Line_Count;
          N_Cols  : Column_Count;
       begin
          Get_Size (Win, N_Lines, N_Cols);
          --  if Natural (N_Cols) > Natural (Count'Last) then
          --     raise Layout_Error;
          --  end if;
          return Count (N_Cols);
       end Line_Length;

       function Line_Length return Count
       is
       begin
          return Line_Length (Get_Window);
       end Line_Length;

       function Page_Length (Win : Window) return Count
       is
          N_Lines : Line_Count;
          N_Cols  : Column_Count;
       begin
          if Scrolling_Allowed (Win) then
             return 0;
          else
             Get_Size (Win, N_Lines, N_Cols);
             --  if Natural (N_Lines) > Natural (Count'Last) then
             --     raise Layout_Error;
             --  end if;
             return Count (N_Lines);
          end if;
       end Page_Length;

       function Page_Length return Count
       is
       begin
          return Page_Length (Get_Window);
       end Page_Length;

       ------------------------------------
       -- Column, Line, and Page Control --
       ------------------------------------
       procedure New_Line (Win : Window; Spacing : Positive_Count := 1)
       is
          P_Size : constant Count := Page_Length (Win);
       begin
          if not Spacing'Valid then
             raise Constraint_Error;
          end if;

          for I in 1 .. Spacing loop
             if P_Size > 0 and then Line (Win) >= P_Size then
                New_Page (Win);
             else
                Add (Win, ASCII.LF);
             end if;
          end loop;
       end New_Line;

       procedure New_Line (Spacing : Positive_Count := 1)
       is
       begin
          New_Line (Get_Window, Spacing);
       end New_Line;

       procedure New_Page (Win : Window)
       is
       begin
          Clear (Win);
       end New_Page;

       procedure New_Page
       is
       begin
          New_Page (Get_Window);
       end New_Page;

       procedure Set_Col (Win : Window;  To : Positive_Count)
       is
          Y  : Line_Position;
          X1 : Column_Position;
          X2 : Column_Position;
          N  : Natural;
       begin
          if not To'Valid then
             raise Constraint_Error;
          end if;

          Get_Cursor_Position (Win, Y, X1);
          N  := Natural (To); N := N - 1;
          X2 := Column_Position (N);
          if X1 > X2 then
             New_Line (Win, 1);
             X1 := 0;
          end if;
          if X1 < X2 then
             declare
                Filler : constant String (Integer (X1) .. (Integer (X2) - 1))
                  := (others => ' ');
             begin
                Put (Win, Filler);
             end;
          end if;
       end Set_Col;

       procedure Set_Col (To : Positive_Count)
       is
       begin
          Set_Col (Get_Window, To);
       end Set_Col;

       procedure Set_Line (Win : Window; To : Positive_Count)
       is
          Y1 : Line_Position;
          Y2 : Line_Position;
          X  : Column_Position;
          N  : Natural;
       begin
          if not To'Valid then
             raise Constraint_Error;
          end if;

          Get_Cursor_Position (Win, Y1, X);
          pragma Warnings (Off, X);         --  unreferenced
          N  := Natural (To); N := N - 1;
          Y2 := Line_Position (N);
          if Y2 < Y1 then
             New_Page (Win);
             Y1 := 0;
          end if;
          if Y1 < Y2 then
             New_Line (Win, Positive_Count (Y2 - Y1));
          end if;
       end Set_Line;

       procedure Set_Line (To : Positive_Count)
       is
       begin
          Set_Line (Get_Window, To);
       end Set_Line;

       function Col (Win : Window) return Positive_Count
       is
          Y : Line_Position;
          X : Column_Position;
          N : Natural;
       begin
          Get_Cursor_Position (Win, Y, X);
          N := Natural (X); N := N + 1;
          --  if N > Natural (Count'Last) then
          --     raise Layout_Error;
          --  end if;
          return Positive_Count (N);
       end Col;

       function Col return Positive_Count
       is
       begin
          return Col (Get_Window);
       end Col;

       function Line (Win : Window) return Positive_Count
       is
          Y : Line_Position;
          X : Column_Position;
          N : Natural;
       begin
          Get_Cursor_Position (Win, Y, X);
          N := Natural (Y); N := N + 1;
          --  if N > Natural (Count'Last) then
          --     raise Layout_Error;
          --  end if;
          return Positive_Count (N);
       end Line;

       function Line return Positive_Count
       is
       begin
          return Line (Get_Window);
       end Line;

       -----------------------
       -- Characters Output --
       -----------------------

       procedure Put (Win  : Window; Item : Character)
       is
          P_Size : constant Count := Page_Length (Win);
          Y : Line_Position;
          X : Column_Position;
          L : Line_Count;
          C : Column_Count;
       begin
          if P_Size > 0 then
             Get_Cursor_Position (Win, Y, X);
             Get_Size (Win, L, C);
             if (Y + 1) = L and then (X + 1) = C then
                New_Page (Win);
             end if;
          end if;
          Add (Win, Item);
       end Put;

       procedure Put (Item : Character)
       is
       begin
          Put (Get_Window, Item);
       end Put;

       --------------------
       -- Strings-Output --
       --------------------

       procedure Put (Win  : Window; Item : String)
       is
          P_Size : constant Count := Page_Length (Win);
          Y : Line_Position;
          X : Column_Position;
          L : Line_Count;
          C : Column_Count;
       begin
          if P_Size > 0 then
             Get_Cursor_Position (Win, Y, X);
             Get_Size (Win, L, C);
             if (Y + 1) = L and then (X + 1 + Item'Length) >= C then
                New_Page (Win);
             end if;
          end if;
          Add (Win, Item);
       end Put;

       procedure Put (Item : String)
       is
       begin
          Put (Get_Window, Item);
       end Put;

       procedure Put_Line
         (Win  : Window;
          Item : String)
       is
       begin
          Put (Win, Item);
          New_Line (Win, 1);
       end Put_Line;

       procedure Put_Line
         (Item : String)
       is
       begin
          Put_Line (Get_Window, Item);
       end Put_Line;

    end Terminal_Interface.Curses.Text_IO;