+++ /dev/null
-------------------------------------------------------------------------------
--- --
--- GNAT ncurses Binding --
--- --
--- Terminal_Interface.Curses.Text_IO --
--- --
--- B O D Y --
--- --
-------------------------------------------------------------------------------
--- Copyright (c) 1998 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 <Juergen.Pfeifer@T-Online.de> 1996
--- Version Control:
--- $Revision: 1.8 $
--- Binding Version 00.93
-------------------------------------------------------------------------------
-with System;
-
-package body Terminal_Interface.Curses.Text_IO is
-
- Default_Window : Window := Null_Window;
-
- procedure Set_Window (Win : in 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 : in 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 : in 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 : in 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 : in Window; Spacing : in Positive_Count := 1)
- is
- P_Size : constant Count := Page_Length (Win);
- begin
- if Spacing not in Positive_Count 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 : in Positive_Count := 1)
- is
- begin
- New_Line (Get_Window, Spacing);
- end New_Line;
-
- procedure New_Page (Win : in Window)
- is
- begin
- Clear (Win);
- end New_Page;
-
- procedure New_Page
- is
- begin
- New_Page (Get_Window);
- end New_Page;
-
- procedure Set_Col (Win : in Window; To : in Positive_Count)
- is
- Y : Line_Position;
- X1 : Column_Position;
- X2 : Column_Position;
- N : Natural;
- begin
- if To not in Positive_Count 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 : in Positive_Count)
- is
- begin
- Set_Col (Get_Window, To);
- end Set_Col;
-
- procedure Set_Line (Win : in Window; To : in Positive_Count)
- is
- Y1 : Line_Position;
- Y2 : Line_Position;
- X : Column_Position;
- N : Natural;
- begin
- if To not in Positive_Count then
- raise Constraint_Error;
- end if;
-
- Get_Cursor_Position (Win, Y1, X);
- 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 : in Positive_Count)
- is
- begin
- Set_Line (Get_Window, To);
- end Set_Line;
-
- function Col (Win : in 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 : in 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 : in Window; Item : in 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 : in Character)
- is
- begin
- Put (Get_Window, Item);
- end Put;
-
- --------------------
- -- Strings-Output --
- --------------------
-
- procedure Put (Win : in Window; Item : in 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 : in String)
- is
- begin
- Put (Get_Window, Item);
- end Put;
-
- procedure Put_Line
- (Win : in Window;
- Item : in String)
- is
- begin
- Put (Win, Item);
- New_Line (Win, 1);
- end Put_Line;
-
- procedure Put_Line
- (Item : in String)
- is
- begin
- Put_Line (Get_Window, Item);
- end Put_Line;
-
-end Terminal_Interface.Curses.Text_IO;
projects / ncurses.git / blobdiff