X-Git-Url: https://ncurses.scripts.mit.edu/?a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses-text_io__adb.htm;h=fb818d03411604327dffac431f35d53642ffda55;hb=0485620c03e69b1b58a6b12e5e45c98415fc7575;hp=cca6461d2ce9d38a66a30e10fb8e8bb1ae37f993;hpb=55ccd2b959766810cf7db8d1c4462f338ce0afc8;p=ncurses.git diff --git a/doc/html/ada/terminal_interface-curses-text_io__adb.htm b/doc/html/ada/terminal_interface-curses-text_io__adb.htm index cca6461d..fb818d03 100644 --- a/doc/html/ada/terminal_interface-curses-text_io__adb.htm +++ b/doc/html/ada/terminal_interface-curses-text_io__adb.htm @@ -1,190 +1,202 @@ - -
------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding -- --- -- --- Terminal_Interface.Curses.Text_IO -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 1998,2004 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.17 @ --- @Date: 2004/08/21 21:37:00 @ --- Binding Version 01.00 ------------------------------------------------------------------------------- -package body Terminal_Interface.Curses.Text_IO is - - Default_Window : Window := Null_Window; - - procedure Set_Window (Win : in Window) +------------------------------------------------------------------------------ +-- -- +-- 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 + function Get_Window return Window is begin - if Default_Window = Null_Window then - return Standard_Window; + 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) + procedure Flush (Win : Window) is begin - Refresh (Win); + Refresh (Win); end Flush; - procedure Flush + procedure Flush is begin Flush (Get_Window); end Flush; - -------------------------------------------- - -- Specification of line and page lengths -- - -------------------------------------------- + -------------------------------------------- + -- 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. + -- 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 + function Line_Length (Win : Window) return Count is - N_Lines : Line_Count; - N_Cols : Column_Count; + 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; + 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 + function Line_Length return Count is begin return Line_Length (Get_Window); end Line_Length; - function Page_Length (Win : in Window) return Count + function Page_Length (Win : Window) return Count is - N_Lines : Line_Count; - N_Cols : Column_Count; + N_Lines : Line_Count; + N_Cols : Column_Count; begin - if Scrolling_Allowed (Win) then + 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; + 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 + 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) + ------------------------------------ + -- Column, Line, and Page Control -- + ------------------------------------ + procedure New_Line (Win : Window; Spacing : Positive_Count := 1) is - P_Size : constant Count := Page_Length (Win); + P_Size : constant Count := Page_Length (Win); begin - if Spacing not in Positive_Count then + if not Spacing'Valid then raise Constraint_Error; end if; - for I in 1 .. Spacing loop + 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); + Add (Win, ASCII.LF); end if; end loop; end New_Line; - procedure New_Line (Spacing : in Positive_Count := 1) + procedure New_Line (Spacing : Positive_Count := 1) is begin New_Line (Get_Window, Spacing); end New_Line; - procedure New_Page (Win : in Window) + procedure New_Page (Win : Window) is begin - Clear (Win); + Clear (Win); end New_Page; - procedure New_Page + procedure New_Page is begin New_Page (Get_Window); end New_Page; - procedure Set_Col (Win : in Window; To : in Positive_Count) + procedure Set_Col (Win : Window; To : Positive_Count) is - Y : Line_Position; - X1 : Column_Position; - X2 : Column_Position; - N : Natural; + Y : Line_Position; + X1 : Column_Position; + X2 : Column_Position; + N : Natural; begin - if To not in Positive_Count then + 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); + 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)) + Filler : constant String (Integer (X1) .. (Integer (X2) - 1)) := (others => ' '); begin Put (Win, Filler); @@ -192,26 +204,27 @@ end if; end Set_Col; - procedure Set_Col (To : in Positive_Count) + procedure Set_Col (To : Positive_Count) is begin Set_Col (Get_Window, To); end Set_Col; - procedure Set_Line (Win : in Window; To : in Positive_Count) + procedure Set_Line (Win : Window; To : Positive_Count) is - Y1 : Line_Position; - Y2 : Line_Position; - X : Column_Position; - N : Natural; + Y1 : Line_Position; + Y2 : Line_Position; + X : Column_Position; + N : Natural; begin - if To not in Positive_Count then + if not To'Valid then raise Constraint_Error; end if; - Get_Cursor_Position (Win, Y1, X); - N := Natural (To); N := N - 1; - Y2 := Line_Position (N); + 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; @@ -221,123 +234,123 @@ end if; end Set_Line; - procedure Set_Line (To : in Positive_Count) + procedure Set_Line (To : Positive_Count) is begin Set_Line (Get_Window, To); end Set_Line; - function Col (Win : in Window) return Positive_Count + function Col (Win : Window) return Positive_Count is - Y : Line_Position; - X : Column_Position; - N : Natural; + 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); + 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 + function Col return Positive_Count is begin return Col (Get_Window); end Col; - function Line (Win : in Window) return Positive_Count + function Line (Win : Window) return Positive_Count is - Y : Line_Position; - X : Column_Position; - N : Natural; + 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); + 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 + function Line return Positive_Count is begin return Line (Get_Window); end Line; - ----------------------- - -- Characters Output -- - ----------------------- + ----------------------- + -- Characters Output -- + ----------------------- - procedure Put (Win : in Window; Item : in Character) + 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; + 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 + 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); + Add (Win, Item); end Put; - procedure Put (Item : in Character) + procedure Put (Item : Character) is begin Put (Get_Window, Item); end Put; - -------------------- - -- Strings-Output -- - -------------------- + -------------------- + -- Strings-Output -- + -------------------- - procedure Put (Win : in Window; Item : in String) + 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; + 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 + 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); + Add (Win, Item); end Put; - procedure Put (Item : in String) + procedure Put (Item : String) is begin Put (Get_Window, Item); end Put; - procedure Put_Line - (Win : in Window; - Item : in String) + procedure Put_Line + (Win : Window; + Item : String) is begin Put (Win, Item); New_Line (Win, 1); end Put_Line; - procedure Put_Line - (Item : in String) + procedure Put_Line + (Item : String) is begin Put_Line (Get_Window, Item); end Put_Line; -end Terminal_Interface.Curses.Text_IO; +end Terminal_Interface.Curses.Text_IO;