by Jürgen Pfeifer.
If you want to navigate through the html pages of the package specs, click here.
All the new types like Window, Panel, Menu, Form etc. are just opaque representations of the pointers to the corresponding low level (n)curses structures like WINDOW *, PANEL *, MENU * or FORM *. So you can safely pass them to C routines that expect a pointer to one of those structures.
The official documentation of (n)curses says, that the line parameter determines only whether or not exactly one line is stolen from the top or bottom of the screen. So essentially only the sign of the parameter is evaluated. ncurses has internally implemented it in a way, that uses the line parameter also to control the amount of lines to steal. This mechanism is used in the Rip_Off_Lines routine of the binding.
TBD
The (n)curses documentation says, that the String arrays to be passed to an TYPE_ENUM fieldtype must not be automatic variables. This is not true in this binding, because it is internally arranged to safely copy these values.
This should basically not be a problem.
Basically it should not be too hard to make all this run on a
regular SVr4 implementation of curses. The problems are probably
these:
Most likely you will follow a mixed approach. Some features are easy to simulate, others will be hard if not impossible.
I'm quite sure I forgot something.
AdaCurses-20211021/doc/MKada_config.in 0000644 0001751 0000144 00000010354 14062736752 015753 0 ustar tom users .\"*************************************************************************** .\" Copyright 2019-2020,2021 Thomas E. Dickey * .\" Copyright 2010-2014,2016 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. * .\"*************************************************************************** .\" .\" $Id: MKada_config.in,v 1.13 2021/06/17 21:26:02 tom Exp $ .ds C adacurses@USE_CFG_SUFFIX@\-config .TH ADACURSES "1" "" "" "User Commands" .SH NAME adacurses@USE_CFG_SUFFIX@\-config \- helper script for @ADA_LIBNAME@ libraries .SH SYNOPSIS .B \*C [\fIoptions\fR] .SH DESCRIPTION This is a shell script which simplifies configuring an application to use the @ADA_LIBNAME@ library binding to ncurses. .SH OPTIONS .TP \fB\-\-cflags\fR echos the gnat (Ada compiler) flags needed to compile with @ADA_LIBNAME@. .TP \fB\-\-libs\fR echos the gnat libraries needed to link with @ADA_LIBNAME@. .TP \fB\-\-version\fR echos the release+patchdate version of the ncurses libraries used to configure and build @ADA_LIBNAME@. .TP \fB\-\-help\fR prints a list of the \fB\*C\fP script's options. .PP If no options are given, \fB\*C\fP prints the combination of \fB\-\-cflags\fR and \fB\-\-libs\fR that \fBgnatmake\fP expects (see example). .SH EXAMPLE .PP For example, supposing that you want to compile the "Hello World!" program for @ADA_LIBNAME@. Make a file named "hello.adb": .RS .nf .ft CW with Terminal_Interface.Curses; use Terminal_Interface.Curses; procedure Hello is Visibility : Cursor_Visibility := Invisible; done : Boolean := False; c : Key_Code; begin Init_Screen; Set_Echo_Mode (False); Set_Cursor_Visibility (Visibility); Set_Timeout_Mode (Standard_Window, Non_Blocking, 0); Move_Cursor (Line => Lines / 2, Column => (Columns - 12) / 2); Add (Str => "Hello World!"); while not done loop c := Get_Keystroke (Standard_Window); case c is when Character'Pos ('q') => done := True; when others => null; end case; Nap_Milli_Seconds (50); end loop; End_Windows; end Hello; .fi .RE .PP Then, using .RS .ft CW gnatmake `adacurses-config --cflags` hello -largs `adacurses-config --libs` .ft .RE .PP or (simpler): .RS .ft CW gnatmake hello `adacurses-config` .ft .RE .PP you will compile and link the program. .SH "SEE ALSO" \fBcurses\fR(3X) .PP This describes \fBncurses\fR version @NCURSES_MAJOR@.@NCURSES_MINOR@ (patch @NCURSES_PATCH@). AdaCurses-20211021/doc/ada/ 0000755 0001751 0000144 00000000000 14134402303 013621 5 ustar tom users AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-form_user_data__ads.htm 0000644 0001751 0000144 00000022210 13615673306 026607 0 ustar tom users------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Form_User_Data -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2003,2009 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.16 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type User is limited private; type User_Access is access User; package Terminal_Interface.Curses.Forms.Form_User_Data is pragma Preelaborate (Terminal_Interface.Curses.Forms.Form_User_Data); -- |===================================================================== -- | Man page form_userptr.3x -- |===================================================================== -- | procedure Set_User_Data (Frm : Form; Data : User_Access); -- AKA: set_form_userptr pragma Inline (Set_User_Data); -- | procedure Get_User_Data (Frm : Form; Data : out User_Access); -- AKA: form_userptr -- | function Get_User_Data (Frm : Form) return User_Access; -- AKA: form_userptr -- Same as function pragma Inline (Get_User_Data); end Terminal_Interface.Curses.Forms.Form_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-ipv4_address__ads.htm 0000644 0001751 0000144 00000016276 13615673306 030530 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address); type Internet_V4_Address_Field is new Field_Type with null record; procedure Set_Field_Type (Fld : Field; Typ : Internet_V4_Address_Field); pragma Inline (Set_Field_Type); end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address;AdaCurses-20211021/doc/ada/terminal_interface-curses-trace__ads.htm 0000644 0001751 0000144 00000040541 13615673306 023576 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Trace -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2000,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: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 -- Version Control: -- @Revision: 1.5 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Trace is pragma Preelaborate (Terminal_Interface.Curses.Trace); type Trace_Attribute_Set is record Times : Boolean; Tputs : Boolean; Update : Boolean; Cursor_Move : Boolean; Character_Output : Boolean; Calls : Boolean; Virtual_Puts : Boolean; Input_Events : Boolean; TTY_State : Boolean; Internal_Calls : Boolean; Character_Calls : Boolean; Termcap_TermInfo : Boolean; Attribute_Color : Boolean; end record; pragma Convention (C_Pass_By_Copy, Trace_Attribute_Set); for Trace_Attribute_Set use record Times at 0 range Curses_Constants.TRACE_TIMES_First .. Curses_Constants.TRACE_TIMES_Last; Tputs at 0 range Curses_Constants.TRACE_TPUTS_First .. Curses_Constants.TRACE_TPUTS_Last; Update at 0 range Curses_Constants.TRACE_UPDATE_First .. Curses_Constants.TRACE_UPDATE_Last; Cursor_Move at 0 range Curses_Constants.TRACE_MOVE_First .. Curses_Constants.TRACE_MOVE_Last; Character_Output at 0 range Curses_Constants.TRACE_CHARPUT_First .. Curses_Constants.TRACE_CHARPUT_Last; Calls at 0 range Curses_Constants.TRACE_CALLS_First .. Curses_Constants.TRACE_CALLS_Last; Virtual_Puts at 0 range Curses_Constants.TRACE_VIRTPUT_First .. Curses_Constants.TRACE_VIRTPUT_Last; Input_Events at 0 range Curses_Constants.TRACE_IEVENT_First .. Curses_Constants.TRACE_IEVENT_Last; TTY_State at 0 range Curses_Constants.TRACE_BITS_First .. Curses_Constants.TRACE_BITS_Last; Internal_Calls at 0 range Curses_Constants.TRACE_ICALLS_First .. Curses_Constants.TRACE_ICALLS_Last; Character_Calls at 0 range Curses_Constants.TRACE_CCALLS_First .. Curses_Constants.TRACE_CCALLS_Last; Termcap_TermInfo at 0 range Curses_Constants.TRACE_DATABASE_First .. Curses_Constants.TRACE_DATABASE_Last; Attribute_Color at 0 range Curses_Constants.TRACE_ATTRS_First .. Curses_Constants.TRACE_ATTRS_Last; end record; pragma Warnings (Off); for Trace_Attribute_Set'Size use Curses_Constants.Trace_Size; pragma Warnings (On); Trace_Disable : constant Trace_Attribute_Set := (others => False); Trace_Ordinary : constant Trace_Attribute_Set := (Times => True, Tputs => True, Update => True, Cursor_Move => True, Character_Output => True, others => False); Trace_Maximum : constant Trace_Attribute_Set := (others => True); ------------------------------------------------------------------------------ -- |===================================================================== -- | Man page curs_trace.3x -- |===================================================================== -- | procedure Trace_On (x : Trace_Attribute_Set); -- The debugging library has trace. -- | procedure Trace_Put (str : String); -- AKA: _tracef() Current_Trace_Setting : Trace_Attribute_Set; pragma Import (C, Current_Trace_Setting, "_nc_tracing"); end Terminal_Interface.Curses.Trace;AdaCurses-20211021/doc/ada/terminal_interface-curses-panels__ads.htm 0000644 0001751 0000144 00000040502 13615673306 023757 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Panels -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2009,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.23 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; package Terminal_Interface.Curses.Panels is pragma Preelaborate (Terminal_Interface.Curses.Panels); pragma Linker_Options ("-lpanel" & Curses_Constants.DFT_ARG_SUFFIX); type Panel is private; --------------------------- -- Interface constants -- --------------------------- Null_Panel : constant Panel; ------------------- -- Exceptions -- ------------------- Panel_Exception : exception; -- |===================================================================== -- | Man page panel.3x -- |===================================================================== -- | function Create (Win : Window) return Panel; -- AKA: new_panel() pragma Inline (Create); -- | function New_Panel (Win : Window) return Panel renames Create; -- AKA: new_panel() -- pragma Inline (New_Panel); -- | procedure Bottom (Pan : Panel); -- AKA: bottom_panel() pragma Inline (Bottom); -- | procedure Top (Pan : Panel); -- AKA: top_panel() pragma Inline (Top); -- | procedure Show (Pan : Panel); -- AKA: show_panel() pragma Inline (Show); -- | procedure Update_Panels; -- AKA: update_panels() pragma Import (C, Update_Panels, "update_panels"); -- | procedure Hide (Pan : Panel); -- AKA: hide_panel() pragma Inline (Hide); -- | function Get_Window (Pan : Panel) return Window; -- AKA: panel_window() pragma Inline (Get_Window); -- | function Panel_Window (Pan : Panel) return Window renames Get_Window; -- pragma Inline (Panel_Window); -- | procedure Replace (Pan : Panel; Win : Window); -- AKA: replace_panel() pragma Inline (Replace); -- | procedure Move (Pan : Panel; Line : Line_Position; Column : Column_Position); -- AKA: move_panel() pragma Inline (Move); -- | function Is_Hidden (Pan : Panel) return Boolean; -- AKA: panel_hidden() pragma Inline (Is_Hidden); -- | function Above (Pan : Panel) return Panel; -- AKA: panel_above() pragma Import (C, Above, "panel_above"); -- | function Below (Pan : Panel) return Panel; -- AKA: panel_below() pragma Import (C, Below, "panel_below"); -- | procedure Delete (Pan : in out Panel); -- AKA: del_panel() pragma Inline (Delete); private type Panel is new System.Storage_Elements.Integer_Address; Null_Panel : constant Panel := 0; end Terminal_Interface.Curses.Panels;AdaCurses-20211021/doc/ada/funcs.htm 0000644 0001751 0000144 00000001717 12145772563 015501 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.21 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.User.Choice is package Argument_Conversions is new System.Address_To_Access_Conversions (Argument); function Generic_Next (Fld : Field; Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Next (Fld, Udf.all); return Curses_Bool (Boolean'Pos (Result)); end Generic_Next; function Generic_Prev (Fld : Field; Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_With_Choice_Access := User_Defined_Field_Type_With_Choice_Access (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Previous (Fld, Udf.all); return Curses_Bool (Boolean'Pos (Result)); end Generic_Prev; -- ----------------------------------------------------------------------- -- function C_Generic_Choice return C_Field_Type is Res : Eti_Error; T : C_Field_Type; begin if M_Generic_Choice = Null_Field_Type then T := New_Fieldtype (Generic_Field_Check'Access, Generic_Char_Check'Access); if T = Null_Field_Type then raise Form_Exception; else Res := Set_Fieldtype_Arg (T, Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access); Eti_Exception (Res); Res := Set_Fieldtype_Choice (T, Generic_Next'Access, Generic_Prev'Access); Eti_Exception (Res); end if; M_Generic_Choice := T; end if; pragma Assert (M_Generic_Choice /= Null_Field_Type); return M_Generic_Choice; end C_Generic_Choice; end Terminal_Interface.Curses.Forms.Field_Types.User.Choice;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-float_io__adb.htm 0000644 0001751 0000144 00000026561 13615673306 025732 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Float_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; with Terminal_Interface.Curses.Text_IO.Aux; package body Terminal_Interface.Curses.Text_IO.Float_IO is package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package FIO is new Ada.Text_IO.Float_IO (Num); procedure Put (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is Buf : String (1 .. Field'Last); Len : Field := Fore + 1 + Aft; begin if Exp > 0 then Len := Len + 1 + Exp; end if; FIO.Put (Buf, Item, Aft, Exp); Aux.Put_Buf (Win, Buf, Len, False); end Put; procedure Put (Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is begin Put (Get_Window, Item, Fore, Aft, Exp); end Put; end Terminal_Interface.Curses.Text_IO.Float_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-menus__ads.htm 0000644 0001751 0000144 00000250346 13615673306 023635 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Menu -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2009,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.32 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; with Ada.Characters.Latin_1; package Terminal_Interface.Curses.Menus is pragma Preelaborate (Terminal_Interface.Curses.Menus); pragma Linker_Options ("-lmenu" & Curses_Constants.DFT_ARG_SUFFIX); Space : Character renames Ada.Characters.Latin_1.Space; type Item is private; type Menu is private; --------------------------- -- Interface constants -- --------------------------- Null_Item : constant Item; Null_Menu : constant Menu; subtype Menu_Request_Code is Key_Code range (Key_Max + 1) .. (Key_Max + 17); -- The prefix M_ stands for "Menu Request" M_Left_Item : constant Menu_Request_Code := Key_Max + 1; M_Right_Item : constant Menu_Request_Code := Key_Max + 2; M_Up_Item : constant Menu_Request_Code := Key_Max + 3; M_Down_Item : constant Menu_Request_Code := Key_Max + 4; M_ScrollUp_Line : constant Menu_Request_Code := Key_Max + 5; M_ScrollDown_Line : constant Menu_Request_Code := Key_Max + 6; M_ScrollDown_Page : constant Menu_Request_Code := Key_Max + 7; M_ScrollUp_Page : constant Menu_Request_Code := Key_Max + 8; M_First_Item : constant Menu_Request_Code := Key_Max + 9; M_Last_Item : constant Menu_Request_Code := Key_Max + 10; M_Next_Item : constant Menu_Request_Code := Key_Max + 11; M_Previous_Item : constant Menu_Request_Code := Key_Max + 12; M_Toggle_Item : constant Menu_Request_Code := Key_Max + 13; M_Clear_Pattern : constant Menu_Request_Code := Key_Max + 14; M_Back_Pattern : constant Menu_Request_Code := Key_Max + 15; M_Next_Match : constant Menu_Request_Code := Key_Max + 16; M_Previous_Match : constant Menu_Request_Code := Key_Max + 17; -- For those who like the old 'C' names for the request codes REQ_LEFT_ITEM : Menu_Request_Code renames M_Left_Item; REQ_RIGHT_ITEM : Menu_Request_Code renames M_Right_Item; REQ_UP_ITEM : Menu_Request_Code renames M_Up_Item; REQ_DOWN_ITEM : Menu_Request_Code renames M_Down_Item; REQ_SCR_ULINE : Menu_Request_Code renames M_ScrollUp_Line; REQ_SCR_DLINE : Menu_Request_Code renames M_ScrollDown_Line; REQ_SCR_DPAGE : Menu_Request_Code renames M_ScrollDown_Page; REQ_SCR_UPAGE : Menu_Request_Code renames M_ScrollUp_Page; REQ_FIRST_ITEM : Menu_Request_Code renames M_First_Item; REQ_LAST_ITEM : Menu_Request_Code renames M_Last_Item; REQ_NEXT_ITEM : Menu_Request_Code renames M_Next_Item; REQ_PREV_ITEM : Menu_Request_Code renames M_Previous_Item; REQ_TOGGLE_ITEM : Menu_Request_Code renames M_Toggle_Item; REQ_CLEAR_PATTERN : Menu_Request_Code renames M_Clear_Pattern; REQ_BACK_PATTERN : Menu_Request_Code renames M_Back_Pattern; REQ_NEXT_MATCH : Menu_Request_Code renames M_Next_Match; REQ_PREV_MATCH : Menu_Request_Code renames M_Previous_Match; procedure Request_Name (Key : Menu_Request_Code; Name : out String); function Request_Name (Key : Menu_Request_Code) return String; -- Same as function ------------------ -- Exceptions -- ------------------ Menu_Exception : exception; -- -- Menu options -- type Menu_Option_Set is record One_Valued : Boolean; Show_Descriptions : Boolean; Row_Major_Order : Boolean; Ignore_Case : Boolean; Show_Matches : Boolean; Non_Cyclic : Boolean; end record; pragma Convention (C_Pass_By_Copy, Menu_Option_Set); for Menu_Option_Set use record One_Valued at 0 range Curses_Constants.O_ONEVALUE_First .. Curses_Constants.O_ONEVALUE_Last; Show_Descriptions at 0 range Curses_Constants.O_SHOWDESC_First .. Curses_Constants.O_SHOWDESC_Last; Row_Major_Order at 0 range Curses_Constants.O_ROWMAJOR_First .. Curses_Constants.O_ROWMAJOR_Last; Ignore_Case at 0 range Curses_Constants.O_IGNORECASE_First .. Curses_Constants.O_IGNORECASE_Last; Show_Matches at 0 range Curses_Constants.O_SHOWMATCH_First .. Curses_Constants.O_SHOWMATCH_Last; Non_Cyclic at 0 range Curses_Constants.O_NONCYCLIC_First .. Curses_Constants.O_NONCYCLIC_Last; end record; pragma Warnings (Off); for Menu_Option_Set'Size use Curses_Constants.Menu_Options_Size; pragma Warnings (On); function Default_Menu_Options return Menu_Option_Set; -- Initial default options for a menu. pragma Inline (Default_Menu_Options); -- -- Item options -- type Item_Option_Set is record Selectable : Boolean; end record; pragma Convention (C_Pass_By_Copy, Item_Option_Set); for Item_Option_Set use record Selectable at 0 range Curses_Constants.O_SELECTABLE_First .. Curses_Constants.O_SELECTABLE_Last; end record; pragma Warnings (Off); for Item_Option_Set'Size use Curses_Constants.Item_Options_Size; pragma Warnings (On); function Default_Item_Options return Item_Option_Set; -- Initial default options for an item. pragma Inline (Default_Item_Options); -- -- Item Array -- type Item_Array is array (Positive range <>) of aliased Item; pragma Convention (C, Item_Array); type Item_Array_Access is access Item_Array; procedure Free (IA : in out Item_Array_Access; Free_Items : Boolean := False); -- Release the memory for an allocated item array -- If Free_Items is True, call Delete() for all the items in -- the array. -- |===================================================================== -- | Man page mitem_new.3x -- |===================================================================== -- | function Create (Name : String; Description : String := "") return Item; -- AKA: new_item() -- Not inlined. -- | function New_Item (Name : String; Description : String := "") return Item renames Create; -- AKA: new_item() -- | procedure Delete (Itm : in out Item); -- AKA: free_item() -- Resets Itm to Null_Item -- |===================================================================== -- | Man page mitem_value.3x -- |===================================================================== -- | procedure Set_Value (Itm : Item; Value : Boolean := True); -- AKA: set_item_value() pragma Inline (Set_Value); -- | function Value (Itm : Item) return Boolean; -- AKA: item_value() pragma Inline (Value); -- |===================================================================== -- | Man page mitem_visible.3x -- |===================================================================== -- | function Visible (Itm : Item) return Boolean; -- AKA: item_visible() pragma Inline (Visible); -- |===================================================================== -- | Man page mitem_opts.3x -- |===================================================================== -- | procedure Set_Options (Itm : Item; Options : Item_Option_Set); -- AKA: set_item_opts() -- An overloaded Set_Options is defined later. Pragma Inline appears there -- | procedure Switch_Options (Itm : Item; Options : Item_Option_Set; On : Boolean := True); -- AKA: item_opts_on() -- AKA: item_opts_off() -- An overloaded Switch_Options is defined later. -- Pragma Inline appears there -- | procedure Get_Options (Itm : Item; Options : out Item_Option_Set); -- AKA: item_opts() -- | function Get_Options (Itm : Item := Null_Item) return Item_Option_Set; -- AKA: item_opts() -- An overloaded Get_Options is defined later. Pragma Inline appears there -- |===================================================================== -- | Man page mitem_name.3x -- |===================================================================== -- | procedure Name (Itm : Item; Name : out String); -- AKA: item_name() function Name (Itm : Item) return String; -- AKA: item_name() -- Implemented as function pragma Inline (Name); -- | procedure Description (Itm : Item; Description : out String); -- AKA: item_description(); function Description (Itm : Item) return String; -- AKA: item_description(); -- Implemented as function pragma Inline (Description); -- |===================================================================== -- | Man page mitem_current.3x -- |===================================================================== -- | procedure Set_Current (Men : Menu; Itm : Item); -- AKA: set_current_item() pragma Inline (Set_Current); -- | function Current (Men : Menu) return Item; -- AKA: current_item() pragma Inline (Current); -- | procedure Set_Top_Row (Men : Menu; Line : Line_Position); -- AKA: set_top_row() pragma Inline (Set_Top_Row); -- | function Top_Row (Men : Menu) return Line_Position; -- AKA: top_row() pragma Inline (Top_Row); -- | function Get_Index (Itm : Item) return Positive; -- AKA: item_index() -- Please note that in this binding we start the numbering of items -- with 1. So this is number is one more than you get from the low -- level call. pragma Inline (Get_Index); -- |===================================================================== -- | Man page menu_post.3x -- |===================================================================== -- | procedure Post (Men : Menu; Post : Boolean := True); -- AKA: post_menu() -- AKA: unpost_menu() pragma Inline (Post); -- |===================================================================== -- | Man page menu_opts.3x -- |===================================================================== -- | procedure Set_Options (Men : Menu; Options : Menu_Option_Set); -- AKA: set_menu_opts() pragma Inline (Set_Options); -- | procedure Switch_Options (Men : Menu; Options : Menu_Option_Set; On : Boolean := True); -- AKA: menu_opts_on() -- AKA: menu_opts_off() pragma Inline (Switch_Options); -- | procedure Get_Options (Men : Menu; Options : out Menu_Option_Set); -- AKA: menu_opts() -- | function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set; -- AKA: menu_opts() pragma Inline (Get_Options); -- |===================================================================== -- | Man page menu_win.3x -- |===================================================================== -- | procedure Set_Window (Men : Menu; Win : Window); -- AKA: set_menu_win() pragma Inline (Set_Window); -- | function Get_Window (Men : Menu) return Window; -- AKA: menu_win() pragma Inline (Get_Window); -- | procedure Set_Sub_Window (Men : Menu; Win : Window); -- AKA: set_menu_sub() pragma Inline (Set_Sub_Window); -- | function Get_Sub_Window (Men : Menu) return Window; -- AKA: menu_sub() pragma Inline (Get_Sub_Window); -- | procedure Scale (Men : Menu; Lines : out Line_Count; Columns : out Column_Count); -- AKA: scale_menu() pragma Inline (Scale); -- |===================================================================== -- | Man page menu_cursor.3x -- |===================================================================== -- | procedure Position_Cursor (Men : Menu); -- AKA: pos_menu_cursor() pragma Inline (Position_Cursor); -- |===================================================================== -- | Man page menu_mark.3x -- |===================================================================== -- | procedure Set_Mark (Men : Menu; Mark : String); -- AKA: set_menu_mark() pragma Inline (Set_Mark); -- | procedure Mark (Men : Menu; Mark : out String); -- AKA: menu_mark() function Mark (Men : Menu) return String; -- AKA: menu_mark() -- Implemented as function pragma Inline (Mark); -- |===================================================================== -- | Man page menu_attributes.3x -- |===================================================================== -- | procedure Set_Foreground (Men : Menu; Fore : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: set_menu_fore() pragma Inline (Set_Foreground); -- | procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set); -- AKA: menu_fore() -- | procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set; Color : out Color_Pair); -- AKA: menu_fore() pragma Inline (Foreground); -- | procedure Set_Background (Men : Menu; Back : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: set_menu_back() pragma Inline (Set_Background); -- | procedure Background (Men : Menu; Back : out Character_Attribute_Set); -- AKA: menu_back() -- | procedure Background (Men : Menu; Back : out Character_Attribute_Set; Color : out Color_Pair); -- AKA: menu_back() pragma Inline (Background); -- | procedure Set_Grey (Men : Menu; Grey : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: set_menu_grey() pragma Inline (Set_Grey); -- | procedure Grey (Men : Menu; Grey : out Character_Attribute_Set); -- AKA: menu_grey() -- | procedure Grey (Men : Menu; Grey : out Character_Attribute_Set; Color : out Color_Pair); -- AKA: menu_grey() pragma Inline (Grey); -- | procedure Set_Pad_Character (Men : Menu; Pad : Character := Space); -- AKA: set_menu_pad() pragma Inline (Set_Pad_Character); -- | procedure Pad_Character (Men : Menu; Pad : out Character); -- AKA: menu_pad() pragma Inline (Pad_Character); -- |===================================================================== -- | Man page menu_spacing.3x -- |===================================================================== -- | procedure Set_Spacing (Men : Menu; Descr : Column_Position := 0; Row : Line_Position := 0; Col : Column_Position := 0); -- AKA: set_menu_spacing() pragma Inline (Set_Spacing); -- | procedure Spacing (Men : Menu; Descr : out Column_Position; Row : out Line_Position; Col : out Column_Position); -- AKA: menu_spacing() pragma Inline (Spacing); -- |===================================================================== -- | Man page menu_pattern.3x -- |===================================================================== -- | function Set_Pattern (Men : Menu; Text : String) return Boolean; -- AKA: set_menu_pattern() -- Return TRUE if the pattern matches, FALSE otherwise pragma Inline (Set_Pattern); -- | procedure Pattern (Men : Menu; Text : out String); -- AKA: menu_pattern() pragma Inline (Pattern); -- |===================================================================== -- | Man page menu_format.3x -- |===================================================================== -- | procedure Set_Format (Men : Menu; Lines : Line_Count; Columns : Column_Count); -- Not implemented: 0 argument for Lines or Columns; -- instead use Format to get the current sizes -- The default format is 16 rows, 1 column. Calling -- set_menu_format with a null menu pointer will change this -- default. A zero row or column argument to set_menu_format -- is interpreted as a request not to change the current -- value. -- AKA: set_menu_format() pragma Inline (Set_Format); -- | procedure Format (Men : Menu; Lines : out Line_Count; Columns : out Column_Count); -- AKA: menu_format() pragma Inline (Format); -- |===================================================================== -- | Man page menu_hook.3x -- |===================================================================== type Menu_Hook_Function is access procedure (Men : Menu); pragma Convention (C, Menu_Hook_Function); -- | procedure Set_Item_Init_Hook (Men : Menu; Proc : Menu_Hook_Function); -- AKA: set_item_init() pragma Inline (Set_Item_Init_Hook); -- | procedure Set_Item_Term_Hook (Men : Menu; Proc : Menu_Hook_Function); -- AKA: set_item_term() pragma Inline (Set_Item_Term_Hook); -- | procedure Set_Menu_Init_Hook (Men : Menu; Proc : Menu_Hook_Function); -- AKA: set_menu_init() pragma Inline (Set_Menu_Init_Hook); -- | procedure Set_Menu_Term_Hook (Men : Menu; Proc : Menu_Hook_Function); -- AKA: set_menu_term() pragma Inline (Set_Menu_Term_Hook); -- | function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: item_init() pragma Inline (Get_Item_Init_Hook); -- | function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: item_term() pragma Inline (Get_Item_Term_Hook); -- | function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: menu_init() pragma Inline (Get_Menu_Init_Hook); -- | function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function; -- AKA: menu_term() pragma Inline (Get_Menu_Term_Hook); -- |===================================================================== -- | Man page menu_items.3x -- |===================================================================== -- | procedure Redefine (Men : Menu; Items : Item_Array_Access); -- AKA: set_menu_items() pragma Inline (Redefine); procedure Set_Items (Men : Menu; Items : Item_Array_Access) renames Redefine; -- pragma Inline (Set_Items); -- | function Items (Men : Menu; Index : Positive) return Item; -- AKA: menu_items() pragma Inline (Items); -- | function Item_Count (Men : Menu) return Natural; -- AKA: item_count() pragma Inline (Item_Count); -- |===================================================================== -- | Man page menu_new.3x -- |===================================================================== -- | function Create (Items : Item_Array_Access) return Menu; -- AKA: new_menu() -- Not inlined function New_Menu (Items : Item_Array_Access) return Menu renames Create; -- | procedure Delete (Men : in out Menu); -- AKA: free_menu() -- Reset Men to Null_Menu -- Not inlined -- |===================================================================== -- | Man page menu_driver.3x -- |===================================================================== type Driver_Result is (Menu_Ok, Request_Denied, Unknown_Request, No_Match); -- | function Driver (Men : Menu; Key : Key_Code) return Driver_Result; -- AKA: menu_driver() -- Driver is not inlined -- | -- Not Implemented: menu_request_name, menu_request_by_name ------------------------------------------------------------------------------- private type Item is new System.Storage_Elements.Integer_Address; type Menu is new System.Storage_Elements.Integer_Address; Null_Item : constant Item := 0; Null_Menu : constant Menu := 0; end Terminal_Interface.Curses.Menus;AdaCurses-20211021/doc/ada/terminal_interface-curses-putwin__ads.htm 0000644 0001751 0000144 00000014303 13615673306 024023 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.PutWin -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2000-2002,2003 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.5 @ -- Binding Version 01.00 with Ada.Streams.Stream_IO; package Terminal_Interface.Curses.PutWin is procedure Put_Window (Win : Window; File : Ada.Streams.Stream_IO.File_Type); function Get_Window (File : Ada.Streams.Stream_IO.File_Type) return Window; end Terminal_Interface.Curses.PutWin;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-decimal_io__adb.htm 0000644 0001751 0000144 00000026716 13615673306 026225 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Decimal_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; with Terminal_Interface.Curses.Text_IO.Aux; package body Terminal_Interface.Curses.Text_IO.Decimal_IO is package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package DIO is new Ada.Text_IO.Decimal_IO (Num); procedure Put (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is Buf : String (1 .. Field'Last); Len : Field := Fore + 1 + Aft; begin if Exp > 0 then Len := Len + 1 + Exp; end if; DIO.Put (Buf, Item, Aft, Exp); Aux.Put_Buf (Win, Buf, Len, False); end Put; procedure Put (Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is begin Put (Get_Window, Item, Fore, Aft, Exp); end Put; end Terminal_Interface.Curses.Text_IO.Decimal_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-regexp__ads.htm 0000644 0001751 0000144 00000016655 13615673306 027434 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Forms.Field_Types.RegExp is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.RegExp); type String_Access is access String; type Regular_Expression_Field is new Field_Type with record Regular_Expression : String_Access; end record; procedure Set_Field_Type (Fld : Field; Typ : Regular_Expression_Field); pragma Inline (Set_Field_Type); end Terminal_Interface.Curses.Forms.Field_Types.RegExp;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-intfield__ads.htm 0000644 0001751 0000144 00000016606 13615673306 027734 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.IntField -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Forms.Field_Types.IntField is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.IntField); type Integer_Field is new Field_Type with record Precision : Natural; Lower_Limit : Integer; Upper_Limit : Integer; end record; procedure Set_Field_Type (Fld : Field; Typ : Integer_Field); pragma Inline (Set_Field_Type); end Terminal_Interface.Curses.Forms.Field_Types.IntField;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-numeric__adb.htm 0000644 0001751 0000144 00000024301 13615673306 027546 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.15 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.Numeric is procedure Set_Field_Type (Fld : Field; Typ : Numeric_Field) is type Double is new Interfaces.C.double; function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int; Arg2 : Double; Arg3 : Double) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_numeric"); begin Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision), Arg2 => Double (Typ.Lower_Limit), Arg3 => Double (Typ.Upper_Limit))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; end Terminal_Interface.Curses.Forms.Field_Types.Numeric;AdaCurses-20211021/doc/ada/table.html 0000644 0001751 0000144 00000161026 13076721162 015617 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.IntField -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.14 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.IntField is procedure Set_Field_Type (Fld : Field; Typ : Integer_Field) is function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int; Arg2 : C_Long_Int; Arg3 : C_Long_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_integer"); begin Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Precision), Arg2 => C_Long_Int (Typ.Lower_Limit), Arg3 => C_Long_Int (Typ.Upper_Limit))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; end Terminal_Interface.Curses.Forms.Field_Types.IntField;AdaCurses-20211021/doc/ada/terminal_interface-curses-menus-menu_user_data__ads.htm 0000644 0001751 0000144 00000022210 13615673306 026611 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Menus.Menu_User_Data -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2003,2009 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.16 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type User is limited private; type User_Access is access User; package Terminal_Interface.Curses.Menus.Menu_User_Data is pragma Preelaborate (Terminal_Interface.Curses.Menus.Menu_User_Data); -- |===================================================================== -- | Man page menu_userptr.3x -- |===================================================================== -- | procedure Set_User_Data (Men : Menu; Data : User_Access); -- AKA: set_menu_userptr pragma Inline (Set_User_Data); -- | procedure Get_User_Data (Men : Menu; Data : out User_Access); -- AKA: menu_userptr -- | function Get_User_Data (Men : Menu) return User_Access; -- AKA: menu_userptr -- Same as function pragma Inline (Get_User_Data); end Terminal_Interface.Curses.Menus.Menu_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types__ads.htm 0000644 0001751 0000144 00000075620 13615673306 026141 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 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.21 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; with Terminal_Interface.Curses.Aux; package Terminal_Interface.Curses.Forms.Field_Types is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types); subtype C_Int is Interfaces.C.int; -- |===================================================================== -- | Man page form_fieldtype.3x -- |===================================================================== type Field_Type is abstract tagged null record; -- Abstract base type for all field types. A concrete field type -- is an extension that adds some data elements describing formats or -- boundary values for the type and validation routines. -- For the builtin low-level fieldtypes, the validation routines are -- already defined by the low-level C library. -- The builtin types like Alpha or AlphaNumeric etc. are defined in -- child packages of this package. You may use one of them as example -- how to create you own child packages for low-level field types that -- you may have already written in C. type Field_Type_Access is access all Field_Type'Class; -- | procedure Set_Field_Type (Fld : Field; Fld_Type : Field_Type) is abstract; -- AKA: set_field_type() -- But: we hide the vararg mechanism of the C interface. You always -- have to pass a single Field_Type parameter. -- --------------------------------------------------------------------- -- |===================================================================== -- | Man page form_field_validation.3x -- |===================================================================== -- | function Get_Type (Fld : Field) return Field_Type_Access; -- AKA: field_type() -- AKA: field_arg() -- In Ada95 we can combine these. If you try to retrieve the field type -- that is not defined as extension of the abstract tagged type above, -- you will raise a Form_Exception. -- This is not inlined -- +---------------------------------------------------------------------- -- | Private Part. -- | Most of this is used by the implementations of the child packages. -- | private type Makearg_Function is access function (Args : System.Address) return System.Address; pragma Convention (C, Makearg_Function); type Copyarg_Function is access function (Usr : System.Address) return System.Address; pragma Convention (C, Copyarg_Function); type Freearg_Function is access procedure (Usr : System.Address); pragma Convention (C, Freearg_Function); type Field_Check_Function is access function (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Field_Check_Function); type Char_Check_Function is access function (Ch : C_Int; Usr : System.Address) return Curses_Bool; pragma Convention (C, Char_Check_Function); type Choice_Function is access function (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Choice_Function); -- +---------------------------------------------------------------------- -- | This must be in sync with the FIELDTYPE structure in form.h -- | type Low_Level_Field_Type is record Status : Interfaces.C.unsigned_short; Ref_Count : Interfaces.C.long; Left, Right : System.Address; Makearg : Makearg_Function; Copyarg : Copyarg_Function; Freearg : Freearg_Function; Fcheck : Field_Check_Function; Ccheck : Char_Check_Function; Next, Prev : Choice_Function; end record; pragma Convention (C, Low_Level_Field_Type); type C_Field_Type is access all Low_Level_Field_Type; Null_Field_Type : constant C_Field_Type := null; -- +---------------------------------------------------------------------- -- | This four low-level fieldtypes are the ones associated with -- | fieldtypes handled by this binding. Any other low-level fieldtype -- | will result in a Form_Exception is function Get_Type. -- | M_Generic_Type : C_Field_Type := null; M_Generic_Choice : C_Field_Type := null; M_Builtin_Router : C_Field_Type := null; M_Choice_Router : C_Field_Type := null; -- Two wrapper functions to access those low-level fieldtypes defined -- in this package. function C_Builtin_Router return C_Field_Type; function C_Choice_Router return C_Field_Type; procedure Wrap_Builtin (Fld : Field; Typ : Field_Type'Class; Cft : C_Field_Type := C_Builtin_Router); -- This procedure has to be called by the Set_Field_Type implementation -- for builtin low-level fieldtypes to replace it by an Ada95 -- conformant Field_Type object. -- The parameter Cft must be C_Builtin_Router for regular low-level -- fieldtypes (like TYP_ALPHA or TYP_ALNUM) and C_Choice_Router for -- low-level fieldtypes witch choice functions (like TYP_ENUM). -- Any other value will raise a Form_Exception. function Make_Arg (Args : System.Address) return System.Address; pragma Import (C, Make_Arg, "void_star_make_arg"); -- This is the Makearg_Function for the internal low-level types -- introduced by this binding. function Copy_Arg (Usr : System.Address) return System.Address; pragma Convention (C, Copy_Arg); -- This is the Copyarg_Function for the internal low-level types -- introduced by this binding. procedure Free_Arg (Usr : System.Address); pragma Convention (C, Free_Arg); -- This is the Freearg_Function for the internal low-level types -- introduced by this binding. function Field_Check_Router (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Field_Check_Router); -- This is the Field_Check_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level validation -- function. function Char_Check_Router (Ch : C_Int; Usr : System.Address) return Curses_Bool; pragma Convention (C, Char_Check_Router); -- This is the Char_Check_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level validation -- function. function Next_Router (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Next_Router); -- This is the Choice_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level next_choice -- function. function Prev_Router (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Prev_Router); -- This is the Choice_Function for the internal low-level types -- introduced to wrap the low-level types by a Field_Type derived -- type. It routes the call to the corresponding low-level prev_choice -- function. -- This is the Argument structure maintained by all low-level field types -- introduced by this binding. type Argument is record Typ : Field_Type_Access; -- the Field_Type creating this record Usr : System.Address; -- original arg for builtin low-level types Cft : C_Field_Type; -- the original low-level type end record; type Argument_Access is access all Argument; -- +---------------------------------------------------------------------- -- | -- | Some Imports of libform routines to deal with low-level fieldtypes. -- | function New_Fieldtype (Fcheck : Field_Check_Function; Ccheck : Char_Check_Function) return C_Field_Type; pragma Import (C, New_Fieldtype, "new_fieldtype"); function Set_Fieldtype_Arg (Cft : C_Field_Type; Mak : Makearg_Function := Make_Arg'Access; Cop : Copyarg_Function := Copy_Arg'Access; Fre : Freearg_Function := Free_Arg'Access) return Aux.Eti_Error; pragma Import (C, Set_Fieldtype_Arg, "set_fieldtype_arg"); function Set_Fieldtype_Choice (Cft : C_Field_Type; Next, Prev : Choice_Function) return Aux.Eti_Error; pragma Import (C, Set_Fieldtype_Choice, "set_fieldtype_choice"); end Terminal_Interface.Curses.Forms.Field_Types;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_user_data__adb.htm 0000644 0001751 0000144 00000025427 13615673306 026723 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_User_Data -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 1999-2009,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.17 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; -- | -- |===================================================================== -- | man page form_field_userptr.3x -- |===================================================================== -- | package body Terminal_Interface.Curses.Forms.Field_User_Data is -- | -- | -- | procedure Set_User_Data (Fld : Field; Data : User_Access) is function Set_Field_Userptr (Fld : Field; Usr : User_Access) return Eti_Error; pragma Import (C, Set_Field_Userptr, "set_field_userptr"); begin Eti_Exception (Set_Field_Userptr (Fld, Data)); end Set_User_Data; -- | -- | -- | function Get_User_Data (Fld : Field) return User_Access is function Field_Userptr (Fld : Field) return User_Access; pragma Import (C, Field_Userptr, "field_userptr"); begin return Field_Userptr (Fld); end Get_User_Data; procedure Get_User_Data (Fld : Field; Data : out User_Access) is begin Data := Get_User_Data (Fld); end Get_User_Data; end Terminal_Interface.Curses.Forms.Field_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-alphanumeric__adb.htm 0000644 0001751 0000144 00000021417 13615673306 030561 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.14 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is procedure Set_Field_Type (Fld : Field; Typ : AlphaNumeric_Field) is function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_alnum"); begin Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric;AdaCurses-20211021/doc/ada/terminal_interface-curses-menus-item_user_data__adb.htm 0000644 0001751 0000144 00000024115 13615673306 026570 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Menus.Item_User_Data -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 1999-2009,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.16 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Menus.Item_User_Data is procedure Set_User_Data (Itm : Item; Data : User_Access) is function Set_Item_Userptr (Itm : Item; Addr : User_Access) return Eti_Error; pragma Import (C, Set_Item_Userptr, "set_item_userptr"); begin Eti_Exception (Set_Item_Userptr (Itm, Data)); end Set_User_Data; function Get_User_Data (Itm : Item) return User_Access is function Item_Userptr (Itm : Item) return User_Access; pragma Import (C, Item_Userptr, "item_userptr"); begin return Item_Userptr (Itm); end Get_User_Data; procedure Get_User_Data (Itm : Item; Data : out User_Access) is begin Data := Get_User_Data (Itm); end Get_User_Data; end Terminal_Interface.Curses.Menus.Item_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses__ads.htm 0000644 0001751 0000144 00001027406 13615673306 022510 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 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.48 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Storage_Elements; with Interfaces.C; -- We need this for some assertions. with Terminal_Interface.Curses_Constants; package Terminal_Interface.Curses is pragma Preelaborate (Terminal_Interface.Curses); pragma Linker_Options ("-lncurses" & Curses_Constants.DFT_ARG_SUFFIX); Major_Version : constant := Curses_Constants.NCURSES_VERSION_MAJOR; Minor_Version : constant := Curses_Constants.NCURSES_VERSION_MINOR; NC_Version : String renames Curses_Constants.Version; type Window is private; Null_Window : constant Window; type Line_Position is new Integer; -- line coordinate type Column_Position is new Integer; -- column coordinate subtype Line_Count is Line_Position range 1 .. Line_Position'Last; -- Type to count lines. We do not allow null windows, so must be positive subtype Column_Count is Column_Position range 1 .. Column_Position'Last; -- Type to count columns. We do not allow null windows, so must be positive type Key_Code is new Integer; -- That is anything including real characters, special keys and logical -- request codes. -- FIXME: The "-1" should be Curses_Err subtype Real_Key_Code is Key_Code range -1 .. Curses_Constants.KEY_MAX; -- This are the codes that potentially represent a real keystroke. -- Not all codes may be possible on a specific terminal. To check the -- availability of a special key, the Has_Key function is provided. subtype Special_Key_Code is Real_Key_Code range Curses_Constants. KEY_MIN - 1 .. Real_Key_Code'Last; -- Type for a function- or special key number subtype Normal_Key_Code is Real_Key_Code range Character'Pos (Character'First) .. Character'Pos (Character'Last); -- This are the codes for regular (incl. non-graphical) characters. -- For those who like to use the original key names we produce them were -- they differ from the original. -- Constants for function- and special keys Key_None : constant Special_Key_Code := Curses_Constants.KEY_MIN - 1; Key_Min : constant Special_Key_Code := Curses_Constants.KEY_MIN; Key_Break : constant Special_Key_Code := Curses_Constants.KEY_BREAK; KEY_DOWN : constant Special_Key_Code := Curses_Constants.KEY_DOWN; Key_Cursor_Down : Special_Key_Code renames KEY_DOWN; KEY_UP : constant Special_Key_Code := Curses_Constants.KEY_UP; Key_Cursor_Up : Special_Key_Code renames KEY_UP; KEY_LEFT : constant Special_Key_Code := Curses_Constants.KEY_LEFT; Key_Cursor_Left : Special_Key_Code renames KEY_LEFT; KEY_RIGHT : constant Special_Key_Code := Curses_Constants.KEY_RIGHT; Key_Cursor_Right : Special_Key_Code renames KEY_RIGHT; Key_Home : constant Special_Key_Code := Curses_Constants.KEY_HOME; Key_Backspace : constant Special_Key_Code := Curses_Constants.KEY_BACKSPACE; Key_F0 : constant Special_Key_Code := Curses_Constants.KEY_F0; Key_F1 : constant Special_Key_Code := Curses_Constants.KEY_F1; Key_F2 : constant Special_Key_Code := Curses_Constants.KEY_F2; Key_F3 : constant Special_Key_Code := Curses_Constants.KEY_F3; Key_F4 : constant Special_Key_Code := Curses_Constants.KEY_F4; Key_F5 : constant Special_Key_Code := Curses_Constants.KEY_F5; Key_F6 : constant Special_Key_Code := Curses_Constants.KEY_F6; Key_F7 : constant Special_Key_Code := Curses_Constants.KEY_F7; Key_F8 : constant Special_Key_Code := Curses_Constants.KEY_F8; Key_F9 : constant Special_Key_Code := Curses_Constants.KEY_F9; Key_F10 : constant Special_Key_Code := Curses_Constants.KEY_F10; Key_F11 : constant Special_Key_Code := Curses_Constants.KEY_F11; Key_F12 : constant Special_Key_Code := Curses_Constants.KEY_F12; Key_F13 : constant Special_Key_Code := Curses_Constants.KEY_F13; Key_F14 : constant Special_Key_Code := Curses_Constants.KEY_F14; Key_F15 : constant Special_Key_Code := Curses_Constants.KEY_F15; Key_F16 : constant Special_Key_Code := Curses_Constants.KEY_F16; Key_F17 : constant Special_Key_Code := Curses_Constants.KEY_F17; Key_F18 : constant Special_Key_Code := Curses_Constants.KEY_F18; Key_F19 : constant Special_Key_Code := Curses_Constants.KEY_F19; Key_F20 : constant Special_Key_Code := Curses_Constants.KEY_F20; Key_F21 : constant Special_Key_Code := Curses_Constants.KEY_F21; Key_F22 : constant Special_Key_Code := Curses_Constants.KEY_F22; Key_F23 : constant Special_Key_Code := Curses_Constants.KEY_F23; Key_F24 : constant Special_Key_Code := Curses_Constants.KEY_F24; KEY_DL : constant Special_Key_Code := Curses_Constants.KEY_DL; Key_Delete_Line : Special_Key_Code renames KEY_DL; KEY_IL : constant Special_Key_Code := Curses_Constants.KEY_IL; Key_Insert_Line : Special_Key_Code renames KEY_IL; KEY_DC : constant Special_Key_Code := Curses_Constants.KEY_DC; Key_Delete_Char : Special_Key_Code renames KEY_DC; KEY_IC : constant Special_Key_Code := Curses_Constants.KEY_IC; Key_Insert_Char : Special_Key_Code renames KEY_IC; KEY_EIC : constant Special_Key_Code := Curses_Constants.KEY_EIC; Key_Exit_Insert_Mode : Special_Key_Code renames KEY_EIC; KEY_CLEAR : constant Special_Key_Code := Curses_Constants.KEY_CLEAR; Key_Clear_Screen : Special_Key_Code renames KEY_CLEAR; KEY_EOS : constant Special_Key_Code := Curses_Constants.KEY_EOS; Key_Clear_End_Of_Screen : Special_Key_Code renames KEY_EOS; KEY_EOL : constant Special_Key_Code := Curses_Constants.KEY_EOL; Key_Clear_End_Of_Line : Special_Key_Code renames KEY_EOL; KEY_SF : constant Special_Key_Code := Curses_Constants.KEY_SF; Key_Scroll_1_Forward : Special_Key_Code renames KEY_SF; KEY_SR : constant Special_Key_Code := Curses_Constants.KEY_SR; Key_Scroll_1_Backward : Special_Key_Code renames KEY_SR; KEY_NPAGE : constant Special_Key_Code := Curses_Constants.KEY_NPAGE; Key_Next_Page : Special_Key_Code renames KEY_NPAGE; KEY_PPAGE : constant Special_Key_Code := Curses_Constants.KEY_PPAGE; Key_Previous_Page : Special_Key_Code renames KEY_PPAGE; KEY_STAB : constant Special_Key_Code := Curses_Constants.KEY_STAB; Key_Set_Tab : Special_Key_Code renames KEY_STAB; KEY_CTAB : constant Special_Key_Code := Curses_Constants.KEY_CTAB; Key_Clear_Tab : Special_Key_Code renames KEY_CTAB; KEY_CATAB : constant Special_Key_Code := Curses_Constants.KEY_CATAB; Key_Clear_All_Tabs : Special_Key_Code renames KEY_CATAB; KEY_ENTER : constant Special_Key_Code := Curses_Constants.KEY_ENTER; Key_Enter_Or_Send : Special_Key_Code renames KEY_ENTER; KEY_SRESET : constant Special_Key_Code := Curses_Constants.KEY_SRESET; Key_Soft_Reset : Special_Key_Code renames KEY_SRESET; Key_Reset : constant Special_Key_Code := Curses_Constants.KEY_RESET; Key_Print : constant Special_Key_Code := Curses_Constants.KEY_PRINT; KEY_LL : constant Special_Key_Code := Curses_Constants.KEY_LL; Key_Bottom : Special_Key_Code renames KEY_LL; KEY_A1 : constant Special_Key_Code := Curses_Constants.KEY_A1; Key_Upper_Left_Of_Keypad : Special_Key_Code renames KEY_A1; KEY_A3 : constant Special_Key_Code := Curses_Constants.KEY_A3; Key_Upper_Right_Of_Keypad : Special_Key_Code renames KEY_A3; KEY_B2 : constant Special_Key_Code := Curses_Constants.KEY_B2; Key_Center_Of_Keypad : Special_Key_Code renames KEY_B2; KEY_C1 : constant Special_Key_Code := Curses_Constants.KEY_C1; Key_Lower_Left_Of_Keypad : Special_Key_Code renames KEY_C1; KEY_C3 : constant Special_Key_Code := Curses_Constants.KEY_C3; Key_Lower_Right_Of_Keypad : Special_Key_Code renames KEY_C3; KEY_BTAB : constant Special_Key_Code := Curses_Constants.KEY_BTAB; Key_Back_Tab : Special_Key_Code renames KEY_BTAB; KEY_BEG : constant Special_Key_Code := Curses_Constants.KEY_BEG; Key_Beginning : Special_Key_Code renames KEY_BEG; Key_Cancel : constant Special_Key_Code := Curses_Constants.KEY_CANCEL; Key_Close : constant Special_Key_Code := Curses_Constants.KEY_CLOSE; Key_Command : constant Special_Key_Code := Curses_Constants.KEY_COMMAND; Key_Copy : constant Special_Key_Code := Curses_Constants.KEY_COPY; Key_Create : constant Special_Key_Code := Curses_Constants.KEY_CREATE; Key_End : constant Special_Key_Code := Curses_Constants.KEY_END; Key_Exit : constant Special_Key_Code := Curses_Constants.KEY_EXIT; Key_Find : constant Special_Key_Code := Curses_Constants.KEY_FIND; Key_Help : constant Special_Key_Code := Curses_Constants.KEY_HELP; Key_Mark : constant Special_Key_Code := Curses_Constants.KEY_MARK; Key_Message : constant Special_Key_Code := Curses_Constants.KEY_MESSAGE; Key_Move : constant Special_Key_Code := Curses_Constants.KEY_MOVE; Key_Next : constant Special_Key_Code := Curses_Constants.KEY_NEXT; Key_Open : constant Special_Key_Code := Curses_Constants.KEY_OPEN; Key_Options : constant Special_Key_Code := Curses_Constants.KEY_OPTIONS; Key_Previous : constant Special_Key_Code := Curses_Constants.KEY_PREVIOUS; Key_Redo : constant Special_Key_Code := Curses_Constants.KEY_REDO; Key_Reference : constant Special_Key_Code := Curses_Constants.KEY_REFERENCE; Key_Refresh : constant Special_Key_Code := Curses_Constants.KEY_REFRESH; Key_Replace : constant Special_Key_Code := Curses_Constants.KEY_REPLACE; Key_Restart : constant Special_Key_Code := Curses_Constants.KEY_RESTART; Key_Resume : constant Special_Key_Code := Curses_Constants.KEY_RESUME; Key_Save : constant Special_Key_Code := Curses_Constants.KEY_SAVE; KEY_SBEG : constant Special_Key_Code := Curses_Constants.KEY_SBEG; Key_Shift_Begin : Special_Key_Code renames KEY_SBEG; KEY_SCANCEL : constant Special_Key_Code := Curses_Constants.KEY_SCANCEL; Key_Shift_Cancel : Special_Key_Code renames KEY_SCANCEL; KEY_SCOMMAND : constant Special_Key_Code := Curses_Constants.KEY_SCOMMAND; Key_Shift_Command : Special_Key_Code renames KEY_SCOMMAND; KEY_SCOPY : constant Special_Key_Code := Curses_Constants.KEY_SCOPY; Key_Shift_Copy : Special_Key_Code renames KEY_SCOPY; KEY_SCREATE : constant Special_Key_Code := Curses_Constants.KEY_SCREATE; Key_Shift_Create : Special_Key_Code renames KEY_SCREATE; KEY_SDC : constant Special_Key_Code := Curses_Constants.KEY_SDC; Key_Shift_Delete_Char : Special_Key_Code renames KEY_SDC; KEY_SDL : constant Special_Key_Code := Curses_Constants.KEY_SDL; Key_Shift_Delete_Line : Special_Key_Code renames KEY_SDL; Key_Select : constant Special_Key_Code := Curses_Constants.KEY_SELECT; KEY_SEND : constant Special_Key_Code := Curses_Constants.KEY_SEND; Key_Shift_End : Special_Key_Code renames KEY_SEND; KEY_SEOL : constant Special_Key_Code := Curses_Constants.KEY_SEOL; Key_Shift_Clear_End_Of_Line : Special_Key_Code renames KEY_SEOL; KEY_SEXIT : constant Special_Key_Code := Curses_Constants.KEY_SEXIT; Key_Shift_Exit : Special_Key_Code renames KEY_SEXIT; KEY_SFIND : constant Special_Key_Code := Curses_Constants.KEY_SFIND; Key_Shift_Find : Special_Key_Code renames KEY_SFIND; KEY_SHELP : constant Special_Key_Code := Curses_Constants.KEY_SHELP; Key_Shift_Help : Special_Key_Code renames KEY_SHELP; KEY_SHOME : constant Special_Key_Code := Curses_Constants.KEY_SHOME; Key_Shift_Home : Special_Key_Code renames KEY_SHOME; KEY_SIC : constant Special_Key_Code := Curses_Constants.KEY_SIC; Key_Shift_Insert_Char : Special_Key_Code renames KEY_SIC; KEY_SLEFT : constant Special_Key_Code := Curses_Constants.KEY_SLEFT; Key_Shift_Cursor_Left : Special_Key_Code renames KEY_SLEFT; KEY_SMESSAGE : constant Special_Key_Code := Curses_Constants.KEY_SMESSAGE; Key_Shift_Message : Special_Key_Code renames KEY_SMESSAGE; KEY_SMOVE : constant Special_Key_Code := Curses_Constants.KEY_SMOVE; Key_Shift_Move : Special_Key_Code renames KEY_SMOVE; KEY_SNEXT : constant Special_Key_Code := Curses_Constants.KEY_SNEXT; Key_Shift_Next_Page : Special_Key_Code renames KEY_SNEXT; KEY_SOPTIONS : constant Special_Key_Code := Curses_Constants.KEY_SOPTIONS; Key_Shift_Options : Special_Key_Code renames KEY_SOPTIONS; KEY_SPREVIOUS : constant Special_Key_Code := Curses_Constants.KEY_SPREVIOUS; Key_Shift_Previous_Page : Special_Key_Code renames KEY_SPREVIOUS; KEY_SPRINT : constant Special_Key_Code := Curses_Constants.KEY_SPRINT; Key_Shift_Print : Special_Key_Code renames KEY_SPRINT; KEY_SREDO : constant Special_Key_Code := Curses_Constants.KEY_SREDO; Key_Shift_Redo : Special_Key_Code renames KEY_SREDO; KEY_SREPLACE : constant Special_Key_Code := Curses_Constants.KEY_SREPLACE; Key_Shift_Replace : Special_Key_Code renames KEY_SREPLACE; KEY_SRIGHT : constant Special_Key_Code := Curses_Constants.KEY_SRIGHT; Key_Shift_Cursor_Right : Special_Key_Code renames KEY_SRIGHT; KEY_SRSUME : constant Special_Key_Code := Curses_Constants.KEY_SRSUME; Key_Shift_Resume : Special_Key_Code renames KEY_SRSUME; KEY_SSAVE : constant Special_Key_Code := Curses_Constants.KEY_SSAVE; Key_Shift_Save : Special_Key_Code renames KEY_SSAVE; KEY_SSUSPEND : constant Special_Key_Code := Curses_Constants.KEY_SSUSPEND; Key_Shift_Suspend : Special_Key_Code renames KEY_SSUSPEND; KEY_SUNDO : constant Special_Key_Code := Curses_Constants.KEY_SUNDO; Key_Shift_Undo : Special_Key_Code renames KEY_SUNDO; Key_Suspend : constant Special_Key_Code := Curses_Constants.KEY_SUSPEND; Key_Undo : constant Special_Key_Code := Curses_Constants.KEY_UNDO; Key_Mouse : constant Special_Key_Code := Curses_Constants.KEY_MOUSE; Key_Resize : constant Special_Key_Code := Curses_Constants.KEY_RESIZE; Key_Max : constant Special_Key_Code := Special_Key_Code'Last; subtype User_Key_Code is Key_Code range (Key_Max + 129) .. Key_Code'Last; -- This is reserved for user defined key codes. The range between Key_Max -- and the first user code is reserved for subsystems like menu and forms. -------------------------------------------------------------------------- type Color_Number is range -1 .. Integer (Interfaces.C.short'Last); for Color_Number'Size use Interfaces.C.short'Size; -- (n)curses uses a short for the color index -- The model is, that a Color_Number is an index into an array of -- (potentially) definable colors. Some of those indices are -- predefined (see below), although they may not really exist. Black : constant Color_Number := Curses_Constants.COLOR_BLACK; Red : constant Color_Number := Curses_Constants.COLOR_RED; Green : constant Color_Number := Curses_Constants.COLOR_GREEN; Yellow : constant Color_Number := Curses_Constants.COLOR_YELLOW; Blue : constant Color_Number := Curses_Constants.COLOR_BLUE; Magenta : constant Color_Number := Curses_Constants.COLOR_MAGENTA; Cyan : constant Color_Number := Curses_Constants.COLOR_CYAN; White : constant Color_Number := Curses_Constants.COLOR_WHITE; type RGB_Value is range 0 .. Integer (Interfaces.C.short'Last); for RGB_Value'Size use Interfaces.C.short'Size; -- Some system may allow to redefine a color by setting RGB values. type Color_Pair is range 0 .. 255; for Color_Pair'Size use 8; subtype Redefinable_Color_Pair is Color_Pair range 1 .. 255; -- (n)curses reserves 1 Byte for the color-pair number. Color Pair 0 -- is fixed (Black & White). A color pair is simply a combination of -- two colors described by Color_Numbers, one for the foreground and -- the other for the background type Character_Attribute_Set is record Stand_Out : Boolean; Under_Line : Boolean; Reverse_Video : Boolean; Blink : Boolean; Dim_Character : Boolean; Bold_Character : Boolean; Protected_Character : Boolean; Invisible_Character : Boolean; Alternate_Character_Set : Boolean; Horizontal : Boolean; Left : Boolean; Low : Boolean; Right : Boolean; Top : Boolean; Vertical : Boolean; end record; for Character_Attribute_Set use record Stand_Out at 0 range Curses_Constants.A_STANDOUT_First - Curses_Constants.Attr_First .. Curses_Constants.A_STANDOUT_Last - Curses_Constants.Attr_First; Under_Line at 0 range Curses_Constants.A_UNDERLINE_First - Curses_Constants.Attr_First .. Curses_Constants.A_UNDERLINE_Last - Curses_Constants.Attr_First; Reverse_Video at 0 range Curses_Constants.A_REVERSE_First - Curses_Constants.Attr_First .. Curses_Constants.A_REVERSE_Last - Curses_Constants.Attr_First; Blink at 0 range Curses_Constants.A_BLINK_First - Curses_Constants.Attr_First .. Curses_Constants.A_BLINK_Last - Curses_Constants.Attr_First; Dim_Character at 0 range Curses_Constants.A_DIM_First - Curses_Constants.Attr_First .. Curses_Constants.A_DIM_Last - Curses_Constants.Attr_First; Bold_Character at 0 range Curses_Constants.A_BOLD_First - Curses_Constants.Attr_First .. Curses_Constants.A_BOLD_Last - Curses_Constants.Attr_First; Protected_Character at 0 range Curses_Constants.A_PROTECT_First - Curses_Constants.Attr_First .. Curses_Constants.A_PROTECT_Last - Curses_Constants.Attr_First; Invisible_Character at 0 range Curses_Constants.A_INVIS_First - Curses_Constants.Attr_First .. Curses_Constants.A_INVIS_Last - Curses_Constants.Attr_First; Alternate_Character_Set at 0 range Curses_Constants.A_ALTCHARSET_First - Curses_Constants.Attr_First .. Curses_Constants.A_ALTCHARSET_Last - Curses_Constants.Attr_First; Horizontal at 0 range Curses_Constants.A_HORIZONTAL_First - Curses_Constants.Attr_First .. Curses_Constants.A_HORIZONTAL_Last - Curses_Constants.Attr_First; Left at 0 range Curses_Constants.A_LEFT_First - Curses_Constants.Attr_First .. Curses_Constants.A_LEFT_Last - Curses_Constants.Attr_First; Low at 0 range Curses_Constants.A_LOW_First - Curses_Constants.Attr_First .. Curses_Constants.A_LOW_Last - Curses_Constants.Attr_First; Right at 0 range Curses_Constants.A_RIGHT_First - Curses_Constants.Attr_First .. Curses_Constants.A_RIGHT_Last - Curses_Constants.Attr_First; Top at 0 range Curses_Constants.A_TOP_First - Curses_Constants.Attr_First .. Curses_Constants.A_TOP_Last - Curses_Constants.Attr_First; Vertical at 0 range Curses_Constants.A_VERTICAL_First - Curses_Constants.Attr_First .. Curses_Constants.A_VERTICAL_Last - Curses_Constants.Attr_First; end record; Normal_Video : constant Character_Attribute_Set := (others => False); type Attributed_Character is record Attr : Character_Attribute_Set; Color : Color_Pair; Ch : Character; end record; pragma Convention (C_Pass_By_Copy, Attributed_Character); -- This is the counterpart for the chtype in C. for Attributed_Character use record Ch at 0 range Curses_Constants.A_CHARTEXT_First .. Curses_Constants.A_CHARTEXT_Last; Color at 0 range Curses_Constants.A_COLOR_First .. Curses_Constants.A_COLOR_Last; pragma Warnings (Off); Attr at 0 range Curses_Constants.Attr_First .. Curses_Constants.Attr_Last; pragma Warnings (On); end record; for Attributed_Character'Size use Curses_Constants.chtype_Size; Default_Character : constant Attributed_Character := (Ch => Character'First, Color => Color_Pair'First, Attr => (others => False)); -- preelaboratable Normal_Video type Attributed_String is array (Positive range <>) of Attributed_Character; pragma Convention (C, Attributed_String); -- In this binding we allow strings of attributed characters. ------------------ -- Exceptions -- ------------------ Curses_Exception : exception; Wrong_Curses_Version : exception; -- Those exceptions are raised by the ETI (Extended Terminal Interface) -- subpackets for Menu and Forms handling. -- Eti_System_Error : exception; Eti_Bad_Argument : exception; Eti_Posted : exception; Eti_Connected : exception; Eti_Bad_State : exception; Eti_No_Room : exception; Eti_Not_Posted : exception; Eti_Unknown_Command : exception; Eti_No_Match : exception; Eti_Not_Selectable : exception; Eti_Not_Connected : exception; Eti_Request_Denied : exception; Eti_Invalid_Field : exception; Eti_Current : exception; -------------------------------------------------------------------------- -- External C variables -- Conceptually even in C this are kind of constants, but they are -- initialized and sometimes changed by the library routines at runtime -- depending on the type of terminal. I believe the best way to model -- this is to use functions. -------------------------------------------------------------------------- function Lines return Line_Count; pragma Inline (Lines); function Columns return Column_Count; pragma Inline (Columns); function Tab_Size return Natural; pragma Inline (Tab_Size); function Number_Of_Colors return Natural; pragma Inline (Number_Of_Colors); function Number_Of_Color_Pairs return Natural; pragma Inline (Number_Of_Color_Pairs); subtype ACS_Index is Character range Character'Val (0) .. Character'Val (127); function ACS_Map (Index : ACS_Index) return Attributed_Character; pragma Import (C, ACS_Map, "acs_map_as_function"); -- Constants for several characters from the Alternate Character Set -- You must use these constants as indices into the ACS_Map function -- to get the corresponding attributed character at runtime ACS_Upper_Left_Corner : constant ACS_Index := Character'Val (Curses_Constants.ACS_ULCORNER); ACS_Lower_Left_Corner : constant ACS_Index := Character'Val (Curses_Constants.ACS_LLCORNER); ACS_Upper_Right_Corner : constant ACS_Index := Character'Val (Curses_Constants.ACS_URCORNER); ACS_Lower_Right_Corner : constant ACS_Index := Character'Val (Curses_Constants.ACS_LRCORNER); ACS_Left_Tee : constant ACS_Index := Character'Val (Curses_Constants.ACS_LTEE); ACS_Right_Tee : constant ACS_Index := Character'Val (Curses_Constants.ACS_RTEE); ACS_Bottom_Tee : constant ACS_Index := Character'Val (Curses_Constants.ACS_BTEE); ACS_Top_Tee : constant ACS_Index := Character'Val (Curses_Constants.ACS_TTEE); ACS_Horizontal_Line : constant ACS_Index := Character'Val (Curses_Constants.ACS_HLINE); ACS_Vertical_Line : constant ACS_Index := Character'Val (Curses_Constants.ACS_VLINE); ACS_Plus_Symbol : constant ACS_Index := Character'Val (Curses_Constants.ACS_PLUS); ACS_Scan_Line_1 : constant ACS_Index := Character'Val (Curses_Constants.ACS_S1); ACS_Scan_Line_9 : constant ACS_Index := Character'Val (Curses_Constants.ACS_S9); ACS_Diamond : constant ACS_Index := Character'Val (Curses_Constants.ACS_DIAMOND); ACS_Checker_Board : constant ACS_Index := Character'Val (Curses_Constants.ACS_CKBOARD); ACS_Degree : constant ACS_Index := Character'Val (Curses_Constants.ACS_DEGREE); ACS_Plus_Minus : constant ACS_Index := Character'Val (Curses_Constants.ACS_PLMINUS); ACS_Bullet : constant ACS_Index := Character'Val (Curses_Constants.ACS_BULLET); ACS_Left_Arrow : constant ACS_Index := Character'Val (Curses_Constants.ACS_LARROW); ACS_Right_Arrow : constant ACS_Index := Character'Val (Curses_Constants.ACS_RARROW); ACS_Down_Arrow : constant ACS_Index := Character'Val (Curses_Constants.ACS_DARROW); ACS_Up_Arrow : constant ACS_Index := Character'Val (Curses_Constants.ACS_UARROW); ACS_Board_Of_Squares : constant ACS_Index := Character'Val (Curses_Constants.ACS_BOARD); ACS_Lantern : constant ACS_Index := Character'Val (Curses_Constants.ACS_LANTERN); ACS_Solid_Block : constant ACS_Index := Character'Val (Curses_Constants.ACS_BLOCK); ACS_Scan_Line_3 : constant ACS_Index := Character'Val (Curses_Constants.ACS_S3); ACS_Scan_Line_7 : constant ACS_Index := Character'Val (Curses_Constants.ACS_S7); ACS_Less_Or_Equal : constant ACS_Index := Character'Val (Curses_Constants.ACS_LEQUAL); ACS_Greater_Or_Equal : constant ACS_Index := Character'Val (Curses_Constants.ACS_GEQUAL); ACS_PI : constant ACS_Index := Character'Val (Curses_Constants.ACS_PI); ACS_Not_Equal : constant ACS_Index := Character'Val (Curses_Constants.ACS_NEQUAL); ACS_Sterling : constant ACS_Index := Character'Val (Curses_Constants.ACS_STERLING); -- |===================================================================== -- | Man page curs_initscr.3x -- |===================================================================== -- | Not implemented: newterm, set_term, delscreen -- | function Standard_Window return Window; -- AKA: stdscr pragma Import (C, Standard_Window, "stdscr_as_function"); pragma Inline (Standard_Window); -- | function Current_Window return Window; -- AKA: curscr pragma Import (C, Current_Window, "curscr_as_function"); pragma Inline (Current_Window); -- | procedure Init_Screen; -- | procedure Init_Windows renames Init_Screen; -- AKA: initscr() pragma Inline (Init_Screen); -- pragma Inline (Init_Windows); -- | procedure End_Windows; -- AKA: endwin() procedure End_Screen renames End_Windows; pragma Inline (End_Windows); -- pragma Inline (End_Screen); -- | function Is_End_Window return Boolean; -- AKA: isendwin() pragma Inline (Is_End_Window); -- |===================================================================== -- | Man page curs_move.3x -- |===================================================================== -- | procedure Move_Cursor (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position); -- AKA: wmove() -- AKA: move() pragma Inline (Move_Cursor); -- |===================================================================== -- | Man page curs_addch.3x -- |===================================================================== -- | procedure Add (Win : Window := Standard_Window; Ch : Attributed_Character); -- AKA: waddch() -- AKA: addch() procedure Add (Win : Window := Standard_Window; Ch : Character); -- Add a single character at the current logical cursor position to -- the window. Use the current windows attributes. -- | procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Ch : Attributed_Character); -- AKA: mvwaddch() -- AKA: mvaddch() procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Ch : Character); -- Move to the position and add a single character into the window -- There are more Add routines, so the Inline pragma follows later -- | procedure Add_With_Immediate_Echo (Win : Window := Standard_Window; Ch : Attributed_Character); -- AKA: wechochar() -- AKA: echochar() procedure Add_With_Immediate_Echo (Win : Window := Standard_Window; Ch : Character); -- Add a character and do an immediate refresh of the screen. pragma Inline (Add_With_Immediate_Echo); -- |===================================================================== -- | Man page curs_window.3x -- |===================================================================== -- Not Implemented: wcursyncup -- | function Create (Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window; -- Not Implemented: Default Number_Of_Lines, Number_Of_Columns -- the C version lets them be 0, see the man page. -- AKA: newwin() pragma Inline (Create); function New_Window (Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window renames Create; -- pragma Inline (New_Window); -- | procedure Delete (Win : in out Window); -- AKA: delwin() -- Reset Win to Null_Window pragma Inline (Delete); -- | function Sub_Window (Win : Window := Standard_Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window; -- AKA: subwin() pragma Inline (Sub_Window); -- | function Derived_Window (Win : Window := Standard_Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window; -- AKA: derwin() pragma Inline (Derived_Window); -- | function Duplicate (Win : Window) return Window; -- AKA: dupwin() pragma Inline (Duplicate); -- | procedure Move_Window (Win : Window; Line : Line_Position; Column : Column_Position); -- AKA: mvwin() pragma Inline (Move_Window); -- | procedure Move_Derived_Window (Win : Window; Line : Line_Position; Column : Column_Position); -- AKA: mvderwin() pragma Inline (Move_Derived_Window); -- | procedure Synchronize_Upwards (Win : Window); -- AKA: wsyncup() pragma Import (C, Synchronize_Upwards, "wsyncup"); -- | procedure Synchronize_Downwards (Win : Window); -- AKA: wsyncdown() pragma Import (C, Synchronize_Downwards, "wsyncdown"); -- | procedure Set_Synch_Mode (Win : Window := Standard_Window; Mode : Boolean := False); -- AKA: syncok() pragma Inline (Set_Synch_Mode); -- |===================================================================== -- | Man page curs_addstr.3x -- |===================================================================== -- | procedure Add (Win : Window := Standard_Window; Str : String; Len : Integer := -1); -- AKA: waddnstr() -- AKA: waddstr() -- AKA: addnstr() -- AKA: addstr() -- | procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : String; Len : Integer := -1); -- AKA: mvwaddnstr() -- AKA: mvwaddstr() -- AKA: mvaddnstr() -- AKA: mvaddstr() -- |===================================================================== -- | Man page curs_addchstr.3x -- |===================================================================== -- | procedure Add (Win : Window := Standard_Window; Str : Attributed_String; Len : Integer := -1); -- AKA: waddchnstr() -- AKA: waddchstr() -- AKA: addchnstr() -- AKA: addchstr() -- | procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : Attributed_String; Len : Integer := -1); -- AKA: mvwaddchnstr() -- AKA: mvwaddchstr() -- AKA: mvaddchnstr() -- AKA: mvaddchstr() pragma Inline (Add); -- |===================================================================== -- | Man page curs_border.3x -- |===================================================================== -- | Not implemented: mvhline, mvwhline, mvvline, mvwvline -- | use Move_Cursor then Horizontal_Line or Vertical_Line -- | procedure Border (Win : Window := Standard_Window; Left_Side_Symbol : Attributed_Character := Default_Character; Right_Side_Symbol : Attributed_Character := Default_Character; Top_Side_Symbol : Attributed_Character := Default_Character; Bottom_Side_Symbol : Attributed_Character := Default_Character; Upper_Left_Corner_Symbol : Attributed_Character := Default_Character; Upper_Right_Corner_Symbol : Attributed_Character := Default_Character; Lower_Left_Corner_Symbol : Attributed_Character := Default_Character; Lower_Right_Corner_Symbol : Attributed_Character := Default_Character ); -- AKA: wborder() -- AKA: border() pragma Inline (Border); -- | procedure Box (Win : Window := Standard_Window; Vertical_Symbol : Attributed_Character := Default_Character; Horizontal_Symbol : Attributed_Character := Default_Character); -- AKA: box() pragma Inline (Box); -- | procedure Horizontal_Line (Win : Window := Standard_Window; Line_Size : Natural; Line_Symbol : Attributed_Character := Default_Character); -- AKA: whline() -- AKA: hline() pragma Inline (Horizontal_Line); -- | procedure Vertical_Line (Win : Window := Standard_Window; Line_Size : Natural; Line_Symbol : Attributed_Character := Default_Character); -- AKA: wvline() -- AKA: vline() pragma Inline (Vertical_Line); -- |===================================================================== -- | Man page curs_getch.3x -- |===================================================================== -- Not implemented: mvgetch, mvwgetch -- | function Get_Keystroke (Win : Window := Standard_Window) return Real_Key_Code; -- AKA: wgetch() -- AKA: getch() -- Get a character from the keyboard and echo it - if enabled - to the -- window. -- If for any reason (i.e. a timeout) we could not get a character the -- returned keycode is Key_None. pragma Inline (Get_Keystroke); -- | procedure Undo_Keystroke (Key : Real_Key_Code); -- AKA: ungetch() pragma Inline (Undo_Keystroke); -- | function Has_Key (Key : Special_Key_Code) return Boolean; -- AKA: has_key() pragma Inline (Has_Key); -- | -- | Some helper functions -- | function Is_Function_Key (Key : Special_Key_Code) return Boolean; -- Return True if the Key is a function key (i.e. one of F0 .. F63) pragma Inline (Is_Function_Key); subtype Function_Key_Number is Integer range 0 .. 63; -- (n)curses allows for 64 function keys. function Function_Key (Key : Real_Key_Code) return Function_Key_Number; -- Return the number of the function key. If the code is not a -- function key, a CONSTRAINT_ERROR will be raised. pragma Inline (Function_Key); function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code; -- Return the key code for a given function-key number. pragma Inline (Function_Key_Code); -- |===================================================================== -- | Man page curs_attr.3x -- |===================================================================== -- | Not implemented attr_off, wattr_off, -- | attr_on, wattr_on, attr_set, wattr_set -- PAIR_NUMBER -- PAIR_NUMBER(c) is the same as c.Color -- | procedure Standout (Win : Window := Standard_Window; On : Boolean := True); -- AKA: wstandout() -- AKA: wstandend() -- | procedure Switch_Character_Attribute (Win : Window := Standard_Window; Attr : Character_Attribute_Set := Normal_Video; On : Boolean := True); -- if False we switch Off. -- Switches those Attributes set to true in the list. -- AKA: wattron() -- AKA: wattroff() -- AKA: attron() -- AKA: attroff() -- | procedure Set_Character_Attributes (Win : Window := Standard_Window; Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: wattrset() -- AKA: attrset() pragma Inline (Set_Character_Attributes); -- | function Get_Character_Attribute (Win : Window := Standard_Window) return Character_Attribute_Set; -- AKA: wattr_get() -- AKA: attr_get() -- | function Get_Character_Attribute (Win : Window := Standard_Window) return Color_Pair; -- AKA: wattr_get() pragma Inline (Get_Character_Attribute); -- | procedure Set_Color (Win : Window := Standard_Window; Pair : Color_Pair); -- AKA: wcolor_set() -- AKA: color_set() pragma Inline (Set_Color); -- | procedure Change_Attributes (Win : Window := Standard_Window; Count : Integer := -1; Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: wchgat() -- AKA: chgat() -- | procedure Change_Attributes (Win : Window := Standard_Window; Line : Line_Position := Line_Position'First; Column : Column_Position := Column_Position'First; Count : Integer := -1; Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: mvwchgat() -- AKA: mvchgat() pragma Inline (Change_Attributes); -- |===================================================================== -- | Man page curs_beep.3x -- |===================================================================== -- | procedure Beep; -- AKA: beep() pragma Inline (Beep); -- | procedure Flash_Screen; -- AKA: flash() pragma Inline (Flash_Screen); -- |===================================================================== -- | Man page curs_inopts.3x -- |===================================================================== -- | Not implemented : typeahead -- -- | procedure Set_Cbreak_Mode (SwitchOn : Boolean := True); -- AKA: cbreak() -- AKA: nocbreak() pragma Inline (Set_Cbreak_Mode); -- | procedure Set_Raw_Mode (SwitchOn : Boolean := True); -- AKA: raw() -- AKA: noraw() pragma Inline (Set_Raw_Mode); -- | procedure Set_Echo_Mode (SwitchOn : Boolean := True); -- AKA: echo() -- AKA: noecho() pragma Inline (Set_Echo_Mode); -- | procedure Set_Meta_Mode (Win : Window := Standard_Window; SwitchOn : Boolean := True); -- AKA: meta() pragma Inline (Set_Meta_Mode); -- | procedure Set_KeyPad_Mode (Win : Window := Standard_Window; SwitchOn : Boolean := True); -- AKA: keypad() pragma Inline (Set_KeyPad_Mode); function Get_KeyPad_Mode (Win : Window := Standard_Window) return Boolean; -- This has no pendant in C. There you've to look into the WINDOWS -- structure to get the value. Bad practice, not repeated in Ada. type Half_Delay_Amount is range 1 .. 255; -- | procedure Half_Delay (Amount : Half_Delay_Amount); -- AKA: halfdelay() pragma Inline (Half_Delay); -- | procedure Set_Flush_On_Interrupt_Mode (Win : Window := Standard_Window; Mode : Boolean := True); -- AKA: intrflush() pragma Inline (Set_Flush_On_Interrupt_Mode); -- | procedure Set_Queue_Interrupt_Mode (Win : Window := Standard_Window; Flush : Boolean := True); -- AKA: qiflush() -- AKA: noqiflush() pragma Inline (Set_Queue_Interrupt_Mode); -- | procedure Set_NoDelay_Mode (Win : Window := Standard_Window; Mode : Boolean := False); -- AKA: nodelay() pragma Inline (Set_NoDelay_Mode); type Timeout_Mode is (Blocking, Non_Blocking, Delayed); -- | procedure Set_Timeout_Mode (Win : Window := Standard_Window; Mode : Timeout_Mode; Amount : Natural); -- in Milliseconds -- AKA: wtimeout() -- AKA: timeout() -- Instead of overloading the semantic of the sign of amount, we -- introduce the Timeout_Mode parameter. This should improve -- readability. For Blocking and Non_Blocking, the Amount is not -- evaluated. -- We do not inline this procedure. -- | procedure Set_Escape_Timer_Mode (Win : Window := Standard_Window; Timer_Off : Boolean := False); -- AKA: notimeout() pragma Inline (Set_Escape_Timer_Mode); -- |===================================================================== -- | Man page curs_outopts.3x -- |===================================================================== -- | procedure Set_NL_Mode (SwitchOn : Boolean := True); -- AKA: nl() -- AKA: nonl() pragma Inline (Set_NL_Mode); -- | procedure Clear_On_Next_Update (Win : Window := Standard_Window; Do_Clear : Boolean := True); -- AKA: clearok() pragma Inline (Clear_On_Next_Update); -- | procedure Use_Insert_Delete_Line (Win : Window := Standard_Window; Do_Idl : Boolean := True); -- AKA: idlok() pragma Inline (Use_Insert_Delete_Line); -- | procedure Use_Insert_Delete_Character (Win : Window := Standard_Window; Do_Idc : Boolean := True); -- AKA: idcok() pragma Inline (Use_Insert_Delete_Character); -- | procedure Leave_Cursor_After_Update (Win : Window := Standard_Window; Do_Leave : Boolean := True); -- AKA: leaveok() pragma Inline (Leave_Cursor_After_Update); -- | procedure Immediate_Update_Mode (Win : Window := Standard_Window; Mode : Boolean := False); -- AKA: immedok() pragma Inline (Immediate_Update_Mode); -- | procedure Allow_Scrolling (Win : Window := Standard_Window; Mode : Boolean := False); -- AKA: scrollok() pragma Inline (Allow_Scrolling); function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean; -- There is no such function in the C interface. pragma Inline (Scrolling_Allowed); -- | procedure Set_Scroll_Region (Win : Window := Standard_Window; Top_Line : Line_Position; Bottom_Line : Line_Position); -- AKA: wsetscrreg() -- AKA: setscrreg() pragma Inline (Set_Scroll_Region); -- |===================================================================== -- | Man page curs_refresh.3x -- |===================================================================== -- | procedure Update_Screen; -- AKA: doupdate() pragma Inline (Update_Screen); -- | procedure Refresh (Win : Window := Standard_Window); -- AKA: wrefresh() -- There is an overloaded Refresh for Pads. -- The Inline pragma appears there -- AKA: refresh() -- | procedure Refresh_Without_Update (Win : Window := Standard_Window); -- AKA: wnoutrefresh() -- There is an overloaded Refresh_Without_Update for Pads. -- The Inline pragma appears there -- | procedure Redraw (Win : Window := Standard_Window); -- AKA: redrawwin() -- | procedure Redraw (Win : Window := Standard_Window; Begin_Line : Line_Position; Line_Count : Positive); -- AKA: wredrawln() pragma Inline (Redraw); -- |===================================================================== -- | Man page curs_clear.3x -- |===================================================================== -- | procedure Erase (Win : Window := Standard_Window); -- AKA: werase() -- AKA: erase() pragma Inline (Erase); -- | procedure Clear (Win : Window := Standard_Window); -- AKA: wclear() -- AKA: clear() pragma Inline (Clear); -- | procedure Clear_To_End_Of_Screen (Win : Window := Standard_Window); -- AKA: wclrtobot() -- AKA: clrtobot() pragma Inline (Clear_To_End_Of_Screen); -- | procedure Clear_To_End_Of_Line (Win : Window := Standard_Window); -- AKA: wclrtoeol() -- AKA: clrtoeol() pragma Inline (Clear_To_End_Of_Line); -- |===================================================================== -- | Man page curs_bkgd.3x -- |===================================================================== -- | -- TODO: we could have Set_Background(Window; Character_Attribute_Set) -- because in C it is common to see bkgdset(A_BOLD) or -- bkgdset(COLOR_PAIR(n)) procedure Set_Background (Win : Window := Standard_Window; Ch : Attributed_Character); -- AKA: wbkgdset() -- AKA: bkgdset() pragma Inline (Set_Background); -- | procedure Change_Background (Win : Window := Standard_Window; Ch : Attributed_Character); -- AKA: wbkgd() -- AKA: bkgd() pragma Inline (Change_Background); -- | -- ? wbkgdget is not listed in curs_bkgd, getbkgd is thpough. function Get_Background (Win : Window := Standard_Window) return Attributed_Character; -- AKA: wbkgdget() -- AKA: bkgdget() pragma Inline (Get_Background); -- |===================================================================== -- | Man page curs_touch.3x -- |===================================================================== -- | procedure Untouch (Win : Window := Standard_Window); -- AKA: untouchwin() pragma Inline (Untouch); -- | procedure Touch (Win : Window := Standard_Window); -- AKA: touchwin() -- | procedure Touch (Win : Window := Standard_Window; Start : Line_Position; Count : Positive); -- AKA: touchline() pragma Inline (Touch); -- | procedure Change_Lines_Status (Win : Window := Standard_Window; Start : Line_Position; Count : Positive; State : Boolean); -- AKA: wtouchln() pragma Inline (Change_Lines_Status); -- | function Is_Touched (Win : Window := Standard_Window; Line : Line_Position) return Boolean; -- AKA: is_linetouched() -- | function Is_Touched (Win : Window := Standard_Window) return Boolean; -- AKA: is_wintouched() pragma Inline (Is_Touched); -- |===================================================================== -- | Man page curs_overlay.3x -- |===================================================================== -- | procedure Copy (Source_Window : Window; Destination_Window : Window; Source_Top_Row : Line_Position; Source_Left_Column : Column_Position; Destination_Top_Row : Line_Position; Destination_Left_Column : Column_Position; Destination_Bottom_Row : Line_Position; Destination_Right_Column : Column_Position; Non_Destructive_Mode : Boolean := True); -- AKA: copywin() pragma Inline (Copy); -- | procedure Overwrite (Source_Window : Window; Destination_Window : Window); -- AKA: overwrite() pragma Inline (Overwrite); -- | procedure Overlay (Source_Window : Window; Destination_Window : Window); -- AKA: overlay() pragma Inline (Overlay); -- |===================================================================== -- | Man page curs_deleteln.3x -- |===================================================================== -- | procedure Insert_Delete_Lines (Win : Window := Standard_Window; Lines : Integer := 1); -- default is to insert one line above -- AKA: winsdelln() -- AKA: insdelln() pragma Inline (Insert_Delete_Lines); -- | procedure Delete_Line (Win : Window := Standard_Window); -- AKA: wdeleteln() -- AKA: deleteln() pragma Inline (Delete_Line); -- | procedure Insert_Line (Win : Window := Standard_Window); -- AKA: winsertln() -- AKA: insertln() pragma Inline (Insert_Line); -- |===================================================================== -- | Man page curs_getyx.3x -- |===================================================================== -- | procedure Get_Size (Win : Window := Standard_Window; Number_Of_Lines : out Line_Count; Number_Of_Columns : out Column_Count); -- AKA: getmaxyx() pragma Inline (Get_Size); -- | procedure Get_Window_Position (Win : Window := Standard_Window; Top_Left_Line : out Line_Position; Top_Left_Column : out Column_Position); -- AKA: getbegyx() pragma Inline (Get_Window_Position); -- | procedure Get_Cursor_Position (Win : Window := Standard_Window; Line : out Line_Position; Column : out Column_Position); -- AKA: getyx() pragma Inline (Get_Cursor_Position); -- | procedure Get_Origin_Relative_To_Parent (Win : Window; Top_Left_Line : out Line_Position; Top_Left_Column : out Column_Position; Is_Not_A_Subwindow : out Boolean); -- AKA: getparyx() -- Instead of placing -1 in the coordinates as return, we use a Boolean -- to return the info that the window has no parent. pragma Inline (Get_Origin_Relative_To_Parent); -- |===================================================================== -- | Man page curs_pad.3x -- |===================================================================== -- | function New_Pad (Lines : Line_Count; Columns : Column_Count) return Window; -- AKA: newpad() pragma Inline (New_Pad); -- | function Sub_Pad (Pad : Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window; -- AKA: subpad() pragma Inline (Sub_Pad); -- | procedure Refresh (Pad : Window; Source_Top_Row : Line_Position; Source_Left_Column : Column_Position; Destination_Top_Row : Line_Position; Destination_Left_Column : Column_Position; Destination_Bottom_Row : Line_Position; Destination_Right_Column : Column_Position); -- AKA: prefresh() pragma Inline (Refresh); -- | procedure Refresh_Without_Update (Pad : Window; Source_Top_Row : Line_Position; Source_Left_Column : Column_Position; Destination_Top_Row : Line_Position; Destination_Left_Column : Column_Position; Destination_Bottom_Row : Line_Position; Destination_Right_Column : Column_Position); -- AKA: pnoutrefresh() pragma Inline (Refresh_Without_Update); -- | procedure Add_Character_To_Pad_And_Echo_It (Pad : Window; Ch : Attributed_Character); -- AKA: pechochar() procedure Add_Character_To_Pad_And_Echo_It (Pad : Window; Ch : Character); pragma Inline (Add_Character_To_Pad_And_Echo_It); -- |===================================================================== -- | Man page curs_scroll.3x -- |===================================================================== -- | procedure Scroll (Win : Window := Standard_Window; Amount : Integer := 1); -- AKA: wscrl() -- AKA: scroll() -- AKA: scrl() pragma Inline (Scroll); -- |===================================================================== -- | Man page curs_delch.3x -- |===================================================================== -- | procedure Delete_Character (Win : Window := Standard_Window); -- AKA: wdelch() -- AKA: delch() -- | procedure Delete_Character (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position); -- AKA: mvwdelch() -- AKA: mvdelch() pragma Inline (Delete_Character); -- |===================================================================== -- | Man page curs_inch.3x -- |===================================================================== -- | function Peek (Win : Window := Standard_Window) return Attributed_Character; -- AKA: inch() -- AKA: winch() -- | function Peek (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position) return Attributed_Character; -- AKA: mvwinch() -- AKA: mvinch() -- More Peek's follow, pragma Inline appears later. -- |===================================================================== -- | Man page curs_insch.3x -- |===================================================================== -- | procedure Insert (Win : Window := Standard_Window; Ch : Attributed_Character); -- AKA: winsch() -- AKA: insch() -- | procedure Insert (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Ch : Attributed_Character); -- AKA: mvwinsch() -- AKA: mvinsch() -- |===================================================================== -- | Man page curs_insstr.3x -- |===================================================================== -- | procedure Insert (Win : Window := Standard_Window; Str : String; Len : Integer := -1); -- AKA: winsnstr() -- AKA: winsstr() -- AKA: insnstr() -- AKA: insstr() -- | procedure Insert (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : String; Len : Integer := -1); -- AKA: mvwinsnstr() -- AKA: mvwinsstr() -- AKA: mvinsnstr() -- AKA: mvinsstr() pragma Inline (Insert); -- |===================================================================== -- | Man page curs_instr.3x -- |===================================================================== -- | procedure Peek (Win : Window := Standard_Window; Str : out String; Len : Integer := -1); -- AKA: winnstr() -- AKA: winstr() -- AKA: innstr() -- AKA: instr() -- | procedure Peek (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : out String; Len : Integer := -1); -- AKA: mvwinnstr() -- AKA: mvwinstr() -- AKA: mvinnstr() -- AKA: mvinstr() -- |===================================================================== -- | Man page curs_inchstr.3x -- |===================================================================== -- | procedure Peek (Win : Window := Standard_Window; Str : out Attributed_String; Len : Integer := -1); -- AKA: winchnstr() -- AKA: winchstr() -- AKA: inchnstr() -- AKA: inchstr() -- | procedure Peek (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : out Attributed_String; Len : Integer := -1); -- AKA: mvwinchnstr() -- AKA: mvwinchstr() -- AKA: mvinchnstr() -- AKA: mvinchstr() -- We do not inline the Peek procedures -- |===================================================================== -- | Man page curs_getstr.3x -- |===================================================================== -- | procedure Get (Win : Window := Standard_Window; Str : out String; Len : Integer := -1); -- AKA: wgetnstr() -- AKA: wgetstr() -- AKA: getnstr() -- AKA: getstr() -- actually getstr is not supported because that results in buffer -- overflows. -- | procedure Get (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : out String; Len : Integer := -1); -- AKA: mvwgetnstr() -- AKA: mvwgetstr() -- AKA: mvgetnstr() -- AKA: mvgetstr() -- Get is not inlined -- |===================================================================== -- | Man page curs_slk.3x -- |===================================================================== -- Not Implemented: slk_attr_on, slk_attr_off, slk_attr_set type Soft_Label_Key_Format is (Three_Two_Three, Four_Four, PC_Style, -- ncurses specific PC_Style_With_Index); -- " type Label_Number is new Positive range 1 .. 12; type Label_Justification is (Left, Centered, Right); -- | procedure Init_Soft_Label_Keys (Format : Soft_Label_Key_Format := Three_Two_Three); -- AKA: slk_init() pragma Inline (Init_Soft_Label_Keys); -- | procedure Set_Soft_Label_Key (Label : Label_Number; Text : String; Fmt : Label_Justification := Left); -- AKA: slk_set() -- We do not inline this procedure -- | procedure Refresh_Soft_Label_Keys; -- AKA: slk_refresh() pragma Inline (Refresh_Soft_Label_Keys); -- | procedure Refresh_Soft_Label_Keys_Without_Update; -- AKA: slk_noutrefresh() pragma Inline (Refresh_Soft_Label_Keys_Without_Update); -- | procedure Get_Soft_Label_Key (Label : Label_Number; Text : out String); -- AKA: slk_label() -- | function Get_Soft_Label_Key (Label : Label_Number) return String; -- AKA: slk_label() -- Same as function pragma Inline (Get_Soft_Label_Key); -- | procedure Clear_Soft_Label_Keys; -- AKA: slk_clear() pragma Inline (Clear_Soft_Label_Keys); -- | procedure Restore_Soft_Label_Keys; -- AKA: slk_restore() pragma Inline (Restore_Soft_Label_Keys); -- | procedure Touch_Soft_Label_Keys; -- AKA: slk_touch() pragma Inline (Touch_Soft_Label_Keys); -- | procedure Switch_Soft_Label_Key_Attributes (Attr : Character_Attribute_Set; On : Boolean := True); -- AKA: slk_attron() -- AKA: slk_attroff() pragma Inline (Switch_Soft_Label_Key_Attributes); -- | procedure Set_Soft_Label_Key_Attributes (Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: slk_attrset() pragma Inline (Set_Soft_Label_Key_Attributes); -- | function Get_Soft_Label_Key_Attributes return Character_Attribute_Set; -- AKA: slk_attr() -- | function Get_Soft_Label_Key_Attributes return Color_Pair; -- AKA: slk_attr() pragma Inline (Get_Soft_Label_Key_Attributes); -- | procedure Set_Soft_Label_Key_Color (Pair : Color_Pair); -- AKA: slk_color() pragma Inline (Set_Soft_Label_Key_Color); -- |===================================================================== -- | Man page keybound.3x -- |===================================================================== -- Not Implemented: keybound -- |===================================================================== -- | Man page keyok.3x -- |===================================================================== -- | procedure Enable_Key (Key : Special_Key_Code; Enable : Boolean := True); -- AKA: keyok() pragma Inline (Enable_Key); -- |===================================================================== -- | Man page define_key.3x -- |===================================================================== -- | procedure Define_Key (Definition : String; Key : Special_Key_Code); -- AKA: define_key() pragma Inline (Define_Key); -- |===================================================================== -- | Man page curs_util.3x -- |===================================================================== -- | Not implemented : filter, use_env -- | putwin, getwin are in the child package PutWin -- -- | procedure Key_Name (Key : Real_Key_Code; Name : out String); -- AKA: keyname() -- The external name for a real keystroke. -- | function Key_Name (Key : Real_Key_Code) return String; -- AKA: keyname() -- Same as function -- We do not inline this routine -- | procedure Un_Control (Ch : Attributed_Character; Str : out String); -- AKA: unctrl() -- | function Un_Control (Ch : Attributed_Character) return String; -- AKA: unctrl() -- Same as function pragma Inline (Un_Control); -- | procedure Delay_Output (Msecs : Natural); -- AKA: delay_output() pragma Inline (Delay_Output); -- | procedure Flush_Input; -- AKA: flushinp() pragma Inline (Flush_Input); -- |===================================================================== -- | Man page curs_termattrs.3x -- |===================================================================== -- | function Baudrate return Natural; -- AKA: baudrate() pragma Inline (Baudrate); -- | function Erase_Character return Character; -- AKA: erasechar() pragma Inline (Erase_Character); -- | function Kill_Character return Character; -- AKA: killchar() pragma Inline (Kill_Character); -- | function Has_Insert_Character return Boolean; -- AKA: has_ic() pragma Inline (Has_Insert_Character); -- | function Has_Insert_Line return Boolean; -- AKA: has_il() pragma Inline (Has_Insert_Line); -- | function Supported_Attributes return Character_Attribute_Set; -- AKA: termattrs() pragma Inline (Supported_Attributes); -- | procedure Long_Name (Name : out String); -- AKA: longname() -- | function Long_Name return String; -- AKA: longname() -- Same as function pragma Inline (Long_Name); -- | procedure Terminal_Name (Name : out String); -- AKA: termname() -- | function Terminal_Name return String; -- AKA: termname() -- Same as function pragma Inline (Terminal_Name); -- |===================================================================== -- | Man page curs_color.3x -- |===================================================================== -- COLOR_PAIR -- COLOR_PAIR(n) in C is the same as -- Attributed_Character(Ch => Nul, Color => n, Attr => Normal_Video) -- In C you often see something like c = c | COLOR_PAIR(n); -- This is equivalent to c.Color := n; -- | procedure Start_Color; -- AKA: start_color() pragma Import (C, Start_Color, "start_color"); -- | procedure Init_Pair (Pair : Redefinable_Color_Pair; Fore : Color_Number; Back : Color_Number); -- AKA: init_pair() pragma Inline (Init_Pair); -- | procedure Pair_Content (Pair : Color_Pair; Fore : out Color_Number; Back : out Color_Number); -- AKA: pair_content() pragma Inline (Pair_Content); -- | function Has_Colors return Boolean; -- AKA: has_colors() pragma Inline (Has_Colors); -- | procedure Init_Color (Color : Color_Number; Red : RGB_Value; Green : RGB_Value; Blue : RGB_Value); -- AKA: init_color() pragma Inline (Init_Color); -- | function Can_Change_Color return Boolean; -- AKA: can_change_color() pragma Inline (Can_Change_Color); -- | procedure Color_Content (Color : Color_Number; Red : out RGB_Value; Green : out RGB_Value; Blue : out RGB_Value); -- AKA: color_content() pragma Inline (Color_Content); -- |===================================================================== -- | Man page curs_kernel.3x -- |===================================================================== -- | Not implemented: getsyx, setsyx -- type Curses_Mode is (Curses, Shell); -- | procedure Save_Curses_Mode (Mode : Curses_Mode); -- AKA: def_prog_mode() -- AKA: def_shell_mode() pragma Inline (Save_Curses_Mode); -- | procedure Reset_Curses_Mode (Mode : Curses_Mode); -- AKA: reset_prog_mode() -- AKA: reset_shell_mode() pragma Inline (Reset_Curses_Mode); -- | procedure Save_Terminal_State; -- AKA: savetty() pragma Inline (Save_Terminal_State); -- | procedure Reset_Terminal_State; -- AKA: resetty(); pragma Inline (Reset_Terminal_State); type Stdscr_Init_Proc is access function (Win : Window; Columns : Column_Count) return Integer; pragma Convention (C, Stdscr_Init_Proc); -- N.B.: the return value is actually ignored, but it seems to be -- a good practice to return 0 if you think all went fine -- and -1 otherwise. -- | procedure Rip_Off_Lines (Lines : Integer; Proc : Stdscr_Init_Proc); -- AKA: ripoffline() -- N.B.: to be more precise, this uses a ncurses specific enhancement of -- ripoffline(), in which the Lines argument absolute value is the -- number of lines to be ripped of. The official ripoffline() only -- uses the sign of Lines to remove a single line from bottom or top. pragma Inline (Rip_Off_Lines); type Cursor_Visibility is (Invisible, Normal, Very_Visible); -- | procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility); -- AKA: curs_set() pragma Inline (Set_Cursor_Visibility); -- | procedure Nap_Milli_Seconds (Ms : Natural); -- AKA: napms() pragma Inline (Nap_Milli_Seconds); -- |===================================================================== -- | Some useful helpers. -- |===================================================================== type Transform_Direction is (From_Screen, To_Screen); procedure Transform_Coordinates (W : Window := Standard_Window; Line : in out Line_Position; Column : in out Column_Position; Dir : Transform_Direction := From_Screen); -- This procedure transforms screen coordinates into coordinates relative -- to the window and vice versa, depending on the Dir parameter. -- Screen coordinates are the position information for the physical device. -- An Curses_Exception will be raised if Line and Column are not in the -- Window or if you pass the Null_Window as argument. -- We do not inline this procedure -- |===================================================================== -- | Man page default_colors.3x -- |===================================================================== Default_Color : constant Color_Number := -1; -- | procedure Use_Default_Colors; -- AKA: use_default_colors() pragma Inline (Use_Default_Colors); -- | procedure Assume_Default_Colors (Fore : Color_Number := Default_Color; Back : Color_Number := Default_Color); -- AKA: assume_default_colors() pragma Inline (Assume_Default_Colors); -- |===================================================================== -- | Man page curs_extend.3x -- |===================================================================== -- | function Curses_Version return String; -- AKA: curses_version() -- | -- The returnvalue is the previous setting of the flag function Use_Extended_Names (Enable : Boolean) return Boolean; -- AKA: use_extended_names() -- |===================================================================== -- | Man page curs_trace.3x -- |===================================================================== -- | procedure Curses_Free_All; -- AKA: _nc_freeall() -- |===================================================================== -- | Man page curs_scr_dump.3x -- |===================================================================== -- | procedure Screen_Dump_To_File (Filename : String); -- AKA: scr_dump() -- | procedure Screen_Restore_From_File (Filename : String); -- AKA: scr_restore() -- | procedure Screen_Init_From_File (Filename : String); -- AKA: scr_init() -- | procedure Screen_Set_File (Filename : String); -- AKA: scr_set() -- |===================================================================== -- | Man page curs_print.3x -- |===================================================================== -- Not implemented: mcprint -- |===================================================================== -- | Man page curs_printw.3x -- |===================================================================== -- Not implemented: printw, wprintw, mvprintw, mvwprintw, vwprintw, -- vw_printw -- Please use the Ada style Text_IO child packages for formatted -- printing. It does not make a lot of sense to map the printf style -- C functions to Ada. -- |===================================================================== -- | Man page curs_scanw.3x -- |===================================================================== -- Not implemented: scanw, wscanw, mvscanw, mvwscanw, vwscanw, vw_scanw -- |===================================================================== -- | Man page resizeterm.3x -- |===================================================================== -- Not Implemented: resizeterm -- |===================================================================== -- | Man page wresize.3x -- |===================================================================== -- | procedure Resize (Win : Window := Standard_Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count); -- AKA: wresize() private type Window is new System.Storage_Elements.Integer_Address; Null_Window : constant Window := 0; -- The next constants are generated and may be different on your -- architecture. -- Sizeof_Bool : constant := Curses_Constants.Sizeof_Bool; type Curses_Bool is mod 2 ** Sizeof_Bool; Curses_Bool_False : constant Curses_Bool := 0; end Terminal_Interface.Curses;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-integer_io__adb.htm 0000644 0001751 0000144 00000024037 13615673306 026256 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Integer_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; with Terminal_Interface.Curses.Text_IO.Aux; package body Terminal_Interface.Curses.Text_IO.Integer_IO is package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package IIO is new Ada.Text_IO.Integer_IO (Num); procedure Put (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base) is Buf : String (1 .. Field'Last); begin IIO.Put (Buf, Item, Base); Aux.Put_Buf (Win, Buf, Width); end Put; procedure Put (Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base) is begin Put (Get_Window, Item, Width, Base); end Put; end Terminal_Interface.Curses.Text_IO.Integer_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-putwin__adb.htm 0000644 0001751 0000144 00000023435 13615673306 024010 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.PutWin -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2000-2002,2003 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.5 @ -- Binding Version 01.00 with Ada.Streams.Stream_IO.C_Streams; with Interfaces.C_Streams; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.PutWin is package ICS renames Interfaces.C_Streams; package ACS renames Ada.Streams.Stream_IO.C_Streams; use type C_Int; procedure Put_Window (Win : Window; File : Ada.Streams.Stream_IO.File_Type) is function putwin (Win : Window; f : ICS.FILEs) return C_Int; pragma Import (C, putwin, "putwin"); R : constant C_Int := putwin (Win, ACS.C_Stream (File)); begin if R /= Curses_Ok then raise Curses_Exception; end if; end Put_Window; function Get_Window (File : Ada.Streams.Stream_IO.File_Type) return Window is function getwin (f : ICS.FILEs) return Window; pragma Import (C, getwin, "getwin"); W : constant Window := getwin (ACS.C_Stream (File)); begin if W = Null_Window then raise Curses_Exception; else return W; end if; end Get_Window; end Terminal_Interface.Curses.PutWin;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-aux__ads.htm 0000644 0001751 0000144 00000016435 13615673306 024753 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Aux -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2006,2009 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.15 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ private package Terminal_Interface.Curses.Text_IO.Aux is -- pragma Preelaborate (Aux); -- This routine is called from the Text_IO output routines for numeric -- and enumeration types. -- procedure Put_Buf (Win : Window; -- The output window Buf : String; -- The buffer containing the text Width : Field; -- The width of the output field Signal : Boolean := True; -- If true, we raise Layout_Error Ljust : Boolean := False); -- The Buf is left justified end Terminal_Interface.Curses.Text_IO.Aux;AdaCurses-20211021/doc/ada/funcs/ 0000755 0001751 0000144 00000000000 14134402303 014737 5 ustar tom users AdaCurses-20211021/doc/ada/funcs/H.htm 0000644 0001751 0000144 00000003252 13615673306 015662 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Termcap -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2000-2006,2009 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.13 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; package body Terminal_Interface.Curses.Termcap is function Get_Entry (Name : String) return Boolean is function tgetent (name : char_array; val : char_array) return C_Int; pragma Import (C, tgetent, "tgetent"); NameTxt : char_array (0 .. Name'Length); Length : size_t; ignored : constant char_array (0 .. 0) := (0 => nul); result : C_Int; begin To_C (Name, NameTxt, Length); result := tgetent (char_array (ignored), NameTxt); if result = -1 then raise Curses_Exception; else return Boolean'Val (result); end if; end Get_Entry; ------------------------------------------------------------------------------ function Get_Flag (Name : String) return Boolean is function tgetflag (id : char_array) return C_Int; pragma Import (C, tgetflag, "tgetflag"); Txt : char_array (0 .. Name'Length); Length : size_t; begin To_C (Name, Txt, Length); if tgetflag (Txt) = 0 then return False; else return True; end if; end Get_Flag; ------------------------------------------------------------------------------ procedure Get_Number (Name : String; Value : out Integer; Result : out Boolean) is function tgetnum (id : char_array) return C_Int; pragma Import (C, tgetnum, "tgetnum"); Txt : char_array (0 .. Name'Length); Length : size_t; begin To_C (Name, Txt, Length); Value := Integer (tgetnum (Txt)); if Value = -1 then Result := False; else Result := True; end if; end Get_Number; ------------------------------------------------------------------------------ procedure Get_String (Name : String; Value : out String; Result : out Boolean) is function tgetstr (id : char_array; buf : char_array) return chars_ptr; pragma Import (C, tgetstr, "tgetstr"); Txt : char_array (0 .. Name'Length); Length : size_t; Txt2 : chars_ptr; type t is new char_array (0 .. 1024); -- does it need to be 1024? Return_Buffer : constant t := (others => nul); begin To_C (Name, Txt, Length); Txt2 := tgetstr (Txt, char_array (Return_Buffer)); if Txt2 = Null_Ptr then Result := False; else Value := Fill_String (Txt2); Result := True; end if; end Get_String; function Get_String (Name : String) return Boolean is function tgetstr (Id : char_array; buf : char_array) return chars_ptr; pragma Import (C, tgetstr, "tgetstr"); Txt : char_array (0 .. Name'Length); Length : size_t; Txt2 : chars_ptr; type t is new char_array (0 .. 1024); -- does it need to be 1024? Phony_Txt : constant t := (others => nul); begin To_C (Name, Txt, Length); Txt2 := tgetstr (Txt, char_array (Phony_Txt)); if Txt2 = Null_Ptr then return False; else return True; end if; end Get_String; ------------------------------------------------------------------------------ function TGoto (Cap : String; Col : Column_Position; Row : Line_Position) return Termcap_String is function tgoto (cap : char_array; col : C_Int; row : C_Int) return chars_ptr; pragma Import (C, tgoto); Txt : char_array (0 .. Cap'Length); Length : size_t; begin To_C (Cap, Txt, Length); return Termcap_String (Fill_String (tgoto (Txt, C_Int (Col), C_Int (Row)))); end TGoto; end Terminal_Interface.Curses.Termcap;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-ipv4_address__adb.htm 0000644 0001751 0000144 00000020251 13615673306 030473 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.14 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address is procedure Set_Field_Type (Fld : Field; Typ : Internet_V4_Address_Field) is function Set_Fld_Type (F : Field := Fld) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_ipv4"); begin Eti_Exception (Set_Fld_Type); Wrap_Builtin (Fld, Typ); end Set_Field_Type; end Terminal_Interface.Curses.Forms.Field_Types.IPV4_Address;AdaCurses-20211021/doc/ada/terminal_interface-curses-aux__adb.htm 0000644 0001751 0000144 00000032211 13615673306 023247 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Aux -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package body Terminal_Interface.Curses.Aux is -- -- Some helpers procedure Fill_String (Cp : chars_ptr; Str : out String) is -- Fill the string with the characters referenced by the -- chars_ptr. -- Len : Natural; begin if Cp /= Null_Ptr then Len := Natural (Strlen (Cp)); if Str'Length < Len then raise Constraint_Error; end if; declare S : String (1 .. Len); begin S := Value (Cp); Str (Str'First .. (Str'First + Len - 1)) := S (S'Range); end; else Len := 0; end if; if Len < Str'Length then Str ((Str'First + Len) .. Str'Last) := (others => ' '); end if; end Fill_String; function Fill_String (Cp : chars_ptr) return String is Len : Natural; begin if Cp /= Null_Ptr then Len := Natural (Strlen (Cp)); if Len = 0 then return ""; else declare S : String (1 .. Len); begin Fill_String (Cp, S); return S; end; end if; else return ""; end if; end Fill_String; procedure Eti_Exception (Code : Eti_Error) is begin case Code is when E_Ok => null; when E_System_Error => raise Eti_System_Error; when E_Bad_Argument => raise Eti_Bad_Argument; when E_Posted => raise Eti_Posted; when E_Connected => raise Eti_Connected; when E_Bad_State => raise Eti_Bad_State; when E_No_Room => raise Eti_No_Room; when E_Not_Posted => raise Eti_Not_Posted; when E_Unknown_Command => raise Eti_Unknown_Command; when E_No_Match => raise Eti_No_Match; when E_Not_Selectable => raise Eti_Not_Selectable; when E_Not_Connected => raise Eti_Not_Connected; when E_Request_Denied => raise Eti_Request_Denied; when E_Invalid_Field => raise Eti_Invalid_Field; when E_Current => raise Eti_Current; end case; end Eti_Exception; end Terminal_Interface.Curses.Aux;AdaCurses-20211021/doc/ada/main.htm 0000644 0001751 0000144 00000012565 12340214310 015264 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Menus.Item_User_Data -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2006,2009 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.18 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type User is limited private; type User_Access is access User; package Terminal_Interface.Curses.Menus.Item_User_Data is pragma Preelaborate (Terminal_Interface.Curses.Menus.Item_User_Data); -- The binding uses the same user pointer for menu items -- as the low level C implementation. So you can safely -- read or write the user pointer also with the C routines -- -- |===================================================================== -- | Man page mitem_userptr.3x -- |===================================================================== -- | procedure Set_User_Data (Itm : Item; Data : User_Access); -- AKA: set_item_userptr pragma Inline (Set_User_Data); -- | procedure Get_User_Data (Itm : Item; Data : out User_Access); -- AKA: item_userptr -- | function Get_User_Data (Itm : Item) return User_Access; -- AKA: item_userptr -- Same as function pragma Inline (Get_User_Data); end Terminal_Interface.Curses.Menus.Item_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-fixed_io__ads.htm 0000644 0001751 0000144 00000022067 13615673306 025742 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Fixed_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type Num is delta <>; package Terminal_Interface.Curses.Text_IO.Fixed_IO is Default_Fore : Field := Num'Fore; Default_Aft : Field := Num'Aft; Default_Exp : Field := 0; procedure Put (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); procedure Put (Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); private pragma Inline (Put); end Terminal_Interface.Curses.Text_IO.Fixed_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses__adb.htm 0000644 0001751 0000144 00001217325 13615673306 022470 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 2007-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.16 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; with Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Ada.Characters.Handling; use Ada.Characters.Handling; with Ada.Strings.Fixed; package body Terminal_Interface.Curses is use Aux; package ASF renames Ada.Strings.Fixed; type chtype_array is array (size_t range <>) of aliased Attributed_Character; pragma Convention (C, chtype_array); ------------------------------------------------------------------------------ function Key_Name (Key : Real_Key_Code) return String is function Keyname (K : C_Int) return chars_ptr; pragma Import (C, Keyname, "keyname"); Ch : Character; begin if Key <= Character'Pos (Character'Last) then Ch := Character'Val (Key); if Is_Control (Ch) then return Un_Control (Attributed_Character'(Ch => Ch, Color => Color_Pair'First, Attr => Normal_Video)); elsif Is_Graphic (Ch) then declare S : String (1 .. 1); begin S (1) := Ch; return S; end; else return ""; end if; else return Fill_String (Keyname (C_Int (Key))); end if; end Key_Name; procedure Key_Name (Key : Real_Key_Code; Name : out String) is begin ASF.Move (Key_Name (Key), Name); end Key_Name; ------------------------------------------------------------------------------ procedure Init_Screen is function Initscr return Window; pragma Import (C, Initscr, "initscr"); W : Window; begin W := Initscr; if W = Null_Window then raise Curses_Exception; end if; end Init_Screen; procedure End_Windows is function Endwin return C_Int; pragma Import (C, Endwin, "endwin"); begin if Endwin = Curses_Err then raise Curses_Exception; end if; end End_Windows; function Is_End_Window return Boolean is function Isendwin return Curses_Bool; pragma Import (C, Isendwin, "isendwin"); begin if Isendwin = Curses_Bool_False then return False; else return True; end if; end Is_End_Window; ------------------------------------------------------------------------------ procedure Move_Cursor (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position) is function Wmove (Win : Window; Line : C_Int; Column : C_Int ) return C_Int; pragma Import (C, Wmove, "wmove"); begin if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then raise Curses_Exception; end if; end Move_Cursor; ------------------------------------------------------------------------------ procedure Add (Win : Window := Standard_Window; Ch : Attributed_Character) is function Waddch (W : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, Waddch, "waddch"); begin if Waddch (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Add; procedure Add (Win : Window := Standard_Window; Ch : Character) is begin Add (Win, Attributed_Character'(Ch => Ch, Color => Color_Pair'First, Attr => Normal_Video)); end Add; procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Ch : Attributed_Character) is function mvwaddch (W : Window; Y : C_Int; X : C_Int; Ch : Attributed_Character) return C_Int; pragma Import (C, mvwaddch, "mvwaddch"); begin if mvwaddch (Win, C_Int (Line), C_Int (Column), Ch) = Curses_Err then raise Curses_Exception; end if; end Add; procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Ch : Character) is begin Add (Win, Line, Column, Attributed_Character'(Ch => Ch, Color => Color_Pair'First, Attr => Normal_Video)); end Add; procedure Add_With_Immediate_Echo (Win : Window := Standard_Window; Ch : Attributed_Character) is function Wechochar (W : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, Wechochar, "wechochar"); begin if Wechochar (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Add_With_Immediate_Echo; procedure Add_With_Immediate_Echo (Win : Window := Standard_Window; Ch : Character) is begin Add_With_Immediate_Echo (Win, Attributed_Character'(Ch => Ch, Color => Color_Pair'First, Attr => Normal_Video)); end Add_With_Immediate_Echo; ------------------------------------------------------------------------------ function Create (Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window is function Newwin (Number_Of_Lines : C_Int; Number_Of_Columns : C_Int; First_Line_Position : C_Int; First_Column_Position : C_Int) return Window; pragma Import (C, Newwin, "newwin"); W : Window; begin W := Newwin (C_Int (Number_Of_Lines), C_Int (Number_Of_Columns), C_Int (First_Line_Position), C_Int (First_Column_Position)); if W = Null_Window then raise Curses_Exception; end if; return W; end Create; procedure Delete (Win : in out Window) is function Wdelwin (W : Window) return C_Int; pragma Import (C, Wdelwin, "delwin"); begin if Wdelwin (Win) = Curses_Err then raise Curses_Exception; end if; Win := Null_Window; end Delete; function Sub_Window (Win : Window := Standard_Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window is function Subwin (Win : Window; Number_Of_Lines : C_Int; Number_Of_Columns : C_Int; First_Line_Position : C_Int; First_Column_Position : C_Int) return Window; pragma Import (C, Subwin, "subwin"); W : Window; begin W := Subwin (Win, C_Int (Number_Of_Lines), C_Int (Number_Of_Columns), C_Int (First_Line_Position), C_Int (First_Column_Position)); if W = Null_Window then raise Curses_Exception; end if; return W; end Sub_Window; function Derived_Window (Win : Window := Standard_Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window is function Derwin (Win : Window; Number_Of_Lines : C_Int; Number_Of_Columns : C_Int; First_Line_Position : C_Int; First_Column_Position : C_Int) return Window; pragma Import (C, Derwin, "derwin"); W : Window; begin W := Derwin (Win, C_Int (Number_Of_Lines), C_Int (Number_Of_Columns), C_Int (First_Line_Position), C_Int (First_Column_Position)); if W = Null_Window then raise Curses_Exception; end if; return W; end Derived_Window; function Duplicate (Win : Window) return Window is function Dupwin (Win : Window) return Window; pragma Import (C, Dupwin, "dupwin"); W : constant Window := Dupwin (Win); begin if W = Null_Window then raise Curses_Exception; end if; return W; end Duplicate; procedure Move_Window (Win : Window; Line : Line_Position; Column : Column_Position) is function Mvwin (Win : Window; Line : C_Int; Column : C_Int) return C_Int; pragma Import (C, Mvwin, "mvwin"); begin if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then raise Curses_Exception; end if; end Move_Window; procedure Move_Derived_Window (Win : Window; Line : Line_Position; Column : Column_Position) is function Mvderwin (Win : Window; Line : C_Int; Column : C_Int) return C_Int; pragma Import (C, Mvderwin, "mvderwin"); begin if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then raise Curses_Exception; end if; end Move_Derived_Window; procedure Set_Synch_Mode (Win : Window := Standard_Window; Mode : Boolean := False) is function Syncok (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Syncok, "syncok"); begin if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then raise Curses_Exception; end if; end Set_Synch_Mode; ------------------------------------------------------------------------------ procedure Add (Win : Window := Standard_Window; Str : String; Len : Integer := -1) is function Waddnstr (Win : Window; Str : char_array; Len : C_Int := -1) return C_Int; pragma Import (C, Waddnstr, "waddnstr"); Txt : char_array (0 .. Str'Length); Length : size_t; begin To_C (Str, Txt, Length); if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then raise Curses_Exception; end if; end Add; procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : String; Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Add (Win, Str, Len); end Add; ------------------------------------------------------------------------------ procedure Add (Win : Window := Standard_Window; Str : Attributed_String; Len : Integer := -1) is function Waddchnstr (Win : Window; Str : chtype_array; Len : C_Int := -1) return C_Int; pragma Import (C, Waddchnstr, "waddchnstr"); Txt : chtype_array (0 .. Str'Length); begin for Length in 1 .. size_t (Str'Length) loop Txt (Length - 1) := Str (Natural (Length)); end loop; Txt (Str'Length) := Default_Character; if Waddchnstr (Win, Txt, C_Int (Len)) = Curses_Err then raise Curses_Exception; end if; end Add; procedure Add (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : Attributed_String; Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Add (Win, Str, Len); end Add; ------------------------------------------------------------------------------ procedure Border (Win : Window := Standard_Window; Left_Side_Symbol : Attributed_Character := Default_Character; Right_Side_Symbol : Attributed_Character := Default_Character; Top_Side_Symbol : Attributed_Character := Default_Character; Bottom_Side_Symbol : Attributed_Character := Default_Character; Upper_Left_Corner_Symbol : Attributed_Character := Default_Character; Upper_Right_Corner_Symbol : Attributed_Character := Default_Character; Lower_Left_Corner_Symbol : Attributed_Character := Default_Character; Lower_Right_Corner_Symbol : Attributed_Character := Default_Character) is function Wborder (W : Window; LS : Attributed_Character; RS : Attributed_Character; TS : Attributed_Character; BS : Attributed_Character; ULC : Attributed_Character; URC : Attributed_Character; LLC : Attributed_Character; LRC : Attributed_Character) return C_Int; pragma Import (C, Wborder, "wborder"); begin if Wborder (Win, Left_Side_Symbol, Right_Side_Symbol, Top_Side_Symbol, Bottom_Side_Symbol, Upper_Left_Corner_Symbol, Upper_Right_Corner_Symbol, Lower_Left_Corner_Symbol, Lower_Right_Corner_Symbol) = Curses_Err then raise Curses_Exception; end if; end Border; procedure Box (Win : Window := Standard_Window; Vertical_Symbol : Attributed_Character := Default_Character; Horizontal_Symbol : Attributed_Character := Default_Character) is begin Border (Win, Vertical_Symbol, Vertical_Symbol, Horizontal_Symbol, Horizontal_Symbol); end Box; procedure Horizontal_Line (Win : Window := Standard_Window; Line_Size : Natural; Line_Symbol : Attributed_Character := Default_Character) is function Whline (W : Window; Ch : Attributed_Character; Len : C_Int) return C_Int; pragma Import (C, Whline, "whline"); begin if Whline (Win, Line_Symbol, C_Int (Line_Size)) = Curses_Err then raise Curses_Exception; end if; end Horizontal_Line; procedure Vertical_Line (Win : Window := Standard_Window; Line_Size : Natural; Line_Symbol : Attributed_Character := Default_Character) is function Wvline (W : Window; Ch : Attributed_Character; Len : C_Int) return C_Int; pragma Import (C, Wvline, "wvline"); begin if Wvline (Win, Line_Symbol, C_Int (Line_Size)) = Curses_Err then raise Curses_Exception; end if; end Vertical_Line; ------------------------------------------------------------------------------ function Get_Keystroke (Win : Window := Standard_Window) return Real_Key_Code is function Wgetch (W : Window) return C_Int; pragma Import (C, Wgetch, "wgetch"); C : constant C_Int := Wgetch (Win); begin if C = Curses_Err then return Key_None; else return Real_Key_Code (C); end if; end Get_Keystroke; procedure Undo_Keystroke (Key : Real_Key_Code) is function Ungetch (Ch : C_Int) return C_Int; pragma Import (C, Ungetch, "ungetch"); begin if Ungetch (C_Int (Key)) = Curses_Err then raise Curses_Exception; end if; end Undo_Keystroke; function Has_Key (Key : Special_Key_Code) return Boolean is function Haskey (Key : C_Int) return C_Int; pragma Import (C, Haskey, "has_key"); begin if Haskey (C_Int (Key)) = Curses_False then return False; else return True; end if; end Has_Key; function Is_Function_Key (Key : Special_Key_Code) return Boolean is L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) + Natural (Function_Key_Number'Last)); begin if (Key >= Key_F0) and then (Key <= L) then return True; else return False; end if; end Is_Function_Key; function Function_Key (Key : Real_Key_Code) return Function_Key_Number is begin if Is_Function_Key (Key) then return Function_Key_Number (Key - Key_F0); else raise Constraint_Error; end if; end Function_Key; function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code is begin return Real_Key_Code (Natural (Key_F0) + Natural (Key)); end Function_Key_Code; ------------------------------------------------------------------------------ procedure Standout (Win : Window := Standard_Window; On : Boolean := True) is function wstandout (Win : Window) return C_Int; pragma Import (C, wstandout, "wstandout"); function wstandend (Win : Window) return C_Int; pragma Import (C, wstandend, "wstandend"); Err : C_Int; begin if On then Err := wstandout (Win); else Err := wstandend (Win); end if; if Err = Curses_Err then raise Curses_Exception; end if; end Standout; procedure Switch_Character_Attribute (Win : Window := Standard_Window; Attr : Character_Attribute_Set := Normal_Video; On : Boolean := True) is function Wattron (Win : Window; C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattron, "wattr_on"); function Wattroff (Win : Window; C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattroff, "wattr_off"); -- In Ada we use the On Boolean to control whether or not we want to -- switch on or off the attributes in the set. Err : C_Int; AC : constant Attributed_Character := (Ch => Character'First, Color => Color_Pair'First, Attr => Attr); begin if On then Err := Wattron (Win, AC); else Err := Wattroff (Win, AC); end if; if Err = Curses_Err then raise Curses_Exception; end if; end Switch_Character_Attribute; procedure Set_Character_Attributes (Win : Window := Standard_Window; Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Wattrset (Win : Window; C_Attr : Attributed_Character) return C_Int; pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set begin if Wattrset (Win, (Ch => Character'First, Color => Color, Attr => Attr)) = Curses_Err then raise Curses_Exception; end if; end Set_Character_Attributes; function Get_Character_Attribute (Win : Window := Standard_Window) return Character_Attribute_Set is function Wattrget (Win : Window; Atr : access Attributed_Character; Col : access C_Short; Opt : System.Address) return C_Int; pragma Import (C, Wattrget, "wattr_get"); Attr : aliased Attributed_Character; Col : aliased C_Short; Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, System.Null_Address); begin if Res = Curses_Ok then return Attr.Attr; else raise Curses_Exception; end if; end Get_Character_Attribute; function Get_Character_Attribute (Win : Window := Standard_Window) return Color_Pair is function Wattrget (Win : Window; Atr : access Attributed_Character; Col : access C_Short; Opt : System.Address) return C_Int; pragma Import (C, Wattrget, "wattr_get"); Attr : aliased Attributed_Character; Col : aliased C_Short; Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access, System.Null_Address); begin if Res = Curses_Ok then return Attr.Color; else raise Curses_Exception; end if; end Get_Character_Attribute; procedure Set_Color (Win : Window := Standard_Window; Pair : Color_Pair) is function Wset_Color (Win : Window; Color : C_Short; Opts : C_Void_Ptr) return C_Int; pragma Import (C, Wset_Color, "wcolor_set"); begin if Wset_Color (Win, C_Short (Pair), C_Void_Ptr (System.Null_Address)) = Curses_Err then raise Curses_Exception; end if; end Set_Color; procedure Change_Attributes (Win : Window := Standard_Window; Count : Integer := -1; Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Wchgat (Win : Window; Cnt : C_Int; Attr : Attributed_Character; Color : C_Short; Opts : System.Address := System.Null_Address) return C_Int; pragma Import (C, Wchgat, "wchgat"); begin if Wchgat (Win, C_Int (Count), (Ch => Character'First, Color => Color_Pair'First, Attr => Attr), C_Short (Color)) = Curses_Err then raise Curses_Exception; end if; end Change_Attributes; procedure Change_Attributes (Win : Window := Standard_Window; Line : Line_Position := Line_Position'First; Column : Column_Position := Column_Position'First; Count : Integer := -1; Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is begin Move_Cursor (Win, Line, Column); Change_Attributes (Win, Count, Attr, Color); end Change_Attributes; ------------------------------------------------------------------------------ procedure Beep is function Beeper return C_Int; pragma Import (C, Beeper, "beep"); begin if Beeper = Curses_Err then raise Curses_Exception; end if; end Beep; procedure Flash_Screen is function Flash return C_Int; pragma Import (C, Flash, "flash"); begin if Flash = Curses_Err then raise Curses_Exception; end if; end Flash_Screen; ------------------------------------------------------------------------------ procedure Set_Cbreak_Mode (SwitchOn : Boolean := True) is function Cbreak return C_Int; pragma Import (C, Cbreak, "cbreak"); function NoCbreak return C_Int; pragma Import (C, NoCbreak, "nocbreak"); Err : C_Int; begin if SwitchOn then Err := Cbreak; else Err := NoCbreak; end if; if Err = Curses_Err then raise Curses_Exception; end if; end Set_Cbreak_Mode; procedure Set_Raw_Mode (SwitchOn : Boolean := True) is function Raw return C_Int; pragma Import (C, Raw, "raw"); function NoRaw return C_Int; pragma Import (C, NoRaw, "noraw"); Err : C_Int; begin if SwitchOn then Err := Raw; else Err := NoRaw; end if; if Err = Curses_Err then raise Curses_Exception; end if; end Set_Raw_Mode; procedure Set_Echo_Mode (SwitchOn : Boolean := True) is function Echo return C_Int; pragma Import (C, Echo, "echo"); function NoEcho return C_Int; pragma Import (C, NoEcho, "noecho"); Err : C_Int; begin if SwitchOn then Err := Echo; else Err := NoEcho; end if; if Err = Curses_Err then raise Curses_Exception; end if; end Set_Echo_Mode; procedure Set_Meta_Mode (Win : Window := Standard_Window; SwitchOn : Boolean := True) is function Meta (W : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Meta, "meta"); begin if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then raise Curses_Exception; end if; end Set_Meta_Mode; procedure Set_KeyPad_Mode (Win : Window := Standard_Window; SwitchOn : Boolean := True) is function Keypad (W : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Keypad, "keypad"); begin if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then raise Curses_Exception; end if; end Set_KeyPad_Mode; function Get_KeyPad_Mode (Win : Window := Standard_Window) return Boolean is function Is_Keypad (W : Window) return Curses_Bool; pragma Import (C, Is_Keypad, "is_keypad"); begin return (Is_Keypad (Win) /= Curses_Bool_False); end Get_KeyPad_Mode; procedure Half_Delay (Amount : Half_Delay_Amount) is function Halfdelay (Amount : C_Int) return C_Int; pragma Import (C, Halfdelay, "halfdelay"); begin if Halfdelay (C_Int (Amount)) = Curses_Err then raise Curses_Exception; end if; end Half_Delay; procedure Set_Flush_On_Interrupt_Mode (Win : Window := Standard_Window; Mode : Boolean := True) is function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Intrflush, "intrflush"); begin if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then raise Curses_Exception; end if; end Set_Flush_On_Interrupt_Mode; procedure Set_Queue_Interrupt_Mode (Win : Window := Standard_Window; Flush : Boolean := True) is procedure Qiflush; pragma Import (C, Qiflush, "qiflush"); procedure No_Qiflush; pragma Import (C, No_Qiflush, "noqiflush"); begin if Win = Null_Window then raise Curses_Exception; end if; if Flush then Qiflush; else No_Qiflush; end if; end Set_Queue_Interrupt_Mode; procedure Set_NoDelay_Mode (Win : Window := Standard_Window; Mode : Boolean := False) is function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Nodelay, "nodelay"); begin if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then raise Curses_Exception; end if; end Set_NoDelay_Mode; procedure Set_Timeout_Mode (Win : Window := Standard_Window; Mode : Timeout_Mode; Amount : Natural) is procedure Wtimeout (Win : Window; Amount : C_Int); pragma Import (C, Wtimeout, "wtimeout"); Time : C_Int; begin case Mode is when Blocking => Time := -1; when Non_Blocking => Time := 0; when Delayed => if Amount = 0 then raise Constraint_Error; end if; Time := C_Int (Amount); end case; Wtimeout (Win, Time); end Set_Timeout_Mode; procedure Set_Escape_Timer_Mode (Win : Window := Standard_Window; Timer_Off : Boolean := False) is function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Notimeout, "notimeout"); begin if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off))) = Curses_Err then raise Curses_Exception; end if; end Set_Escape_Timer_Mode; ------------------------------------------------------------------------------ procedure Set_NL_Mode (SwitchOn : Boolean := True) is function NL return C_Int; pragma Import (C, NL, "nl"); function NoNL return C_Int; pragma Import (C, NoNL, "nonl"); Err : C_Int; begin if SwitchOn then Err := NL; else Err := NoNL; end if; if Err = Curses_Err then raise Curses_Exception; end if; end Set_NL_Mode; procedure Clear_On_Next_Update (Win : Window := Standard_Window; Do_Clear : Boolean := True) is function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int; pragma Import (C, Clear_Ok, "clearok"); begin if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then raise Curses_Exception; end if; end Clear_On_Next_Update; procedure Use_Insert_Delete_Line (Win : Window := Standard_Window; Do_Idl : Boolean := True) is function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int; pragma Import (C, IDL_Ok, "idlok"); begin if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then raise Curses_Exception; end if; end Use_Insert_Delete_Line; procedure Use_Insert_Delete_Character (Win : Window := Standard_Window; Do_Idc : Boolean := True) is procedure IDC_Ok (W : Window; Flag : Curses_Bool); pragma Import (C, IDC_Ok, "idcok"); begin IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))); end Use_Insert_Delete_Character; procedure Leave_Cursor_After_Update (Win : Window := Standard_Window; Do_Leave : Boolean := True) is function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int; pragma Import (C, Leave_Ok, "leaveok"); begin if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then raise Curses_Exception; end if; end Leave_Cursor_After_Update; procedure Immediate_Update_Mode (Win : Window := Standard_Window; Mode : Boolean := False) is procedure Immedok (Win : Window; Mode : Curses_Bool); pragma Import (C, Immedok, "immedok"); begin Immedok (Win, Curses_Bool (Boolean'Pos (Mode))); end Immediate_Update_Mode; procedure Allow_Scrolling (Win : Window := Standard_Window; Mode : Boolean := False) is function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int; pragma Import (C, Scrollok, "scrollok"); begin if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then raise Curses_Exception; end if; end Allow_Scrolling; function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean is function Is_Scroll_Ok (W : Window) return Curses_Bool; pragma Import (C, Is_Scroll_Ok, "is_scrollok"); begin return (Is_Scroll_Ok (Win) /= Curses_Bool_False); end Scrolling_Allowed; procedure Set_Scroll_Region (Win : Window := Standard_Window; Top_Line : Line_Position; Bottom_Line : Line_Position) is function Wsetscrreg (Win : Window; Lin : C_Int; Col : C_Int) return C_Int; pragma Import (C, Wsetscrreg, "wsetscrreg"); begin if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line)) = Curses_Err then raise Curses_Exception; end if; end Set_Scroll_Region; ------------------------------------------------------------------------------ procedure Update_Screen is function Do_Update return C_Int; pragma Import (C, Do_Update, "doupdate"); begin if Do_Update = Curses_Err then raise Curses_Exception; end if; end Update_Screen; procedure Refresh (Win : Window := Standard_Window) is function Wrefresh (W : Window) return C_Int; pragma Import (C, Wrefresh, "wrefresh"); begin if Wrefresh (Win) = Curses_Err then raise Curses_Exception; end if; end Refresh; procedure Refresh_Without_Update (Win : Window := Standard_Window) is function Wnoutrefresh (W : Window) return C_Int; pragma Import (C, Wnoutrefresh, "wnoutrefresh"); begin if Wnoutrefresh (Win) = Curses_Err then raise Curses_Exception; end if; end Refresh_Without_Update; procedure Redraw (Win : Window := Standard_Window) is function Redrawwin (Win : Window) return C_Int; pragma Import (C, Redrawwin, "redrawwin"); begin if Redrawwin (Win) = Curses_Err then raise Curses_Exception; end if; end Redraw; procedure Redraw (Win : Window := Standard_Window; Begin_Line : Line_Position; Line_Count : Positive) is function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int) return C_Int; pragma Import (C, Wredrawln, "wredrawln"); begin if Wredrawln (Win, C_Int (Begin_Line), C_Int (Line_Count)) = Curses_Err then raise Curses_Exception; end if; end Redraw; ------------------------------------------------------------------------------ procedure Erase (Win : Window := Standard_Window) is function Werase (W : Window) return C_Int; pragma Import (C, Werase, "werase"); begin if Werase (Win) = Curses_Err then raise Curses_Exception; end if; end Erase; procedure Clear (Win : Window := Standard_Window) is function Wclear (W : Window) return C_Int; pragma Import (C, Wclear, "wclear"); begin if Wclear (Win) = Curses_Err then raise Curses_Exception; end if; end Clear; procedure Clear_To_End_Of_Screen (Win : Window := Standard_Window) is function Wclearbot (W : Window) return C_Int; pragma Import (C, Wclearbot, "wclrtobot"); begin if Wclearbot (Win) = Curses_Err then raise Curses_Exception; end if; end Clear_To_End_Of_Screen; procedure Clear_To_End_Of_Line (Win : Window := Standard_Window) is function Wcleareol (W : Window) return C_Int; pragma Import (C, Wcleareol, "wclrtoeol"); begin if Wcleareol (Win) = Curses_Err then raise Curses_Exception; end if; end Clear_To_End_Of_Line; ------------------------------------------------------------------------------ procedure Set_Background (Win : Window := Standard_Window; Ch : Attributed_Character) is procedure WBackground (W : Window; Ch : Attributed_Character); pragma Import (C, WBackground, "wbkgdset"); begin WBackground (Win, Ch); end Set_Background; procedure Change_Background (Win : Window := Standard_Window; Ch : Attributed_Character) is function WChangeBkgd (W : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, WChangeBkgd, "wbkgd"); begin if WChangeBkgd (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Change_Background; function Get_Background (Win : Window := Standard_Window) return Attributed_Character is function Wgetbkgd (Win : Window) return Attributed_Character; pragma Import (C, Wgetbkgd, "getbkgd"); begin return Wgetbkgd (Win); end Get_Background; ------------------------------------------------------------------------------ procedure Change_Lines_Status (Win : Window := Standard_Window; Start : Line_Position; Count : Positive; State : Boolean) is function Wtouchln (Win : Window; Sta : C_Int; Cnt : C_Int; Chg : C_Int) return C_Int; pragma Import (C, Wtouchln, "wtouchln"); begin if Wtouchln (Win, C_Int (Start), C_Int (Count), C_Int (Boolean'Pos (State))) = Curses_Err then raise Curses_Exception; end if; end Change_Lines_Status; procedure Touch (Win : Window := Standard_Window) is Y : Line_Position; X : Column_Position; begin Get_Size (Win, Y, X); pragma Warnings (Off, X); -- unreferenced Change_Lines_Status (Win, 0, Positive (Y), True); end Touch; procedure Untouch (Win : Window := Standard_Window) is Y : Line_Position; X : Column_Position; begin Get_Size (Win, Y, X); pragma Warnings (Off, X); -- unreferenced Change_Lines_Status (Win, 0, Positive (Y), False); end Untouch; procedure Touch (Win : Window := Standard_Window; Start : Line_Position; Count : Positive) is begin Change_Lines_Status (Win, Start, Count, True); end Touch; function Is_Touched (Win : Window := Standard_Window; Line : Line_Position) return Boolean is function WLineTouched (W : Window; L : C_Int) return Curses_Bool; pragma Import (C, WLineTouched, "is_linetouched"); begin if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then return False; else return True; end if; end Is_Touched; function Is_Touched (Win : Window := Standard_Window) return Boolean is function WWinTouched (W : Window) return Curses_Bool; pragma Import (C, WWinTouched, "is_wintouched"); begin if WWinTouched (Win) = Curses_Bool_False then return False; else return True; end if; end Is_Touched; ------------------------------------------------------------------------------ procedure Copy (Source_Window : Window; Destination_Window : Window; Source_Top_Row : Line_Position; Source_Left_Column : Column_Position; Destination_Top_Row : Line_Position; Destination_Left_Column : Column_Position; Destination_Bottom_Row : Line_Position; Destination_Right_Column : Column_Position; Non_Destructive_Mode : Boolean := True) is function Copywin (Src : Window; Dst : Window; Str : C_Int; Slc : C_Int; Dtr : C_Int; Dlc : C_Int; Dbr : C_Int; Drc : C_Int; Ndm : C_Int) return C_Int; pragma Import (C, Copywin, "copywin"); begin if Copywin (Source_Window, Destination_Window, C_Int (Source_Top_Row), C_Int (Source_Left_Column), C_Int (Destination_Top_Row), C_Int (Destination_Left_Column), C_Int (Destination_Bottom_Row), C_Int (Destination_Right_Column), Boolean'Pos (Non_Destructive_Mode) ) = Curses_Err then raise Curses_Exception; end if; end Copy; procedure Overwrite (Source_Window : Window; Destination_Window : Window) is function Overwrite (Src : Window; Dst : Window) return C_Int; pragma Import (C, Overwrite, "overwrite"); begin if Overwrite (Source_Window, Destination_Window) = Curses_Err then raise Curses_Exception; end if; end Overwrite; procedure Overlay (Source_Window : Window; Destination_Window : Window) is function Overlay (Src : Window; Dst : Window) return C_Int; pragma Import (C, Overlay, "overlay"); begin if Overlay (Source_Window, Destination_Window) = Curses_Err then raise Curses_Exception; end if; end Overlay; ------------------------------------------------------------------------------ procedure Insert_Delete_Lines (Win : Window := Standard_Window; Lines : Integer := 1) -- default is to insert one line above is function Winsdelln (W : Window; N : C_Int) return C_Int; pragma Import (C, Winsdelln, "winsdelln"); begin if Winsdelln (Win, C_Int (Lines)) = Curses_Err then raise Curses_Exception; end if; end Insert_Delete_Lines; procedure Delete_Line (Win : Window := Standard_Window) is begin Insert_Delete_Lines (Win, -1); end Delete_Line; procedure Insert_Line (Win : Window := Standard_Window) is begin Insert_Delete_Lines (Win, 1); end Insert_Line; ------------------------------------------------------------------------------ procedure Get_Size (Win : Window := Standard_Window; Number_Of_Lines : out Line_Count; Number_Of_Columns : out Column_Count) is function GetMaxY (W : Window) return C_Int; pragma Import (C, GetMaxY, "getmaxy"); function GetMaxX (W : Window) return C_Int; pragma Import (C, GetMaxX, "getmaxx"); Y : constant C_Int := GetMaxY (Win); X : constant C_Int := GetMaxX (Win); begin Number_Of_Lines := Line_Count (Y); Number_Of_Columns := Column_Count (X); end Get_Size; procedure Get_Window_Position (Win : Window := Standard_Window; Top_Left_Line : out Line_Position; Top_Left_Column : out Column_Position) is function GetBegY (W : Window) return C_Int; pragma Import (C, GetBegY, "getbegy"); function GetBegX (W : Window) return C_Int; pragma Import (C, GetBegX, "getbegx"); Y : constant C_Short := C_Short (GetBegY (Win)); X : constant C_Short := C_Short (GetBegX (Win)); begin Top_Left_Line := Line_Position (Y); Top_Left_Column := Column_Position (X); end Get_Window_Position; procedure Get_Cursor_Position (Win : Window := Standard_Window; Line : out Line_Position; Column : out Column_Position) is function GetCurY (W : Window) return C_Int; pragma Import (C, GetCurY, "getcury"); function GetCurX (W : Window) return C_Int; pragma Import (C, GetCurX, "getcurx"); Y : constant C_Short := C_Short (GetCurY (Win)); X : constant C_Short := C_Short (GetCurX (Win)); begin Line := Line_Position (Y); Column := Column_Position (X); end Get_Cursor_Position; procedure Get_Origin_Relative_To_Parent (Win : Window; Top_Left_Line : out Line_Position; Top_Left_Column : out Column_Position; Is_Not_A_Subwindow : out Boolean) is function GetParY (W : Window) return C_Int; pragma Import (C, GetParY, "getpary"); function GetParX (W : Window) return C_Int; pragma Import (C, GetParX, "getparx"); Y : constant C_Int := GetParY (Win); X : constant C_Int := GetParX (Win); begin if Y = -1 then Top_Left_Line := Line_Position'Last; Top_Left_Column := Column_Position'Last; Is_Not_A_Subwindow := True; else Top_Left_Line := Line_Position (Y); Top_Left_Column := Column_Position (X); Is_Not_A_Subwindow := False; end if; end Get_Origin_Relative_To_Parent; ------------------------------------------------------------------------------ function New_Pad (Lines : Line_Count; Columns : Column_Count) return Window is function Newpad (Lines : C_Int; Columns : C_Int) return Window; pragma Import (C, Newpad, "newpad"); W : Window; begin W := Newpad (C_Int (Lines), C_Int (Columns)); if W = Null_Window then raise Curses_Exception; end if; return W; end New_Pad; function Sub_Pad (Pad : Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count; First_Line_Position : Line_Position; First_Column_Position : Column_Position) return Window is function Subpad (Pad : Window; Number_Of_Lines : C_Int; Number_Of_Columns : C_Int; First_Line_Position : C_Int; First_Column_Position : C_Int) return Window; pragma Import (C, Subpad, "subpad"); W : Window; begin W := Subpad (Pad, C_Int (Number_Of_Lines), C_Int (Number_Of_Columns), C_Int (First_Line_Position), C_Int (First_Column_Position)); if W = Null_Window then raise Curses_Exception; end if; return W; end Sub_Pad; procedure Refresh (Pad : Window; Source_Top_Row : Line_Position; Source_Left_Column : Column_Position; Destination_Top_Row : Line_Position; Destination_Left_Column : Column_Position; Destination_Bottom_Row : Line_Position; Destination_Right_Column : Column_Position) is function Prefresh (Pad : Window; Source_Top_Row : C_Int; Source_Left_Column : C_Int; Destination_Top_Row : C_Int; Destination_Left_Column : C_Int; Destination_Bottom_Row : C_Int; Destination_Right_Column : C_Int) return C_Int; pragma Import (C, Prefresh, "prefresh"); begin if Prefresh (Pad, C_Int (Source_Top_Row), C_Int (Source_Left_Column), C_Int (Destination_Top_Row), C_Int (Destination_Left_Column), C_Int (Destination_Bottom_Row), C_Int (Destination_Right_Column)) = Curses_Err then raise Curses_Exception; end if; end Refresh; procedure Refresh_Without_Update (Pad : Window; Source_Top_Row : Line_Position; Source_Left_Column : Column_Position; Destination_Top_Row : Line_Position; Destination_Left_Column : Column_Position; Destination_Bottom_Row : Line_Position; Destination_Right_Column : Column_Position) is function Pnoutrefresh (Pad : Window; Source_Top_Row : C_Int; Source_Left_Column : C_Int; Destination_Top_Row : C_Int; Destination_Left_Column : C_Int; Destination_Bottom_Row : C_Int; Destination_Right_Column : C_Int) return C_Int; pragma Import (C, Pnoutrefresh, "pnoutrefresh"); begin if Pnoutrefresh (Pad, C_Int (Source_Top_Row), C_Int (Source_Left_Column), C_Int (Destination_Top_Row), C_Int (Destination_Left_Column), C_Int (Destination_Bottom_Row), C_Int (Destination_Right_Column)) = Curses_Err then raise Curses_Exception; end if; end Refresh_Without_Update; procedure Add_Character_To_Pad_And_Echo_It (Pad : Window; Ch : Attributed_Character) is function Pechochar (Pad : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, Pechochar, "pechochar"); begin if Pechochar (Pad, Ch) = Curses_Err then raise Curses_Exception; end if; end Add_Character_To_Pad_And_Echo_It; procedure Add_Character_To_Pad_And_Echo_It (Pad : Window; Ch : Character) is begin Add_Character_To_Pad_And_Echo_It (Pad, Attributed_Character'(Ch => Ch, Color => Color_Pair'First, Attr => Normal_Video)); end Add_Character_To_Pad_And_Echo_It; ------------------------------------------------------------------------------ procedure Scroll (Win : Window := Standard_Window; Amount : Integer := 1) is function Wscrl (Win : Window; N : C_Int) return C_Int; pragma Import (C, Wscrl, "wscrl"); begin if Wscrl (Win, C_Int (Amount)) = Curses_Err then raise Curses_Exception; end if; end Scroll; ------------------------------------------------------------------------------ procedure Delete_Character (Win : Window := Standard_Window) is function Wdelch (Win : Window) return C_Int; pragma Import (C, Wdelch, "wdelch"); begin if Wdelch (Win) = Curses_Err then raise Curses_Exception; end if; end Delete_Character; procedure Delete_Character (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position) is function Mvwdelch (Win : Window; Lin : C_Int; Col : C_Int) return C_Int; pragma Import (C, Mvwdelch, "mvwdelch"); begin if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then raise Curses_Exception; end if; end Delete_Character; ------------------------------------------------------------------------------ function Peek (Win : Window := Standard_Window) return Attributed_Character is function Winch (Win : Window) return Attributed_Character; pragma Import (C, Winch, "winch"); begin return Winch (Win); end Peek; function Peek (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position) return Attributed_Character is function Mvwinch (Win : Window; Lin : C_Int; Col : C_Int) return Attributed_Character; pragma Import (C, Mvwinch, "mvwinch"); begin return Mvwinch (Win, C_Int (Line), C_Int (Column)); end Peek; ------------------------------------------------------------------------------ procedure Insert (Win : Window := Standard_Window; Ch : Attributed_Character) is function Winsch (Win : Window; Ch : Attributed_Character) return C_Int; pragma Import (C, Winsch, "winsch"); begin if Winsch (Win, Ch) = Curses_Err then raise Curses_Exception; end if; end Insert; procedure Insert (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Ch : Attributed_Character) is function Mvwinsch (Win : Window; Lin : C_Int; Col : C_Int; Ch : Attributed_Character) return C_Int; pragma Import (C, Mvwinsch, "mvwinsch"); begin if Mvwinsch (Win, C_Int (Line), C_Int (Column), Ch) = Curses_Err then raise Curses_Exception; end if; end Insert; ------------------------------------------------------------------------------ procedure Insert (Win : Window := Standard_Window; Str : String; Len : Integer := -1) is function Winsnstr (Win : Window; Str : char_array; Len : Integer := -1) return C_Int; pragma Import (C, Winsnstr, "winsnstr"); Txt : char_array (0 .. Str'Length); Length : size_t; begin To_C (Str, Txt, Length); if Winsnstr (Win, Txt, Len) = Curses_Err then raise Curses_Exception; end if; end Insert; procedure Insert (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : String; Len : Integer := -1) is function Mvwinsnstr (Win : Window; Line : C_Int; Column : C_Int; Str : char_array; Len : C_Int) return C_Int; pragma Import (C, Mvwinsnstr, "mvwinsnstr"); Txt : char_array (0 .. Str'Length); Length : size_t; begin To_C (Str, Txt, Length); if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len)) = Curses_Err then raise Curses_Exception; end if; end Insert; ------------------------------------------------------------------------------ procedure Peek (Win : Window := Standard_Window; Str : out String; Len : Integer := -1) is function Winnstr (Win : Window; Str : char_array; Len : C_Int) return C_Int; pragma Import (C, Winnstr, "winnstr"); N : Integer := Len; Txt : char_array (0 .. Str'Length); Cnt : Natural; begin if N < 0 then N := Str'Length; end if; if N > Str'Length then raise Constraint_Error; end if; Txt (0) := Interfaces.C.char'First; if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then raise Curses_Exception; end if; To_Ada (Txt, Str, Cnt, True); if Cnt < Str'Length then Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); end if; end Peek; procedure Peek (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : out String; Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Peek (Win, Str, Len); end Peek; ------------------------------------------------------------------------------ procedure Peek (Win : Window := Standard_Window; Str : out Attributed_String; Len : Integer := -1) is function Winchnstr (Win : Window; Str : chtype_array; -- out Len : C_Int) return C_Int; pragma Import (C, Winchnstr, "winchnstr"); N : Integer := Len; Txt : constant chtype_array (0 .. Str'Length) := (0 => Default_Character); Cnt : Natural := 0; begin if N < 0 then N := Str'Length; end if; if N > Str'Length then raise Constraint_Error; end if; if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then raise Curses_Exception; end if; for To in Str'Range loop exit when Txt (size_t (Cnt)) = Default_Character; Str (To) := Txt (size_t (Cnt)); Cnt := Cnt + 1; end loop; if Cnt < Str'Length then Str ((Str'First + Cnt) .. Str'Last) := (others => (Ch => ' ', Color => Color_Pair'First, Attr => Normal_Video)); end if; end Peek; procedure Peek (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : out Attributed_String; Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Peek (Win, Str, Len); end Peek; ------------------------------------------------------------------------------ procedure Get (Win : Window := Standard_Window; Str : out String; Len : Integer := -1) is function Wgetnstr (Win : Window; Str : char_array; Len : C_Int) return C_Int; pragma Import (C, Wgetnstr, "wgetnstr"); N : Integer := Len; Txt : char_array (0 .. Str'Length); Cnt : Natural; begin if N < 0 then N := Str'Length; end if; if N > Str'Length then raise Constraint_Error; end if; Txt (0) := Interfaces.C.char'First; if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then raise Curses_Exception; end if; To_Ada (Txt, Str, Cnt, True); if Cnt < Str'Length then Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); end if; end Get; procedure Get (Win : Window := Standard_Window; Line : Line_Position; Column : Column_Position; Str : out String; Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Get (Win, Str, Len); end Get; ------------------------------------------------------------------------------ procedure Init_Soft_Label_Keys (Format : Soft_Label_Key_Format := Three_Two_Three) is function Slk_Init (Fmt : C_Int) return C_Int; pragma Import (C, Slk_Init, "slk_init"); begin if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then raise Curses_Exception; end if; end Init_Soft_Label_Keys; procedure Set_Soft_Label_Key (Label : Label_Number; Text : String; Fmt : Label_Justification := Left) is function Slk_Set (Label : C_Int; Txt : char_array; Fmt : C_Int) return C_Int; pragma Import (C, Slk_Set, "slk_set"); Txt : char_array (0 .. Text'Length); Len : size_t; begin To_C (Text, Txt, Len); if Slk_Set (C_Int (Label), Txt, C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then raise Curses_Exception; end if; end Set_Soft_Label_Key; procedure Refresh_Soft_Label_Keys is function Slk_Refresh return C_Int; pragma Import (C, Slk_Refresh, "slk_refresh"); begin if Slk_Refresh = Curses_Err then raise Curses_Exception; end if; end Refresh_Soft_Label_Keys; procedure Refresh_Soft_Label_Keys_Without_Update is function Slk_Noutrefresh return C_Int; pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh"); begin if Slk_Noutrefresh = Curses_Err then raise Curses_Exception; end if; end Refresh_Soft_Label_Keys_Without_Update; procedure Get_Soft_Label_Key (Label : Label_Number; Text : out String) is function Slk_Label (Label : C_Int) return chars_ptr; pragma Import (C, Slk_Label, "slk_label"); begin Fill_String (Slk_Label (C_Int (Label)), Text); end Get_Soft_Label_Key; function Get_Soft_Label_Key (Label : Label_Number) return String is function Slk_Label (Label : C_Int) return chars_ptr; pragma Import (C, Slk_Label, "slk_label"); begin return Fill_String (Slk_Label (C_Int (Label))); end Get_Soft_Label_Key; procedure Clear_Soft_Label_Keys is function Slk_Clear return C_Int; pragma Import (C, Slk_Clear, "slk_clear"); begin if Slk_Clear = Curses_Err then raise Curses_Exception; end if; end Clear_Soft_Label_Keys; procedure Restore_Soft_Label_Keys is function Slk_Restore return C_Int; pragma Import (C, Slk_Restore, "slk_restore"); begin if Slk_Restore = Curses_Err then raise Curses_Exception; end if; end Restore_Soft_Label_Keys; procedure Touch_Soft_Label_Keys is function Slk_Touch return C_Int; pragma Import (C, Slk_Touch, "slk_touch"); begin if Slk_Touch = Curses_Err then raise Curses_Exception; end if; end Touch_Soft_Label_Keys; procedure Switch_Soft_Label_Key_Attributes (Attr : Character_Attribute_Set; On : Boolean := True) is function Slk_Attron (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attron, "slk_attron"); function Slk_Attroff (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attroff, "slk_attroff"); Err : C_Int; Ch : constant Attributed_Character := (Ch => Character'First, Attr => Attr, Color => Color_Pair'First); begin if On then Err := Slk_Attron (Ch); else Err := Slk_Attroff (Ch); end if; if Err = Curses_Err then raise Curses_Exception; end if; end Switch_Soft_Label_Key_Attributes; procedure Set_Soft_Label_Key_Attributes (Attr : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Slk_Attrset (Ch : Attributed_Character) return C_Int; pragma Import (C, Slk_Attrset, "slk_attrset"); Ch : constant Attributed_Character := (Ch => Character'First, Attr => Attr, Color => Color); begin if Slk_Attrset (Ch) = Curses_Err then raise Curses_Exception; end if; end Set_Soft_Label_Key_Attributes; function Get_Soft_Label_Key_Attributes return Character_Attribute_Set is function Slk_Attr return Attributed_Character; pragma Import (C, Slk_Attr, "slk_attr"); Attr : constant Attributed_Character := Slk_Attr; begin return Attr.Attr; end Get_Soft_Label_Key_Attributes; function Get_Soft_Label_Key_Attributes return Color_Pair is function Slk_Attr return Attributed_Character; pragma Import (C, Slk_Attr, "slk_attr"); Attr : constant Attributed_Character := Slk_Attr; begin return Attr.Color; end Get_Soft_Label_Key_Attributes; procedure Set_Soft_Label_Key_Color (Pair : Color_Pair) is function Slk_Color (Color : C_Short) return C_Int; pragma Import (C, Slk_Color, "slk_color"); begin if Slk_Color (C_Short (Pair)) = Curses_Err then raise Curses_Exception; end if; end Set_Soft_Label_Key_Color; ------------------------------------------------------------------------------ procedure Enable_Key (Key : Special_Key_Code; Enable : Boolean := True) is function Keyok (Keycode : C_Int; On_Off : Curses_Bool) return C_Int; pragma Import (C, Keyok, "keyok"); begin if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable))) = Curses_Err then raise Curses_Exception; end if; end Enable_Key; ------------------------------------------------------------------------------ procedure Define_Key (Definition : String; Key : Special_Key_Code) is function Defkey (Def : char_array; Key : C_Int) return C_Int; pragma Import (C, Defkey, "define_key"); Txt : char_array (0 .. Definition'Length); Length : size_t; begin To_C (Definition, Txt, Length); if Defkey (Txt, C_Int (Key)) = Curses_Err then raise Curses_Exception; end if; end Define_Key; ------------------------------------------------------------------------------ procedure Un_Control (Ch : Attributed_Character; Str : out String) is function Unctrl (Ch : Attributed_Character) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin Fill_String (Unctrl (Ch), Str); end Un_Control; function Un_Control (Ch : Attributed_Character) return String is function Unctrl (Ch : Attributed_Character) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin return Fill_String (Unctrl (Ch)); end Un_Control; procedure Delay_Output (Msecs : Natural) is function Delayoutput (Msecs : C_Int) return C_Int; pragma Import (C, Delayoutput, "delay_output"); begin if Delayoutput (C_Int (Msecs)) = Curses_Err then raise Curses_Exception; end if; end Delay_Output; procedure Flush_Input is function Flushinp return C_Int; pragma Import (C, Flushinp, "flushinp"); begin if Flushinp = Curses_Err then -- docu says that never happens, but... raise Curses_Exception; end if; end Flush_Input; ------------------------------------------------------------------------------ function Baudrate return Natural is function Baud return C_Int; pragma Import (C, Baud, "baudrate"); begin return Natural (Baud); end Baudrate; function Erase_Character return Character is function Erasechar return C_Int; pragma Import (C, Erasechar, "erasechar"); begin return Character'Val (Erasechar); end Erase_Character; function Kill_Character return Character is function Killchar return C_Int; pragma Import (C, Killchar, "killchar"); begin return Character'Val (Killchar); end Kill_Character; function Has_Insert_Character return Boolean is function Has_Ic return Curses_Bool; pragma Import (C, Has_Ic, "has_ic"); begin if Has_Ic = Curses_Bool_False then return False; else return True; end if; end Has_Insert_Character; function Has_Insert_Line return Boolean is function Has_Il return Curses_Bool; pragma Import (C, Has_Il, "has_il"); begin if Has_Il = Curses_Bool_False then return False; else return True; end if; end Has_Insert_Line; function Supported_Attributes return Character_Attribute_Set is function Termattrs return Attributed_Character; pragma Import (C, Termattrs, "termattrs"); Ch : constant Attributed_Character := Termattrs; begin return Ch.Attr; end Supported_Attributes; procedure Long_Name (Name : out String) is function Longname return chars_ptr; pragma Import (C, Longname, "longname"); begin Fill_String (Longname, Name); end Long_Name; function Long_Name return String is function Longname return chars_ptr; pragma Import (C, Longname, "longname"); begin return Fill_String (Longname); end Long_Name; procedure Terminal_Name (Name : out String) is function Termname return chars_ptr; pragma Import (C, Termname, "termname"); begin Fill_String (Termname, Name); end Terminal_Name; function Terminal_Name return String is function Termname return chars_ptr; pragma Import (C, Termname, "termname"); begin return Fill_String (Termname); end Terminal_Name; ------------------------------------------------------------------------------ procedure Init_Pair (Pair : Redefinable_Color_Pair; Fore : Color_Number; Back : Color_Number) is function Initpair (Pair : C_Short; Fore : C_Short; Back : C_Short) return C_Int; pragma Import (C, Initpair, "init_pair"); begin if Integer (Pair) >= Number_Of_Color_Pairs then raise Constraint_Error; end if; if Integer (Fore) >= Number_Of_Colors or else Integer (Back) >= Number_Of_Colors then raise Constraint_Error; end if; if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back)) = Curses_Err then raise Curses_Exception; end if; end Init_Pair; procedure Pair_Content (Pair : Color_Pair; Fore : out Color_Number; Back : out Color_Number) is type C_Short_Access is access all C_Short; function Paircontent (Pair : C_Short; Fp : C_Short_Access; Bp : C_Short_Access) return C_Int; pragma Import (C, Paircontent, "pair_content"); F, B : aliased C_Short; begin if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then raise Curses_Exception; else Fore := Color_Number (F); Back := Color_Number (B); end if; end Pair_Content; function Has_Colors return Boolean is function Hascolors return Curses_Bool; pragma Import (C, Hascolors, "has_colors"); begin if Hascolors = Curses_Bool_False then return False; else return True; end if; end Has_Colors; procedure Init_Color (Color : Color_Number; Red : RGB_Value; Green : RGB_Value; Blue : RGB_Value) is function Initcolor (Col : C_Short; Red : C_Short; Green : C_Short; Blue : C_Short) return C_Int; pragma Import (C, Initcolor, "init_color"); begin if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green), C_Short (Blue)) = Curses_Err then raise Curses_Exception; end if; end Init_Color; function Can_Change_Color return Boolean is function Canchangecolor return Curses_Bool; pragma Import (C, Canchangecolor, "can_change_color"); begin if Canchangecolor = Curses_Bool_False then return False; else return True; end if; end Can_Change_Color; procedure Color_Content (Color : Color_Number; Red : out RGB_Value; Green : out RGB_Value; Blue : out RGB_Value) is type C_Short_Access is access all C_Short; function Colorcontent (Color : C_Short; R, G, B : C_Short_Access) return C_Int; pragma Import (C, Colorcontent, "color_content"); R, G, B : aliased C_Short; begin if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) = Curses_Err then raise Curses_Exception; else Red := RGB_Value (R); Green := RGB_Value (G); Blue := RGB_Value (B); end if; end Color_Content; ------------------------------------------------------------------------------ procedure Save_Curses_Mode (Mode : Curses_Mode) is function Def_Prog_Mode return C_Int; pragma Import (C, Def_Prog_Mode, "def_prog_mode"); function Def_Shell_Mode return C_Int; pragma Import (C, Def_Shell_Mode, "def_shell_mode"); Err : C_Int; begin case Mode is when Curses => Err := Def_Prog_Mode; when Shell => Err := Def_Shell_Mode; end case; if Err = Curses_Err then raise Curses_Exception; end if; end Save_Curses_Mode; procedure Reset_Curses_Mode (Mode : Curses_Mode) is function Reset_Prog_Mode return C_Int; pragma Import (C, Reset_Prog_Mode, "reset_prog_mode"); function Reset_Shell_Mode return C_Int; pragma Import (C, Reset_Shell_Mode, "reset_shell_mode"); Err : C_Int; begin case Mode is when Curses => Err := Reset_Prog_Mode; when Shell => Err := Reset_Shell_Mode; end case; if Err = Curses_Err then raise Curses_Exception; end if; end Reset_Curses_Mode; procedure Save_Terminal_State is function Savetty return C_Int; pragma Import (C, Savetty, "savetty"); begin if Savetty = Curses_Err then raise Curses_Exception; end if; end Save_Terminal_State; procedure Reset_Terminal_State is function Resetty return C_Int; pragma Import (C, Resetty, "resetty"); begin if Resetty = Curses_Err then raise Curses_Exception; end if; end Reset_Terminal_State; procedure Rip_Off_Lines (Lines : Integer; Proc : Stdscr_Init_Proc) is function Ripoffline (Lines : C_Int; Proc : Stdscr_Init_Proc) return C_Int; pragma Import (C, Ripoffline, "_nc_ripoffline"); begin if Ripoffline (C_Int (Lines), Proc) = Curses_Err then raise Curses_Exception; end if; end Rip_Off_Lines; procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility) is function Curs_Set (Curs : C_Int) return C_Int; pragma Import (C, Curs_Set, "curs_set"); Res : C_Int; begin Res := Curs_Set (Cursor_Visibility'Pos (Visibility)); if Res /= Curses_Err then Visibility := Cursor_Visibility'Val (Res); end if; end Set_Cursor_Visibility; procedure Nap_Milli_Seconds (Ms : Natural) is function Napms (Ms : C_Int) return C_Int; pragma Import (C, Napms, "napms"); begin if Napms (C_Int (Ms)) = Curses_Err then raise Curses_Exception; end if; end Nap_Milli_Seconds; ------------------------------------------------------------------------------ function Lines return Line_Count is function LINES_As_Function return Interfaces.C.int; pragma Import (C, LINES_As_Function, "LINES_as_function"); begin return Line_Count (LINES_As_Function); end Lines; function Columns return Column_Count is function COLS_As_Function return Interfaces.C.int; pragma Import (C, COLS_As_Function, "COLS_as_function"); begin return Column_Count (COLS_As_Function); end Columns; function Tab_Size return Natural is function TABSIZE_As_Function return Interfaces.C.int; pragma Import (C, TABSIZE_As_Function, "TABSIZE_as_function"); begin return Natural (TABSIZE_As_Function); end Tab_Size; function Number_Of_Colors return Natural is function COLORS_As_Function return Interfaces.C.int; pragma Import (C, COLORS_As_Function, "COLORS_as_function"); begin return Natural (COLORS_As_Function); end Number_Of_Colors; function Number_Of_Color_Pairs return Natural is function COLOR_PAIRS_As_Function return Interfaces.C.int; pragma Import (C, COLOR_PAIRS_As_Function, "COLOR_PAIRS_as_function"); begin return Natural (COLOR_PAIRS_As_Function); end Number_Of_Color_Pairs; ------------------------------------------------------------------------------ procedure Transform_Coordinates (W : Window := Standard_Window; Line : in out Line_Position; Column : in out Column_Position; Dir : Transform_Direction := From_Screen) is type Int_Access is access all C_Int; function Transform (W : Window; Y, X : Int_Access; Dir : Curses_Bool) return C_Int; pragma Import (C, Transform, "wmouse_trafo"); X : aliased C_Int := C_Int (Column); Y : aliased C_Int := C_Int (Line); D : Curses_Bool := Curses_Bool_False; R : C_Int; begin if Dir = To_Screen then D := 1; end if; R := Transform (W, Y'Access, X'Access, D); if R = Curses_False then raise Curses_Exception; else Line := Line_Position (Y); Column := Column_Position (X); end if; end Transform_Coordinates; ------------------------------------------------------------------------------ procedure Use_Default_Colors is function C_Use_Default_Colors return C_Int; pragma Import (C, C_Use_Default_Colors, "use_default_colors"); Err : constant C_Int := C_Use_Default_Colors; begin if Err = Curses_Err then raise Curses_Exception; end if; end Use_Default_Colors; procedure Assume_Default_Colors (Fore : Color_Number := Default_Color; Back : Color_Number := Default_Color) is function C_Assume_Default_Colors (Fore : C_Int; Back : C_Int) return C_Int; pragma Import (C, C_Assume_Default_Colors, "assume_default_colors"); Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore), C_Int (Back)); begin if Err = Curses_Err then raise Curses_Exception; end if; end Assume_Default_Colors; ------------------------------------------------------------------------------ function Curses_Version return String is function curses_versionC return chars_ptr; pragma Import (C, curses_versionC, "curses_version"); Result : constant chars_ptr := curses_versionC; begin return Fill_String (Result); end Curses_Version; ------------------------------------------------------------------------------ procedure Curses_Free_All is procedure curses_freeall; pragma Import (C, curses_freeall, "_nc_freeall"); begin -- Use this only for testing: you cannot use curses after calling it, -- so it has to be the "last" thing done before exiting the program. -- This will not really free ALL of memory used by curses. That is -- because it cannot free the memory used for stdout's setbuf. The -- _nc_free_and_exit() procedure can do that, but it can be invoked -- safely only from C - and again, that only as the "last" thing done -- before exiting the program. curses_freeall; end Curses_Free_All; ------------------------------------------------------------------------------ function Use_Extended_Names (Enable : Boolean) return Boolean is function use_extended_namesC (e : Curses_Bool) return C_Int; pragma Import (C, use_extended_namesC, "use_extended_names"); Res : constant C_Int := use_extended_namesC (Curses_Bool (Boolean'Pos (Enable))); begin if Res = C_Int (Curses_Bool_False) then return False; else return True; end if; end Use_Extended_Names; ------------------------------------------------------------------------------ procedure Screen_Dump_To_File (Filename : String) is function scr_dump (f : char_array) return C_Int; pragma Import (C, scr_dump, "scr_dump"); Txt : char_array (0 .. Filename'Length); Length : size_t; begin To_C (Filename, Txt, Length); if Curses_Err = scr_dump (Txt) then raise Curses_Exception; end if; end Screen_Dump_To_File; procedure Screen_Restore_From_File (Filename : String) is function scr_restore (f : char_array) return C_Int; pragma Import (C, scr_restore, "scr_restore"); Txt : char_array (0 .. Filename'Length); Length : size_t; begin To_C (Filename, Txt, Length); if Curses_Err = scr_restore (Txt) then raise Curses_Exception; end if; end Screen_Restore_From_File; procedure Screen_Init_From_File (Filename : String) is function scr_init (f : char_array) return C_Int; pragma Import (C, scr_init, "scr_init"); Txt : char_array (0 .. Filename'Length); Length : size_t; begin To_C (Filename, Txt, Length); if Curses_Err = scr_init (Txt) then raise Curses_Exception; end if; end Screen_Init_From_File; procedure Screen_Set_File (Filename : String) is function scr_set (f : char_array) return C_Int; pragma Import (C, scr_set, "scr_set"); Txt : char_array (0 .. Filename'Length); Length : size_t; begin To_C (Filename, Txt, Length); if Curses_Err = scr_set (Txt) then raise Curses_Exception; end if; end Screen_Set_File; ------------------------------------------------------------------------------ procedure Resize (Win : Window := Standard_Window; Number_Of_Lines : Line_Count; Number_Of_Columns : Column_Count) is function wresize (win : Window; lines : C_Int; columns : C_Int) return C_Int; pragma Import (C, wresize); begin if wresize (Win, C_Int (Number_Of_Lines), C_Int (Number_Of_Columns)) = Curses_Err then raise Curses_Exception; end if; end Resize; ------------------------------------------------------------------------------ end Terminal_Interface.Curses;AdaCurses-20211021/doc/ada/terminal_interface-curses-mouse__adb.htm 0000644 0001751 0000144 00000072474 13707131167 023615 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Mouse -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 1999-2009,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.28 @ -- @Date: 2020/06/27 18:50:44 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; use Interfaces; package body Terminal_Interface.Curses.Mouse is function Has_Mouse return Boolean is function Mouse_Avail return C_Int; pragma Import (C, Mouse_Avail, "has_mouse"); begin if Has_Key (Key_Mouse) or else Mouse_Avail /= 0 then return True; else return False; end if; end Has_Mouse; function Get_Mouse return Mouse_Event is type Event_Access is access all Mouse_Event; function Getmouse (Ev : Event_Access) return C_Int; pragma Import (C, Getmouse, "getmouse"); Event : aliased Mouse_Event; begin if Getmouse (Event'Access) = Curses_Err then raise Curses_Exception; end if; return Event; end Get_Mouse; procedure Register_Reportable_Event (Button : Mouse_Button; State : Button_State; Mask : in out Event_Mask) is Button_Nr : constant Natural := Mouse_Button'Pos (Button); State_Nr : constant Natural := Button_State'Pos (State); begin if Button in Modifier_Keys and then State /= Pressed then raise Curses_Exception; else if Button in Real_Buttons then Mask := Mask or ((2 ** (6 * Button_Nr)) ** State_Nr); else Mask := Mask or (BUTTON_CTRL ** (Button_Nr - 4)); end if; end if; end Register_Reportable_Event; procedure Register_Reportable_Events (Button : Mouse_Button; State : Button_States; Mask : in out Event_Mask) is begin for S in Button_States'Range loop if State (S) then Register_Reportable_Event (Button, S, Mask); end if; end loop; end Register_Reportable_Events; function Start_Mouse (Mask : Event_Mask := All_Events) return Event_Mask is function MMask (M : Event_Mask; O : access Event_Mask) return Event_Mask; pragma Import (C, MMask, "mousemask"); R : Event_Mask; Old : aliased Event_Mask; begin R := MMask (Mask, Old'Access); if R = No_Events then Beep; end if; return Old; end Start_Mouse; procedure End_Mouse (Mask : Event_Mask := No_Events) is begin if Mask /= No_Events then Beep; end if; end End_Mouse; procedure Dispatch_Event (Mask : Event_Mask; Button : out Mouse_Button; State : out Button_State); procedure Dispatch_Event (Mask : Event_Mask; Button : out Mouse_Button; State : out Button_State) is L : Event_Mask; begin Button := Alt; -- preset to non real button; if (Mask and BUTTON1_EVENTS) /= 0 then Button := Left; elsif (Mask and BUTTON2_EVENTS) /= 0 then Button := Middle; elsif (Mask and BUTTON3_EVENTS) /= 0 then Button := Right; elsif (Mask and BUTTON4_EVENTS) /= 0 then Button := Button4; end if; if Button in Real_Buttons then State := Released; -- preset to non real button; L := 2 ** (6 * Mouse_Button'Pos (Button)); for I in Button_State'Range loop if (Mask and L) /= 0 then State := I; exit; end if; L := 2 * L; end loop; else State := Pressed; if (Mask and BUTTON_CTRL) /= 0 then Button := Control; elsif (Mask and BUTTON_SHIFT) /= 0 then Button := Shift; elsif (Mask and BUTTON_ALT) /= 0 then Button := Alt; end if; end if; end Dispatch_Event; procedure Get_Event (Event : Mouse_Event; Y : out Line_Position; X : out Column_Position; Button : out Mouse_Button; State : out Button_State) is Mask : constant Event_Mask := Event.Bstate; begin X := Column_Position (Event.X); Y := Line_Position (Event.Y); Dispatch_Event (Mask, Button, State); end Get_Event; procedure Unget_Mouse (Event : Mouse_Event) is function Ungetmouse (Ev : Mouse_Event) return C_Int; pragma Import (C, Ungetmouse, "ungetmouse"); begin if Ungetmouse (Event) = Curses_Err then raise Curses_Exception; end if; end Unget_Mouse; function Enclosed_In_Window (Win : Window := Standard_Window; Event : Mouse_Event) return Boolean is function Wenclose (Win : Window; Y : C_Int; X : C_Int) return Curses_Bool; pragma Import (C, Wenclose, "wenclose"); begin if Wenclose (Win, C_Int (Event.Y), C_Int (Event.X)) = Curses_Bool_False then return False; else return True; end if; end Enclosed_In_Window; function Mouse_Interval (Msec : Natural := 200) return Natural is function Mouseinterval (Msec : C_Int) return C_Int; pragma Import (C, Mouseinterval, "mouseinterval"); begin return Natural (Mouseinterval (C_Int (Msec))); end Mouse_Interval; end Terminal_Interface.Curses.Mouse;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-decimal_io__ads.htm 0000644 0001751 0000144 00000022206 13615673306 026234 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Decimal_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type Num is delta <> digits <>; package Terminal_Interface.Curses.Text_IO.Decimal_IO is Default_Fore : Field := Num'Fore; Default_Aft : Field := Num'Aft; Default_Exp : Field := 0; procedure Put (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); procedure Put (Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); private pragma Inline (Put); end Terminal_Interface.Curses.Text_IO.Decimal_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-menus-menu_user_data__adb.htm 0000644 0001751 0000144 00000024116 13615673306 026577 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Menus.Menu_User_Data -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 1999-2009,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.17 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Menus.Menu_User_Data is procedure Set_User_Data (Men : Menu; Data : User_Access) is function Set_Menu_Userptr (Men : Menu; Data : User_Access) return Eti_Error; pragma Import (C, Set_Menu_Userptr, "set_menu_userptr"); begin Eti_Exception (Set_Menu_Userptr (Men, Data)); end Set_User_Data; function Get_User_Data (Men : Menu) return User_Access is function Menu_Userptr (Men : Menu) return User_Access; pragma Import (C, Menu_Userptr, "menu_userptr"); begin return Menu_Userptr (Men); end Get_User_Data; procedure Get_User_Data (Men : Menu; Data : out User_Access) is begin Data := Get_User_Data (Men); end Get_User_Data; end Terminal_Interface.Curses.Menus.Menu_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-user__ads.htm 0000644 0001751 0000144 00000030414 13615673306 027105 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.User -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2009,2011 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.16 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; package Terminal_Interface.Curses.Forms.Field_Types.User is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.User); subtype C_Int is Interfaces.C.int; type User_Defined_Field_Type is abstract new Field_Type with null record; -- This is the root of the mechanism we use to create field types in -- Ada95. You should your own type derive from this one and implement -- the Field_Check and Character_Check functions for your own type. type User_Defined_Field_Type_Access is access all User_Defined_Field_Type'Class; function Field_Check (Fld : Field; Typ : User_Defined_Field_Type) return Boolean is abstract; -- If True is returned, the field is considered valid, otherwise it is -- invalid. function Character_Check (Ch : Character; Typ : User_Defined_Field_Type) return Boolean is abstract; -- If True is returned, the character is considered as valid for the -- field, otherwise as invalid. procedure Set_Field_Type (Fld : Field; Typ : User_Defined_Field_Type); -- This should work for all types derived from User_Defined_Field_Type. -- No need to reimplement it for your derived type. -- +---------------------------------------------------------------------- -- | Private Part. -- | Used by the Choice child package. private function C_Generic_Type return C_Field_Type; function Generic_Field_Check (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Field_Check); -- This is the generic Field_Check_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Field_Check implementation for the type. function Generic_Char_Check (Ch : C_Int; Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Char_Check); -- This is the generic Char_Check_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Character_Check implementation for the type. end Terminal_Interface.Curses.Forms.Field_Types.User;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io__ads.htm 0000644 0001751 0000144 00000043673 13615673306 024164 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.15 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; with Ada.IO_Exceptions; package Terminal_Interface.Curses.Text_IO is use type Ada.Text_IO.Count; subtype Count is Ada.Text_IO.Count; subtype Positive_Count is Count range 1 .. Count'Last; subtype Field is Ada.Text_IO.Field; subtype Number_Base is Integer range 2 .. 16; type Type_Set is (Lower_Case, Upper_Case, Mixed_Case); -- For most of the routines you will see a version without a Window -- type parameter. They will operate on a default window, which can -- be set by the user. It is initially equal to Standard_Window. procedure Set_Window (Win : Window); -- Set Win as the default window function Get_Window return Window; -- Get the current default window procedure Flush (Win : Window); procedure 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; function Line_Length return Count; function Page_Length (Win : Window) return Count; function Page_Length return Count; ------------------------------------ -- Column, Line, and Page Control -- ------------------------------------ procedure New_Line (Win : Window; Spacing : Positive_Count := 1); procedure New_Line (Spacing : Positive_Count := 1); procedure New_Page (Win : Window); procedure New_Page; procedure Set_Col (Win : Window; To : Positive_Count); procedure Set_Col (To : Positive_Count); procedure Set_Line (Win : Window; To : Positive_Count); procedure Set_Line (To : Positive_Count); function Col (Win : Window) return Positive_Count; function Col return Positive_Count; function Line (Win : Window) return Positive_Count; function Line return Positive_Count; ----------------------- -- Characters-Output -- ----------------------- procedure Put (Win : Window; Item : Character); procedure Put (Item : Character); -------------------- -- Strings-Output -- -------------------- procedure Put (Win : Window; Item : String); procedure Put (Item : String); procedure Put_Line (Win : Window; Item : String); procedure Put_Line (Item : String); -- Exceptions Status_Error : exception renames Ada.IO_Exceptions.Status_Error; Mode_Error : exception renames Ada.IO_Exceptions.Mode_Error; Name_Error : exception renames Ada.IO_Exceptions.Name_Error; Use_Error : exception renames Ada.IO_Exceptions.Use_Error; Device_Error : exception renames Ada.IO_Exceptions.Device_Error; End_Error : exception renames Ada.IO_Exceptions.End_Error; Data_Error : exception renames Ada.IO_Exceptions.Data_Error; Layout_Error : exception renames Ada.IO_Exceptions.Layout_Error; end Terminal_Interface.Curses.Text_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-enumeration-ada__adb.htm 0000644 0001751 0000144 00000033136 13615673306 031163 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2004,2011 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.12 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Characters.Handling; use Ada.Characters.Handling; package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is function Create (Set : Type_Set := Mixed_Case; Case_Sensitive : Boolean := False; Must_Be_Unique : Boolean := False) return Enumeration_Field is I : Enumeration_Info (T'Pos (T'Last) - T'Pos (T'First) + 1); J : Positive := 1; begin I.Case_Sensitive := Case_Sensitive; I.Match_Must_Be_Unique := Must_Be_Unique; for E in T'Range loop I.Names (J) := new String'(T'Image (E)); -- The Image attribute defaults to upper case, so we have to handle -- only the other ones... if Set /= Upper_Case then I.Names (J).all := To_Lower (I.Names (J).all); if Set = Mixed_Case then I.Names (J).all (I.Names (J).all'First) := To_Upper (I.Names (J).all (I.Names (J).all'First)); end if; end if; J := J + 1; end loop; return Create (I, True); end Create; function Value (Fld : Field; Buf : Buffer_Number := Buffer_Number'First) return T is begin return T'Value (Get_Buffer (Fld, Buf)); end Value; end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada;AdaCurses-20211021/doc/ada/index.htm 0000644 0001751 0000144 00000002201 12145772562 015456 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Numeric -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Forms.Field_Types.Numeric is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Numeric); type Numeric_Field is new Field_Type with record Precision : Natural; Lower_Limit : Float; Upper_Limit : Float; end record; procedure Set_Field_Type (Fld : Field; Typ : Numeric_Field); pragma Inline (Set_Field_Type); end Terminal_Interface.Curses.Forms.Field_Types.Numeric;AdaCurses-20211021/doc/ada/terminal_interface-curses-termcap__ads.htm 0000644 0001751 0000144 00000022716 13615673306 024137 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Termcap -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2000-2002,2003 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.5 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Termcap is pragma Preelaborate (Terminal_Interface.Curses.Termcap); -- |===================================================================== -- | Man page curs_termcap.3x -- |===================================================================== -- Not implemented: tputs (see curs_terminfo) type Termcap_String is new String; -- | function TGoto (Cap : String; Col : Column_Position; Row : Line_Position) return Termcap_String; -- AKA: tgoto() -- | function Get_Entry (Name : String) return Boolean; -- AKA: tgetent() -- | function Get_Flag (Name : String) return Boolean; -- AKA: tgetflag() -- | procedure Get_Number (Name : String; Value : out Integer; Result : out Boolean); -- AKA: tgetnum() -- | procedure Get_String (Name : String; Value : out String; Result : out Boolean); function Get_String (Name : String) return Boolean; -- Returns True if the string is found. -- AKA: tgetstr() end Terminal_Interface.Curses.Termcap;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-aux__adb.htm 0000644 0001751 0000144 00000040772 13615673306 024733 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Aux -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2006,2009 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.14 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package body Terminal_Interface.Curses.Text_IO.Aux is procedure Put_Buf (Win : Window; Buf : String; Width : Field; Signal : Boolean := True; Ljust : Boolean := False) is L : Field; Len : Field; W : Field := Width; LC : Line_Count; CC : Column_Count; Y : Line_Position; X : Column_Position; procedure Output (From, To : Field); procedure Output (From, To : Field) is begin if Len > 0 then if W = 0 then W := Len; end if; if Len > W then -- LRM A10.6 (7) says this W := Len; end if; pragma Assert (Len <= W); Get_Size (Win, LC, CC); if Column_Count (Len) > CC then if Signal then raise Layout_Error; else return; end if; else if Len < W and then not Ljust then declare Filler : constant String (1 .. (W - Len)) := (others => ' '); begin Put (Win, Filler); end; end if; Get_Cursor_Position (Win, Y, X); if (X + Column_Position (Len)) > CC then New_Line (Win); end if; Put (Win, Buf (From .. To)); if Len < W and then Ljust then declare Filler : constant String (1 .. (W - Len)) := (others => ' '); begin Put (Win, Filler); end; end if; end if; end if; end Output; begin pragma Assert (Win /= Null_Window); if Ljust then L := 1; for I in 1 .. Buf'Length loop exit when Buf (L) = ' '; L := L + 1; end loop; Len := L - 1; Output (1, Len); else -- input buffer is not left justified L := Buf'Length; for I in 1 .. Buf'Length loop exit when Buf (L) = ' '; L := L - 1; end loop; Len := Buf'Length - L; Output (L + 1, Buf'Length); end if; end Put_Buf; end Terminal_Interface.Curses.Text_IO.Aux;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-float_io__ads.htm 0000644 0001751 0000144 00000021764 13615673306 025753 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Float_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type Num is digits <>; package Terminal_Interface.Curses.Text_IO.Float_IO is Default_Fore : Field := 2; Default_Aft : Field := Num'Digits - 1; Default_Exp : Field := 3; procedure Put (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); procedure Put (Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); private pragma Inline (Put); end Terminal_Interface.Curses.Text_IO.Float_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-enumeration__ads.htm 0000644 0001751 0000144 00000030324 13615673306 030455 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.15 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C.Strings; package Terminal_Interface.Curses.Forms.Field_Types.Enumeration is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Enumeration); type String_Access is access String; -- Type_Set is used by the child package Ada type Type_Set is (Lower_Case, Upper_Case, Mixed_Case); type Enum_Array is array (Positive range <>) of String_Access; type Enumeration_Info (C : Positive) is record Case_Sensitive : Boolean := False; Match_Must_Be_Unique : Boolean := False; Names : Enum_Array (1 .. C); end record; type Enumeration_Field is new Field_Type with private; function Create (Info : Enumeration_Info; Auto_Release_Names : Boolean := False) return Enumeration_Field; -- Make an fieldtype from the info. Enumerations are special, because -- they normally don't copy the enum values into a private store, so -- we have to care for the lifetime of the info we provide. -- The Auto_Release_Names flag may be used to automatically releases -- the strings in the Names array of the Enumeration_Info. function Make_Enumeration_Type (Info : Enumeration_Info; Auto_Release_Names : Boolean := False) return Enumeration_Field renames Create; procedure Release (Enum : in out Enumeration_Field); -- But we may want to release the field to release the memory allocated -- by it internally. After that the Enumeration field is no longer usable. -- The next type definitions are all ncurses extensions. They are typically -- not available in other curses implementations. procedure Set_Field_Type (Fld : Field; Typ : Enumeration_Field); pragma Inline (Set_Field_Type); private type CPA_Access is access Interfaces.C.Strings.chars_ptr_array; type Enumeration_Field is new Field_Type with record Case_Sensitive : Boolean := False; Match_Must_Be_Unique : Boolean := False; Arr : CPA_Access := null; end record; end Terminal_Interface.Curses.Forms.Field_Types.Enumeration;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-enumeration-ada__ads.htm 0000644 0001751 0000144 00000021567 13615673306 031211 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2002,2003 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type T is (<>); package Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada); function Create (Set : Type_Set := Mixed_Case; Case_Sensitive : Boolean := False; Must_Be_Unique : Boolean := False) return Enumeration_Field; function Value (Fld : Field; Buf : Buffer_Number := Buffer_Number'First) return T; -- Translate the content of the fields buffer - indicated by the -- buffer number - into an enumeration value. If the buffer is empty -- or the content is invalid, a Constraint_Error is raises. end Terminal_Interface.Curses.Forms.Field_Types.Enumeration.Ada;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-alpha__adb.htm 0000644 0001751 0000144 00000021174 13615673306 027176 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.14 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.Alpha is procedure Set_Field_Type (Fld : Field; Typ : Alpha_Field) is function Set_Fld_Type (F : Field := Fld; Arg1 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_alpha"); begin Eti_Exception (Set_Fld_Type (Arg1 => C_Int (Typ.Minimum_Field_Width))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; end Terminal_Interface.Curses.Forms.Field_Types.Alpha;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-regexp__adb.htm 0000644 0001751 0000144 00000021101 13615673306 027371 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.RegExp -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; use Interfaces.C; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.RegExp is procedure Set_Field_Type (Fld : Field; Typ : Regular_Expression_Field) is function Set_Ftyp (F : Field := Fld; Arg1 : char_array) return Eti_Error; pragma Import (C, Set_Ftyp, "set_field_type_regexp"); begin Eti_Exception (Set_Ftyp (Arg1 => To_C (Typ.Regular_Expression.all))); Wrap_Builtin (Fld, Typ); end Set_Field_Type; end Terminal_Interface.Curses.Forms.Field_Types.RegExp;AdaCurses-20211021/doc/ada/terminal_interface-curses-terminfo__ads.htm 0000644 0001751 0000144 00000022672 13615673306 024330 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Terminfo -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2000-2002,2003 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.5 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; package Terminal_Interface.Curses.Terminfo is pragma Preelaborate (Terminal_Interface.Curses.Terminfo); -- |===================================================================== -- | Man page curs_terminfo.3x -- |===================================================================== -- Not implemented: setupterm, setterm, set_curterm, del_curterm, -- restartterm, tparm, putp, vidputs, vidattr, -- mvcur type Terminfo_String is new String; -- | procedure Get_String (Name : String; Value : out Terminfo_String; Result : out Boolean); function Has_String (Name : String) return Boolean; -- AKA: tigetstr() -- | function Get_Flag (Name : String) return Boolean; -- AKA: tigetflag() -- | function Get_Number (Name : String) return Integer; -- AKA: tigetnum() type putctype is access function (c : Interfaces.C.int) return Interfaces.C.int; pragma Convention (C, putctype); -- | procedure Put_String (Str : Terminfo_String; affcnt : Natural := 1; putc : putctype := null); -- AKA: tputs() end Terminal_Interface.Curses.Terminfo;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms__adb.htm 0000644 0001751 0000144 00000413245 13615673306 023612 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.33 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Interfaces.C.Pointers; with Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms is use Terminal_Interface.Curses.Aux; type C_Field_Array is array (Natural range <>) of aliased Field; package F_Array is new Interfaces.C.Pointers (Natural, Field, C_Field_Array, Null_Field); ------------------------------------------------------------------------------ -- | -- | -- | -- subtype chars_ptr is Interfaces.C.Strings.chars_ptr; procedure Request_Name (Key : Form_Request_Code; Name : out String) is function Form_Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Form_Request_Name, "form_request_name"); begin Fill_String (Form_Request_Name (C_Int (Key)), Name); end Request_Name; function Request_Name (Key : Form_Request_Code) return String is function Form_Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Form_Request_Name, "form_request_name"); begin return Fill_String (Form_Request_Name (C_Int (Key))); end Request_Name; ------------------------------------------------------------------------------ -- | -- | -- | -- | -- |===================================================================== -- | man page form_field_new.3x -- |===================================================================== -- | -- | -- | function Create (Height : Line_Count; Width : Column_Count; Top : Line_Position; Left : Column_Position; Off_Screen : Natural := 0; More_Buffers : Buffer_Number := Buffer_Number'First) return Field is function Newfield (H, W, T, L, O, M : C_Int) return Field; pragma Import (C, Newfield, "new_field"); Fld : constant Field := Newfield (C_Int (Height), C_Int (Width), C_Int (Top), C_Int (Left), C_Int (Off_Screen), C_Int (More_Buffers)); begin if Fld = Null_Field then raise Form_Exception; end if; return Fld; end Create; -- | -- | -- | procedure Delete (Fld : in out Field) is function Free_Field (Fld : Field) return Eti_Error; pragma Import (C, Free_Field, "free_field"); begin Eti_Exception (Free_Field (Fld)); Fld := Null_Field; end Delete; -- | -- | -- | function Duplicate (Fld : Field; Top : Line_Position; Left : Column_Position) return Field is function Dup_Field (Fld : Field; Top : C_Int; Left : C_Int) return Field; pragma Import (C, Dup_Field, "dup_field"); F : constant Field := Dup_Field (Fld, C_Int (Top), C_Int (Left)); begin if F = Null_Field then raise Form_Exception; end if; return F; end Duplicate; -- | -- | -- | function Link (Fld : Field; Top : Line_Position; Left : Column_Position) return Field is function Lnk_Field (Fld : Field; Top : C_Int; Left : C_Int) return Field; pragma Import (C, Lnk_Field, "link_field"); F : constant Field := Lnk_Field (Fld, C_Int (Top), C_Int (Left)); begin if F = Null_Field then raise Form_Exception; end if; return F; end Link; -- | -- |===================================================================== -- | man page form_field_just.3x -- |===================================================================== -- | -- | -- | procedure Set_Justification (Fld : Field; Just : Field_Justification := None) is function Set_Field_Just (Fld : Field; Just : C_Int) return Eti_Error; pragma Import (C, Set_Field_Just, "set_field_just"); begin Eti_Exception (Set_Field_Just (Fld, C_Int (Field_Justification'Pos (Just)))); end Set_Justification; -- | -- | -- | function Get_Justification (Fld : Field) return Field_Justification is function Field_Just (Fld : Field) return C_Int; pragma Import (C, Field_Just, "field_just"); begin return Field_Justification'Val (Field_Just (Fld)); end Get_Justification; -- | -- |===================================================================== -- | man page form_field_buffer.3x -- |===================================================================== -- | -- | -- | procedure Set_Buffer (Fld : Field; Buffer : Buffer_Number := Buffer_Number'First; Str : String) is function Set_Fld_Buffer (Fld : Field; Bufnum : C_Int; S : char_array) return Eti_Error; pragma Import (C, Set_Fld_Buffer, "set_field_buffer"); begin Eti_Exception (Set_Fld_Buffer (Fld, C_Int (Buffer), To_C (Str))); end Set_Buffer; -- | -- | -- | procedure Get_Buffer (Fld : Field; Buffer : Buffer_Number := Buffer_Number'First; Str : out String) is function Field_Buffer (Fld : Field; B : C_Int) return chars_ptr; pragma Import (C, Field_Buffer, "field_buffer"); begin Fill_String (Field_Buffer (Fld, C_Int (Buffer)), Str); end Get_Buffer; function Get_Buffer (Fld : Field; Buffer : Buffer_Number := Buffer_Number'First) return String is function Field_Buffer (Fld : Field; B : C_Int) return chars_ptr; pragma Import (C, Field_Buffer, "field_buffer"); begin return Fill_String (Field_Buffer (Fld, C_Int (Buffer))); end Get_Buffer; -- | -- | -- | procedure Set_Status (Fld : Field; Status : Boolean := True) is function Set_Fld_Status (Fld : Field; St : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Status, "set_field_status"); begin if Set_Fld_Status (Fld, Boolean'Pos (Status)) /= E_Ok then raise Form_Exception; end if; end Set_Status; -- | -- | -- | function Changed (Fld : Field) return Boolean is function Field_Status (Fld : Field) return C_Int; pragma Import (C, Field_Status, "field_status"); Res : constant C_Int := Field_Status (Fld); begin if Res = Curses_False then return False; else return True; end if; end Changed; -- | -- | -- | procedure Set_Maximum_Size (Fld : Field; Max : Natural := 0) is function Set_Field_Max (Fld : Field; M : C_Int) return Eti_Error; pragma Import (C, Set_Field_Max, "set_max_field"); begin Eti_Exception (Set_Field_Max (Fld, C_Int (Max))); end Set_Maximum_Size; -- | -- |===================================================================== -- | man page form_field_opts.3x -- |===================================================================== -- | -- | -- | procedure Set_Options (Fld : Field; Options : Field_Option_Set) is function Set_Field_Opts (Fld : Field; Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Set_Field_Opts, "set_field_opts"); begin Eti_Exception (Set_Field_Opts (Fld, Options)); end Set_Options; -- | -- | -- | procedure Switch_Options (Fld : Field; Options : Field_Option_Set; On : Boolean := True) is function Field_Opts_On (Fld : Field; Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_On, "field_opts_on"); function Field_Opts_Off (Fld : Field; Opt : Field_Option_Set) return Eti_Error; pragma Import (C, Field_Opts_Off, "field_opts_off"); begin if On then Eti_Exception (Field_Opts_On (Fld, Options)); else Eti_Exception (Field_Opts_Off (Fld, Options)); end if; end Switch_Options; -- | -- | -- | procedure Get_Options (Fld : Field; Options : out Field_Option_Set) is function Field_Opts (Fld : Field) return Field_Option_Set; pragma Import (C, Field_Opts, "field_opts"); begin Options := Field_Opts (Fld); end Get_Options; -- | -- | -- | function Get_Options (Fld : Field := Null_Field) return Field_Option_Set is Fos : Field_Option_Set; begin Get_Options (Fld, Fos); return Fos; end Get_Options; -- | -- |===================================================================== -- | man page form_field_attributes.3x -- |===================================================================== -- | -- | -- | procedure Set_Foreground (Fld : Field; Fore : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Set_Field_Fore (Fld : Field; Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Fore, "set_field_fore"); begin Eti_Exception (Set_Field_Fore (Fld, (Ch => Character'First, Color => Color, Attr => Fore))); end Set_Foreground; -- | -- | -- | procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set) is function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin Fore := Field_Fore (Fld).Attr; end Foreground; procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set; Color : out Color_Pair) is function Field_Fore (Fld : Field) return Attributed_Character; pragma Import (C, Field_Fore, "field_fore"); begin Fore := Field_Fore (Fld).Attr; Color := Field_Fore (Fld).Color; end Foreground; -- | -- | -- | procedure Set_Background (Fld : Field; Back : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Set_Field_Back (Fld : Field; Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Field_Back, "set_field_back"); begin Eti_Exception (Set_Field_Back (Fld, (Ch => Character'First, Color => Color, Attr => Back))); end Set_Background; -- | -- | -- | procedure Background (Fld : Field; Back : out Character_Attribute_Set) is function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin Back := Field_Back (Fld).Attr; end Background; procedure Background (Fld : Field; Back : out Character_Attribute_Set; Color : out Color_Pair) is function Field_Back (Fld : Field) return Attributed_Character; pragma Import (C, Field_Back, "field_back"); begin Back := Field_Back (Fld).Attr; Color := Field_Back (Fld).Color; end Background; -- | -- | -- | procedure Set_Pad_Character (Fld : Field; Pad : Character := Space) is function Set_Field_Pad (Fld : Field; Ch : C_Int) return Eti_Error; pragma Import (C, Set_Field_Pad, "set_field_pad"); begin Eti_Exception (Set_Field_Pad (Fld, C_Int (Character'Pos (Pad)))); end Set_Pad_Character; -- | -- | -- | procedure Pad_Character (Fld : Field; Pad : out Character) is function Field_Pad (Fld : Field) return C_Int; pragma Import (C, Field_Pad, "field_pad"); begin Pad := Character'Val (Field_Pad (Fld)); end Pad_Character; -- | -- |===================================================================== -- | man page form_field_info.3x -- |===================================================================== -- | -- | -- | procedure Info (Fld : Field; Lines : out Line_Count; Columns : out Column_Count; First_Row : out Line_Position; First_Column : out Column_Position; Off_Screen : out Natural; Additional_Buffers : out Buffer_Number) is type C_Int_Access is access all C_Int; function Fld_Info (Fld : Field; L, C, Fr, Fc, Os, Ab : C_Int_Access) return Eti_Error; pragma Import (C, Fld_Info, "field_info"); L, C, Fr, Fc, Os, Ab : aliased C_Int; begin Eti_Exception (Fld_Info (Fld, L'Access, C'Access, Fr'Access, Fc'Access, Os'Access, Ab'Access)); Lines := Line_Count (L); Columns := Column_Count (C); First_Row := Line_Position (Fr); First_Column := Column_Position (Fc); Off_Screen := Natural (Os); Additional_Buffers := Buffer_Number (Ab); end Info; -- | -- | -- | procedure Dynamic_Info (Fld : Field; Lines : out Line_Count; Columns : out Column_Count; Max : out Natural) is type C_Int_Access is access all C_Int; function Dyn_Info (Fld : Field; L, C, M : C_Int_Access) return Eti_Error; pragma Import (C, Dyn_Info, "dynamic_field_info"); L, C, M : aliased C_Int; begin Eti_Exception (Dyn_Info (Fld, L'Access, C'Access, M'Access)); Lines := Line_Count (L); Columns := Column_Count (C); Max := Natural (M); end Dynamic_Info; -- | -- |===================================================================== -- | man page form_win.3x -- |===================================================================== -- | -- | -- | procedure Set_Window (Frm : Form; Win : Window) is function Set_Form_Win (Frm : Form; Win : Window) return Eti_Error; pragma Import (C, Set_Form_Win, "set_form_win"); begin Eti_Exception (Set_Form_Win (Frm, Win)); end Set_Window; -- | -- | -- | function Get_Window (Frm : Form) return Window is function Form_Win (Frm : Form) return Window; pragma Import (C, Form_Win, "form_win"); W : constant Window := Form_Win (Frm); begin return W; end Get_Window; -- | -- | -- | procedure Set_Sub_Window (Frm : Form; Win : Window) is function Set_Form_Sub (Frm : Form; Win : Window) return Eti_Error; pragma Import (C, Set_Form_Sub, "set_form_sub"); begin Eti_Exception (Set_Form_Sub (Frm, Win)); end Set_Sub_Window; -- | -- | -- | function Get_Sub_Window (Frm : Form) return Window is function Form_Sub (Frm : Form) return Window; pragma Import (C, Form_Sub, "form_sub"); W : constant Window := Form_Sub (Frm); begin return W; end Get_Sub_Window; -- | -- | -- | procedure Scale (Frm : Form; Lines : out Line_Count; Columns : out Column_Count) is type C_Int_Access is access all C_Int; function M_Scale (Frm : Form; Yp, Xp : C_Int_Access) return Eti_Error; pragma Import (C, M_Scale, "scale_form"); X, Y : aliased C_Int; begin Eti_Exception (M_Scale (Frm, Y'Access, X'Access)); Lines := Line_Count (Y); Columns := Column_Count (X); end Scale; -- | -- |===================================================================== -- | man page menu_hook.3x -- |===================================================================== -- | -- | -- | procedure Set_Field_Init_Hook (Frm : Form; Proc : Form_Hook_Function) is function Set_Field_Init (Frm : Form; Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Init, "set_field_init"); begin Eti_Exception (Set_Field_Init (Frm, Proc)); end Set_Field_Init_Hook; -- | -- | -- | procedure Set_Field_Term_Hook (Frm : Form; Proc : Form_Hook_Function) is function Set_Field_Term (Frm : Form; Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Field_Term, "set_field_term"); begin Eti_Exception (Set_Field_Term (Frm, Proc)); end Set_Field_Term_Hook; -- | -- | -- | procedure Set_Form_Init_Hook (Frm : Form; Proc : Form_Hook_Function) is function Set_Form_Init (Frm : Form; Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Init, "set_form_init"); begin Eti_Exception (Set_Form_Init (Frm, Proc)); end Set_Form_Init_Hook; -- | -- | -- | procedure Set_Form_Term_Hook (Frm : Form; Proc : Form_Hook_Function) is function Set_Form_Term (Frm : Form; Proc : Form_Hook_Function) return Eti_Error; pragma Import (C, Set_Form_Term, "set_form_term"); begin Eti_Exception (Set_Form_Term (Frm, Proc)); end Set_Form_Term_Hook; -- | -- |===================================================================== -- | man page form_fields.3x -- |===================================================================== -- | -- | -- | procedure Redefine (Frm : Form; Flds : Field_Array_Access) is function Set_Frm_Fields (Frm : Form; Items : System.Address) return Eti_Error; pragma Import (C, Set_Frm_Fields, "set_form_fields"); begin pragma Assert (Flds.all (Flds'Last) = Null_Field); if Flds.all (Flds'Last) /= Null_Field then raise Form_Exception; else Eti_Exception (Set_Frm_Fields (Frm, Flds.all (Flds'First)'Address)); end if; end Redefine; -- | -- | -- | function Fields (Frm : Form; Index : Positive) return Field is use F_Array; function C_Fields (Frm : Form) return Pointer; pragma Import (C, C_Fields, "form_fields"); P : Pointer := C_Fields (Frm); begin if P = null or else Index > Field_Count (Frm) then raise Form_Exception; else P := P + ptrdiff_t (C_Int (Index) - 1); return P.all; end if; end Fields; -- | -- | -- | function Field_Count (Frm : Form) return Natural is function Count (Frm : Form) return C_Int; pragma Import (C, Count, "field_count"); begin return Natural (Count (Frm)); end Field_Count; -- | -- | -- | procedure Move (Fld : Field; Line : Line_Position; Column : Column_Position) is function Move (Fld : Field; L, C : C_Int) return Eti_Error; pragma Import (C, Move, "move_field"); begin Eti_Exception (Move (Fld, C_Int (Line), C_Int (Column))); end Move; -- | -- |===================================================================== -- | man page form_new.3x -- |===================================================================== -- | -- | -- | function Create (Fields : Field_Array_Access) return Form is function NewForm (Fields : System.Address) return Form; pragma Import (C, NewForm, "new_form"); M : Form; begin pragma Assert (Fields.all (Fields'Last) = Null_Field); if Fields.all (Fields'Last) /= Null_Field then raise Form_Exception; else M := NewForm (Fields.all (Fields'First)'Address); if M = Null_Form then raise Form_Exception; end if; return M; end if; end Create; -- | -- | -- | procedure Delete (Frm : in out Form) is function Free (Frm : Form) return Eti_Error; pragma Import (C, Free, "free_form"); begin Eti_Exception (Free (Frm)); Frm := Null_Form; end Delete; -- | -- |===================================================================== -- | man page form_opts.3x -- |===================================================================== -- | -- | -- | procedure Set_Options (Frm : Form; Options : Form_Option_Set) is function Set_Form_Opts (Frm : Form; Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Set_Form_Opts, "set_form_opts"); begin Eti_Exception (Set_Form_Opts (Frm, Options)); end Set_Options; -- | -- | -- | procedure Switch_Options (Frm : Form; Options : Form_Option_Set; On : Boolean := True) is function Form_Opts_On (Frm : Form; Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_On, "form_opts_on"); function Form_Opts_Off (Frm : Form; Opt : Form_Option_Set) return Eti_Error; pragma Import (C, Form_Opts_Off, "form_opts_off"); begin if On then Eti_Exception (Form_Opts_On (Frm, Options)); else Eti_Exception (Form_Opts_Off (Frm, Options)); end if; end Switch_Options; -- | -- | -- | procedure Get_Options (Frm : Form; Options : out Form_Option_Set) is function Form_Opts (Frm : Form) return Form_Option_Set; pragma Import (C, Form_Opts, "form_opts"); begin Options := Form_Opts (Frm); end Get_Options; -- | -- | -- | function Get_Options (Frm : Form := Null_Form) return Form_Option_Set is Fos : Form_Option_Set; begin Get_Options (Frm, Fos); return Fos; end Get_Options; -- | -- |===================================================================== -- | man page form_post.3x -- |===================================================================== -- | -- | -- | procedure Post (Frm : Form; Post : Boolean := True) is function M_Post (Frm : Form) return Eti_Error; pragma Import (C, M_Post, "post_form"); function M_Unpost (Frm : Form) return Eti_Error; pragma Import (C, M_Unpost, "unpost_form"); begin if Post then Eti_Exception (M_Post (Frm)); else Eti_Exception (M_Unpost (Frm)); end if; end Post; -- | -- |===================================================================== -- | man page form_cursor.3x -- |===================================================================== -- | -- | -- | procedure Position_Cursor (Frm : Form) is function Pos_Form_Cursor (Frm : Form) return Eti_Error; pragma Import (C, Pos_Form_Cursor, "pos_form_cursor"); begin Eti_Exception (Pos_Form_Cursor (Frm)); end Position_Cursor; -- | -- |===================================================================== -- | man page form_data.3x -- |===================================================================== -- | -- | -- | function Data_Ahead (Frm : Form) return Boolean is function Ahead (Frm : Form) return C_Int; pragma Import (C, Ahead, "data_ahead"); Res : constant C_Int := Ahead (Frm); begin if Res = Curses_False then return False; else return True; end if; end Data_Ahead; -- | -- | -- | function Data_Behind (Frm : Form) return Boolean is function Behind (Frm : Form) return C_Int; pragma Import (C, Behind, "data_behind"); Res : constant C_Int := Behind (Frm); begin if Res = Curses_False then return False; else return True; end if; end Data_Behind; -- | -- |===================================================================== -- | man page form_driver.3x -- |===================================================================== -- | -- | -- | function Driver (Frm : Form; Key : Key_Code) return Driver_Result is function Frm_Driver (Frm : Form; Key : C_Int) return Eti_Error; pragma Import (C, Frm_Driver, "form_driver"); R : constant Eti_Error := Frm_Driver (Frm, C_Int (Key)); begin case R is when E_Unknown_Command => return Unknown_Request; when E_Invalid_Field => return Invalid_Field; when E_Request_Denied => return Request_Denied; when others => Eti_Exception (R); return Form_Ok; end case; end Driver; -- | -- |===================================================================== -- | man page form_page.3x -- |===================================================================== -- | -- | -- | procedure Set_Current (Frm : Form; Fld : Field) is function Set_Current_Fld (Frm : Form; Fld : Field) return Eti_Error; pragma Import (C, Set_Current_Fld, "set_current_field"); begin Eti_Exception (Set_Current_Fld (Frm, Fld)); end Set_Current; -- | -- | -- | function Current (Frm : Form) return Field is function Current_Fld (Frm : Form) return Field; pragma Import (C, Current_Fld, "current_field"); Fld : constant Field := Current_Fld (Frm); begin if Fld = Null_Field then raise Form_Exception; end if; return Fld; end Current; -- | -- | -- | procedure Set_Page (Frm : Form; Page : Page_Number := Page_Number'First) is function Set_Frm_Page (Frm : Form; Pg : C_Int) return Eti_Error; pragma Import (C, Set_Frm_Page, "set_form_page"); begin Eti_Exception (Set_Frm_Page (Frm, C_Int (Page))); end Set_Page; -- | -- | -- | function Page (Frm : Form) return Page_Number is function Get_Page (Frm : Form) return C_Int; pragma Import (C, Get_Page, "form_page"); P : constant C_Int := Get_Page (Frm); begin if P < 0 then raise Form_Exception; else return Page_Number (P); end if; end Page; function Get_Index (Fld : Field) return Positive is function Get_Fieldindex (Fld : Field) return C_Int; pragma Import (C, Get_Fieldindex, "field_index"); Res : constant C_Int := Get_Fieldindex (Fld); begin if Res = Curses_Err then raise Form_Exception; end if; return Positive (Natural (Res) + Positive'First); end Get_Index; -- | -- |===================================================================== -- | man page form_new_page.3x -- |===================================================================== -- | -- | -- | procedure Set_New_Page (Fld : Field; New_Page : Boolean := True) is function Set_Page (Fld : Field; Flg : C_Int) return Eti_Error; pragma Import (C, Set_Page, "set_new_page"); begin Eti_Exception (Set_Page (Fld, Boolean'Pos (New_Page))); end Set_New_Page; -- | -- | -- | function Is_New_Page (Fld : Field) return Boolean is function Is_New (Fld : Field) return C_Int; pragma Import (C, Is_New, "new_page"); Res : constant C_Int := Is_New (Fld); begin if Res = Curses_False then return False; else return True; end if; end Is_New_Page; procedure Free (FA : in out Field_Array_Access; Free_Fields : Boolean := False) is procedure Release is new Ada.Unchecked_Deallocation (Field_Array, Field_Array_Access); begin if FA /= null and then Free_Fields then for I in FA'First .. (FA'Last - 1) loop if FA.all (I) /= Null_Field then Delete (FA.all (I)); end if; end loop; end if; Release (FA); end Free; -- |===================================================================== function Default_Field_Options return Field_Option_Set is begin return Get_Options (Null_Field); end Default_Field_Options; function Default_Form_Options return Form_Option_Set is begin return Get_Options (Null_Form); end Default_Form_Options; end Terminal_Interface.Curses.Forms;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-form_user_data__adb.htm 0000644 0001751 0000144 00000025346 13615673306 026603 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Form_User_Data -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 1999-2009,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.17 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ -- | -- |===================================================================== -- | man page form__userptr.3x -- |===================================================================== -- | with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Form_User_Data is -- | -- | -- | procedure Set_User_Data (Frm : Form; Data : User_Access) is function Set_Form_Userptr (Frm : Form; Data : User_Access) return Eti_Error; pragma Import (C, Set_Form_Userptr, "set_form_userptr"); begin Eti_Exception (Set_Form_Userptr (Frm, Data)); end Set_User_Data; -- | -- | -- | function Get_User_Data (Frm : Form) return User_Access is function Form_Userptr (Frm : Form) return User_Access; pragma Import (C, Form_Userptr, "form_userptr"); begin return Form_Userptr (Frm); end Get_User_Data; procedure Get_User_Data (Frm : Form; Data : out User_Access) is begin Data := Get_User_Data (Frm); end Get_User_Data; end Terminal_Interface.Curses.Forms.Form_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-modular_io__adb.htm 0000644 0001751 0000144 00000024037 13615673306 026264 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Modular_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; with Terminal_Interface.Curses.Text_IO.Aux; package body Terminal_Interface.Curses.Text_IO.Modular_IO is package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package MIO is new Ada.Text_IO.Modular_IO (Num); procedure Put (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base) is Buf : String (1 .. Field'Last); begin MIO.Put (Buf, Item, Base); Aux.Put_Buf (Win, Buf, Width); end Put; procedure Put (Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base) is begin Put (Get_Window, Item, Width, Base); end Put; end Terminal_Interface.Curses.Text_IO.Modular_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-alpha__ads.htm 0000644 0001751 0000144 00000016277 13615673306 027227 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Alpha -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Forms.Field_Types.Alpha is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.Alpha); type Alpha_Field is new Field_Type with record Minimum_Field_Width : Natural := 0; end record; procedure Set_Field_Type (Fld : Field; Typ : Alpha_Field); pragma Inline (Set_Field_Type); end Terminal_Interface.Curses.Forms.Field_Types.Alpha;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io__adb.htm 0000644 0001751 0000144 00000115174 13615673306 024137 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.23 @ -- @Date: 2020/02/02 23:34:34 @ -- 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;AdaCurses-20211021/doc/ada/terminal_interface-curses-panels__adb.htm 0000644 0001751 0000144 00000051551 13615673306 023744 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Panels -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2004,2009 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.15 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; package body Terminal_Interface.Curses.Panels is use type Interfaces.C.int; function Create (Win : Window) return Panel is function Newpanel (Win : Window) return Panel; pragma Import (C, Newpanel, "new_panel"); Pan : Panel; begin Pan := Newpanel (Win); if Pan = Null_Panel then raise Panel_Exception; end if; return Pan; end Create; procedure Bottom (Pan : Panel) is function Bottompanel (Pan : Panel) return C_Int; pragma Import (C, Bottompanel, "bottom_panel"); begin if Bottompanel (Pan) = Curses_Err then raise Panel_Exception; end if; end Bottom; procedure Top (Pan : Panel) is function Toppanel (Pan : Panel) return C_Int; pragma Import (C, Toppanel, "top_panel"); begin if Toppanel (Pan) = Curses_Err then raise Panel_Exception; end if; end Top; procedure Show (Pan : Panel) is function Showpanel (Pan : Panel) return C_Int; pragma Import (C, Showpanel, "show_panel"); begin if Showpanel (Pan) = Curses_Err then raise Panel_Exception; end if; end Show; procedure Hide (Pan : Panel) is function Hidepanel (Pan : Panel) return C_Int; pragma Import (C, Hidepanel, "hide_panel"); begin if Hidepanel (Pan) = Curses_Err then raise Panel_Exception; end if; end Hide; function Get_Window (Pan : Panel) return Window is function Panel_Win (Pan : Panel) return Window; pragma Import (C, Panel_Win, "panel_window"); Win : constant Window := Panel_Win (Pan); begin if Win = Null_Window then raise Panel_Exception; end if; return Win; end Get_Window; procedure Replace (Pan : Panel; Win : Window) is function Replace_Pan (Pan : Panel; Win : Window) return C_Int; pragma Import (C, Replace_Pan, "replace_panel"); begin if Replace_Pan (Pan, Win) = Curses_Err then raise Panel_Exception; end if; end Replace; procedure Move (Pan : Panel; Line : Line_Position; Column : Column_Position) is function Move (Pan : Panel; Line : C_Int; Column : C_Int) return C_Int; pragma Import (C, Move, "move_panel"); begin if Move (Pan, C_Int (Line), C_Int (Column)) = Curses_Err then raise Panel_Exception; end if; end Move; function Is_Hidden (Pan : Panel) return Boolean is function Panel_Hidden (Pan : Panel) return C_Int; pragma Import (C, Panel_Hidden, "panel_hidden"); begin if Panel_Hidden (Pan) = Curses_False then return False; else return True; end if; end Is_Hidden; procedure Delete (Pan : in out Panel) is function Del_Panel (Pan : Panel) return C_Int; pragma Import (C, Del_Panel, "del_panel"); begin if Del_Panel (Pan) = Curses_Err then raise Panel_Exception; end if; Pan := Null_Panel; end Delete; end Terminal_Interface.Curses.Panels;AdaCurses-20211021/doc/ada/terminal_interface__ads.htm 0000644 0001751 0000144 00000012607 13615673306 021202 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2006 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.15 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface is pragma Pure (Terminal_Interface); -- -- Everything is in the child units -- end Terminal_Interface;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-alphanumeric__ads.htm 0000644 0001751 0000144 00000016446 13615673306 030610 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ package Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric); type AlphaNumeric_Field is new Field_Type with record Minimum_Field_Width : Natural := 0; end record; procedure Set_Field_Type (Fld : Field; Typ : AlphaNumeric_Field); pragma Inline (Set_Field_Type); end Terminal_Interface.Curses.Forms.Field_Types.AlphaNumeric;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-complex_io__ads.htm 0000644 0001751 0000144 00000021524 13615673306 026307 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Complex_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Numerics.Generic_Complex_Types; generic with package Complex_Types is new Ada.Numerics.Generic_Complex_Types (<>); package Terminal_Interface.Curses.Text_IO.Complex_IO is use Complex_Types; Default_Fore : Field := 2; Default_Aft : Field := Real'Digits - 1; Default_Exp : Field := 3; procedure Put (Win : Window; Item : Complex; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); procedure Put (Item : Complex; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp); private pragma Inline (Put); end Terminal_Interface.Curses.Text_IO.Complex_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-enumeration_io__adb.htm 0000644 0001751 0000144 00000027102 13615673306 027143 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; with Ada.Characters.Handling; use Ada.Characters.Handling; with Terminal_Interface.Curses.Text_IO.Aux; package body Terminal_Interface.Curses.Text_IO.Enumeration_IO is package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package EIO is new Ada.Text_IO.Enumeration_IO (Enum); procedure Put (Win : Window; Item : Enum; Width : Field := Default_Width; Set : Type_Set := Default_Setting) is Buf : String (1 .. Field'Last); Tset : Ada.Text_IO.Type_Set; begin if Set /= Mixed_Case then Tset := Ada.Text_IO.Type_Set'Val (Type_Set'Pos (Set)); else Tset := Ada.Text_IO.Lower_Case; end if; EIO.Put (Buf, Item, Tset); if Set = Mixed_Case then Buf (Buf'First) := To_Upper (Buf (Buf'First)); end if; Aux.Put_Buf (Win, Buf, Width, True, True); end Put; procedure Put (Item : Enum; Width : Field := Default_Width; Set : Type_Set := Default_Setting) is begin Put (Get_Window, Item, Width, Set); end Put; end Terminal_Interface.Curses.Text_IO.Enumeration_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-aux__ads.htm 0000644 0001751 0000144 00000037302 13615673306 023276 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Aux -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 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.25 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; with Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; package Terminal_Interface.Curses.Aux is pragma Preelaborate (Terminal_Interface.Curses.Aux); subtype C_Int is Interfaces.C.int; subtype C_Short is Interfaces.C.short; subtype C_Long_Int is Interfaces.C.long; subtype C_Size_T is Interfaces.C.size_t; subtype C_UInt is Interfaces.C.unsigned; subtype C_ULong is Interfaces.C.unsigned_long; subtype C_Char_Ptr is Interfaces.C.Strings.chars_ptr; type C_Void_Ptr is new System.Address; -- This is how those constants are defined in ncurses. I see them also -- exactly like this in all ETI implementations I ever tested. So it -- could be that this is quite general, but please check with your curses. -- This is critical, because curses sometime mixes Boolean returns with -- returning an error status. Curses_Ok : constant C_Int := Curses_Constants.OK; Curses_Err : constant C_Int := Curses_Constants.ERR; Curses_True : constant C_Int := Curses_Constants.TRUE; Curses_False : constant C_Int := Curses_Constants.FALSE; -- Eti_Error: type for error codes returned by the menu and form subsystem type Eti_Error is (E_Current, E_Invalid_Field, E_Request_Denied, E_Not_Connected, E_Not_Selectable, E_No_Match, E_Unknown_Command, E_Not_Posted, E_No_Room, E_Bad_State, E_Connected, E_Posted, E_Bad_Argument, E_System_Error, E_Ok); procedure Eti_Exception (Code : Eti_Error); -- Do nothing if Code = E_Ok. -- Else dispatch the error code and raise the appropriate exception. procedure Fill_String (Cp : chars_ptr; Str : out String); -- Fill the Str parameter with the string denoted by the chars_ptr -- C-Style string. function Fill_String (Cp : chars_ptr) return String; -- Same but as function. private for Eti_Error'Size use C_Int'Size; pragma Convention (C, Eti_Error); for Eti_Error use (E_Current => Curses_Constants.E_CURRENT, E_Invalid_Field => Curses_Constants.E_INVALID_FIELD, E_Request_Denied => Curses_Constants.E_REQUEST_DENIED, E_Not_Connected => Curses_Constants.E_NOT_CONNECTED, E_Not_Selectable => Curses_Constants.E_NOT_SELECTABLE, E_No_Match => Curses_Constants.E_NO_MATCH, E_Unknown_Command => Curses_Constants.E_UNKNOWN_COMMAND, E_Not_Posted => Curses_Constants.E_NOT_POSTED, E_No_Room => Curses_Constants.E_NO_ROOM, E_Bad_State => Curses_Constants.E_BAD_STATE, E_Connected => Curses_Constants.E_CONNECTED, E_Posted => Curses_Constants.E_POSTED, E_Bad_Argument => Curses_Constants.E_BAD_ARGUMENT, E_System_Error => Curses_Constants.E_SYSTEM_ERROR, E_Ok => Curses_Constants.E_OK); end Terminal_Interface.Curses.Aux;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-enumeration_io__ads.htm 0000644 0001751 0000144 00000020623 13615673306 027165 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Enumeration_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type Enum is (<>); package Terminal_Interface.Curses.Text_IO.Enumeration_IO is Default_Width : Field := 0; Default_Setting : Type_Set := Mixed_Case; procedure Put (Win : Window; Item : Enum; Width : Field := Default_Width; Set : Type_Set := Default_Setting); procedure Put (Item : Enum; Width : Field := Default_Width; Set : Type_Set := Default_Setting); private pragma Inline (Put); end Terminal_Interface.Curses.Text_IO.Enumeration_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-panels-user_data__adb.htm 0000644 0001751 0000144 00000025304 13615673306 025706 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Panels.User_Data -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Terminal_Interface.Curses.Panels; use Terminal_Interface.Curses.Panels; package body Terminal_Interface.Curses.Panels.User_Data is use type Interfaces.C.int; procedure Set_User_Data (Pan : Panel; Data : User_Access) is function Set_Panel_Userptr (Pan : Panel; Addr : User_Access) return C_Int; pragma Import (C, Set_Panel_Userptr, "set_panel_userptr"); begin if Set_Panel_Userptr (Pan, Data) = Curses_Err then raise Panel_Exception; end if; end Set_User_Data; function Get_User_Data (Pan : Panel) return User_Access is function Panel_Userptr (Pan : Panel) return User_Access; pragma Import (C, Panel_Userptr, "panel_userptr"); begin return Panel_Userptr (Pan); end Get_User_Data; procedure Get_User_Data (Pan : Panel; Data : out User_Access) is begin Data := Get_User_Data (Pan); end Get_User_Data; end Terminal_Interface.Curses.Panels.User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-enumeration__adb.htm 0000644 0001751 0000144 00000043561 13615673306 030443 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.Enumeration -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.Enumeration is function Create (Info : Enumeration_Info; Auto_Release_Names : Boolean := False) return Enumeration_Field is procedure Release_String is new Ada.Unchecked_Deallocation (String, String_Access); E : Enumeration_Field; L : constant size_t := 1 + size_t (Info.C); S : String_Access; begin E.Case_Sensitive := Info.Case_Sensitive; E.Match_Must_Be_Unique := Info.Match_Must_Be_Unique; E.Arr := new chars_ptr_array (size_t (1) .. L); for I in 1 .. Positive (L - 1) loop if Info.Names (I) = null then raise Form_Exception; end if; E.Arr.all (size_t (I)) := New_String (Info.Names (I).all); if Auto_Release_Names then S := Info.Names (I); Release_String (S); end if; end loop; E.Arr.all (L) := Null_Ptr; return E; end Create; procedure Release (Enum : in out Enumeration_Field) is I : size_t := 0; P : chars_ptr; begin loop P := Enum.Arr.all (I); exit when P = Null_Ptr; Free (P); Enum.Arr.all (I) := Null_Ptr; I := I + 1; end loop; Enum.Arr := null; end Release; procedure Set_Field_Type (Fld : Field; Typ : Enumeration_Field) is function Set_Fld_Type (F : Field := Fld; Arg1 : chars_ptr_array; Arg2 : C_Int; Arg3 : C_Int) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_enum"); begin if Typ.Arr = null then raise Form_Exception; end if; Eti_Exception (Set_Fld_Type (Arg1 => Typ.Arr.all, Arg2 => C_Int (Boolean'Pos (Typ.Case_Sensitive)), Arg3 => C_Int (Boolean'Pos (Typ.Match_Must_Be_Unique)))); Wrap_Builtin (Fld, Typ, C_Choice_Router); end Set_Field_Type; end Terminal_Interface.Curses.Forms.Field_Types.Enumeration;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types__adb.htm 0000644 0001751 0000144 00000114675 13615673306 026124 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.29 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Ada.Unchecked_Deallocation; with System.Address_To_Access_Conversions; -- | -- |===================================================================== -- | man page form_fieldtype.3x -- |===================================================================== -- | package body Terminal_Interface.Curses.Forms.Field_Types is use type System.Address; package Argument_Conversions is new System.Address_To_Access_Conversions (Argument); function Get_Fieldtype (F : Field) return C_Field_Type; pragma Import (C, Get_Fieldtype, "field_type"); function Get_Arg (F : Field) return System.Address; pragma Import (C, Get_Arg, "field_arg"); -- | -- |===================================================================== -- | man page form_field_validation.3x -- |===================================================================== -- | -- | -- | function Get_Type (Fld : Field) return Field_Type_Access is Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); Arg : Argument_Access; begin if Low_Level = Null_Field_Type then return null; else if Low_Level = M_Builtin_Router or else Low_Level = M_Generic_Type or else Low_Level = M_Choice_Router or else Low_Level = M_Generic_Choice then Arg := Argument_Access (Argument_Conversions.To_Pointer (Get_Arg (Fld))); if Arg = null then raise Form_Exception; else return Arg.all.Typ; end if; else raise Form_Exception; end if; end if; end Get_Type; function Copy_Arg (Usr : System.Address) return System.Address is begin return Usr; end Copy_Arg; procedure Free_Arg (Usr : System.Address) is procedure Free_Type is new Ada.Unchecked_Deallocation (Field_Type'Class, Field_Type_Access); procedure Freeargs is new Ada.Unchecked_Deallocation (Argument, Argument_Access); To_Be_Free : Argument_Access := Argument_Access (Argument_Conversions.To_Pointer (Usr)); Low_Level : C_Field_Type; begin if To_Be_Free /= null then if To_Be_Free.all.Usr /= System.Null_Address then Low_Level := To_Be_Free.all.Cft; if Low_Level.all.Freearg /= null then Low_Level.all.Freearg (To_Be_Free.all.Usr); end if; end if; if To_Be_Free.all.Typ /= null then Free_Type (To_Be_Free.all.Typ); end if; Freeargs (To_Be_Free); end if; end Free_Arg; procedure Wrap_Builtin (Fld : Field; Typ : Field_Type'Class; Cft : C_Field_Type := C_Builtin_Router) is Usr_Arg : constant System.Address := Get_Arg (Fld); Low_Level : constant C_Field_Type := Get_Fieldtype (Fld); Arg : Argument_Access; function Set_Fld_Type (F : Field := Fld; Cf : C_Field_Type := Cft; Arg1 : Argument_Access) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); begin pragma Assert (Low_Level /= Null_Field_Type); if Cft /= C_Builtin_Router and then Cft /= C_Choice_Router then raise Form_Exception; else Arg := new Argument'(Usr => System.Null_Address, Typ => new Field_Type'Class'(Typ), Cft => Get_Fieldtype (Fld)); if Usr_Arg /= System.Null_Address then if Low_Level.all.Copyarg /= null then Arg.all.Usr := Low_Level.all.Copyarg (Usr_Arg); else Arg.all.Usr := Usr_Arg; end if; end if; Eti_Exception (Set_Fld_Type (Arg1 => Arg)); end if; end Wrap_Builtin; function Field_Check_Router (Fld : Field; Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type and then Arg.all.Typ /= null); if Arg.all.Cft.all.Fcheck /= null then return Arg.all.Cft.all.Fcheck (Fld, Arg.all.Usr); else return 1; end if; end Field_Check_Router; function Char_Check_Router (Ch : C_Int; Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type and then Arg.all.Typ /= null); if Arg.all.Cft.all.Ccheck /= null then return Arg.all.Cft.all.Ccheck (Ch, Arg.all.Usr); else return 1; end if; end Char_Check_Router; function Next_Router (Fld : Field; Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type and then Arg.all.Typ /= null); if Arg.all.Cft.all.Next /= null then return Arg.all.Cft.all.Next (Fld, Arg.all.Usr); else return 1; end if; end Next_Router; function Prev_Router (Fld : Field; Usr : System.Address) return Curses_Bool is Arg : constant Argument_Access := Argument_Access (Argument_Conversions.To_Pointer (Usr)); begin pragma Assert (Arg /= null and then Arg.all.Cft /= Null_Field_Type and then Arg.all.Typ /= null); if Arg.all.Cft.all.Prev /= null then return Arg.all.Cft.all.Prev (Fld, Arg.all.Usr); else return 1; end if; end Prev_Router; -- ----------------------------------------------------------------------- -- function C_Builtin_Router return C_Field_Type is T : C_Field_Type; begin if M_Builtin_Router = Null_Field_Type then T := New_Fieldtype (Field_Check_Router'Access, Char_Check_Router'Access); if T = Null_Field_Type then raise Form_Exception; else Eti_Exception (Set_Fieldtype_Arg (T, Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access)); end if; M_Builtin_Router := T; end if; pragma Assert (M_Builtin_Router /= Null_Field_Type); return M_Builtin_Router; end C_Builtin_Router; -- ----------------------------------------------------------------------- -- function C_Choice_Router return C_Field_Type is T : C_Field_Type; begin if M_Choice_Router = Null_Field_Type then T := New_Fieldtype (Field_Check_Router'Access, Char_Check_Router'Access); if T = Null_Field_Type then raise Form_Exception; else Eti_Exception (Set_Fieldtype_Arg (T, Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access)); Eti_Exception (Set_Fieldtype_Choice (T, Next_Router'Access, Prev_Router'Access)); end if; M_Choice_Router := T; end if; pragma Assert (M_Choice_Router /= Null_Field_Type); return M_Choice_Router; end C_Choice_Router; end Terminal_Interface.Curses.Forms.Field_Types;AdaCurses-20211021/doc/ada/terminal_interface-curses-panels-user_data__ads.htm 0000644 0001751 0000144 00000022040 13615673306 025721 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Panels.User_Data -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2003,2009 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.16 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type User is limited private; type User_Access is access all User; package Terminal_Interface.Curses.Panels.User_Data is pragma Preelaborate (Terminal_Interface.Curses.Panels.User_Data); -- |===================================================================== -- | Man page panel.3x -- |===================================================================== -- | procedure Set_User_Data (Pan : Panel; Data : User_Access); -- AKA: set_panel_userptr pragma Inline (Set_User_Data); -- | procedure Get_User_Data (Pan : Panel; Data : out User_Access); -- AKA: panel_userptr -- | function Get_User_Data (Pan : Panel) return User_Access; -- AKA: panel_userptr -- Same as function pragma Inline (Get_User_Data); end Terminal_Interface.Curses.Panels.User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-mouse__ads.htm 0000644 0001751 0000144 00000064460 13707131167 023632 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Mouse -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2014,2015 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.33 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; package Terminal_Interface.Curses.Mouse is pragma Preelaborate (Terminal_Interface.Curses.Mouse); -- |===================================================================== -- | Man page curs_mouse.3x -- |===================================================================== -- mouse_trafo, wmouse_trafo are implemented as Transform_Coordinates -- in the parent package. -- -- Not implemented: -- REPORT_MOUSE_POSITION (i.e. as a parameter to Register_Reportable_Event -- or Start_Mouse) type Event_Mask is private; No_Events : constant Event_Mask; All_Events : constant Event_Mask; type Mouse_Button is (Left, -- aka: Button 1 Middle, -- aka: Button 2 Right, -- aka: Button 3 Button4, -- aka: Button 4 Control, -- Control Key Shift, -- Shift Key Alt); -- ALT Key subtype Real_Buttons is Mouse_Button range Left .. Button4; subtype Modifier_Keys is Mouse_Button range Control .. Alt; type Button_State is (Released, Pressed, Clicked, Double_Clicked, Triple_Clicked); type Button_States is array (Button_State) of Boolean; pragma Pack (Button_States); All_Clicks : constant Button_States := (Clicked .. Triple_Clicked => True, others => False); All_States : constant Button_States := (others => True); type Mouse_Event is private; -- |===================================================================== -- | Man page curs_mouse.3x -- |===================================================================== function Has_Mouse return Boolean; -- Return true if a mouse device is supported, false otherwise. procedure Register_Reportable_Event (Button : Mouse_Button; State : Button_State; Mask : in out Event_Mask); -- Stores the event described by the button and the state in the mask. -- Before you call this the first time, you should initialize the mask -- with the Empty_Mask constant pragma Inline (Register_Reportable_Event); procedure Register_Reportable_Events (Button : Mouse_Button; State : Button_States; Mask : in out Event_Mask); -- Register all events described by the Button and the State bitmap. -- Before you call this the first time, you should initialize the mask -- with the Empty_Mask constant -- | -- There is one difference to mousmask(): we return the value of the -- old mask, that means the event mask value before this call. -- Not Implemented: The library version -- returns a Mouse_Mask that tells which events are reported. function Start_Mouse (Mask : Event_Mask := All_Events) return Event_Mask; -- AKA: mousemask() pragma Inline (Start_Mouse); procedure End_Mouse (Mask : Event_Mask := No_Events); -- Terminates the mouse, restores the specified event mask pragma Inline (End_Mouse); -- | function Get_Mouse return Mouse_Event; -- AKA: getmouse() pragma Inline (Get_Mouse); procedure Get_Event (Event : Mouse_Event; Y : out Line_Position; X : out Column_Position; Button : out Mouse_Button; State : out Button_State); -- !!! Warning: X and Y are screen coordinates. Due to ripped of lines they -- may not be identical to window coordinates. -- Not Implemented: Get_Event only reports one event, the C library -- version supports multiple events, e.g. {click-1, click-3} pragma Inline (Get_Event); -- | procedure Unget_Mouse (Event : Mouse_Event); -- AKA: ungetmouse() pragma Inline (Unget_Mouse); -- | function Enclosed_In_Window (Win : Window := Standard_Window; Event : Mouse_Event) return Boolean; -- AKA: wenclose() -- But : use event instead of screen coordinates. pragma Inline (Enclosed_In_Window); -- | function Mouse_Interval (Msec : Natural := 200) return Natural; -- AKA: mouseinterval() pragma Inline (Mouse_Interval); private -- This can be as little as 32 bits (unsigned), or as long as the system's -- unsigned long. Declare it as the minimum size to handle all valid -- sizes. type Event_Mask is mod 4294967296; type Mouse_Event is record Id : Integer range Integer (Interfaces.C.short'First) .. Integer (Interfaces.C.short'Last); X, Y, Z : Integer range Integer (Interfaces.C.int'First) .. Integer (Interfaces.C.int'Last); Bstate : Event_Mask; end record; pragma Convention (C, Mouse_Event); for Mouse_Event use record Id at 0 range Curses_Constants.MEVENT_id_First .. Curses_Constants.MEVENT_id_Last; X at 0 range Curses_Constants.MEVENT_x_First .. Curses_Constants.MEVENT_x_Last; Y at 0 range Curses_Constants.MEVENT_y_First .. Curses_Constants.MEVENT_y_Last; Z at 0 range Curses_Constants.MEVENT_z_First .. Curses_Constants.MEVENT_z_Last; Bstate at 0 range Curses_Constants.MEVENT_bstate_First .. Curses_Constants.MEVENT_bstate_Last; end record; for Mouse_Event'Size use Curses_Constants.MEVENT_Size; Generation_Bit_Order : System.Bit_Order renames Curses_Constants.Bit_Order; BUTTON_CTRL : constant Event_Mask := Curses_Constants.BUTTON_CTRL; BUTTON_SHIFT : constant Event_Mask := Curses_Constants.BUTTON_SHIFT; BUTTON_ALT : constant Event_Mask := Curses_Constants.BUTTON_ALT; BUTTON1_EVENTS : constant Event_Mask := Curses_Constants.all_events_button_1; BUTTON2_EVENTS : constant Event_Mask := Curses_Constants.all_events_button_2; BUTTON3_EVENTS : constant Event_Mask := Curses_Constants.all_events_button_3; BUTTON4_EVENTS : constant Event_Mask := Curses_Constants.all_events_button_4; ALL_MOUSE_EVENTS : constant Event_Mask := Curses_Constants.ALL_MOUSE_EVENTS; No_Events : constant Event_Mask := 0; All_Events : constant Event_Mask := ALL_MOUSE_EVENTS; end Terminal_Interface.Curses.Mouse;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-modular_io__ads.htm 0000644 0001751 0000144 00000020517 13615673306 026304 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Modular_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type Num is mod <>; package Terminal_Interface.Curses.Text_IO.Modular_IO is Default_Width : Field := Num'Width; Default_Base : Number_Base := 10; procedure Put (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base); procedure Put (Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base); private pragma Inline (Put); end Terminal_Interface.Curses.Text_IO.Modular_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms__ads.htm 0000644 0001751 0000144 00000325177 13615673306 023641 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Form -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2009,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.34 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; with Ada.Characters.Latin_1; package Terminal_Interface.Curses.Forms is pragma Preelaborate (Terminal_Interface.Curses.Forms); pragma Linker_Options ("-lform" & Curses_Constants.DFT_ARG_SUFFIX); Space : Character renames Ada.Characters.Latin_1.Space; type Field is private; type Form is private; Null_Field : constant Field; Null_Form : constant Form; type Field_Justification is (None, Left, Center, Right); type Field_Option_Set is record Visible : Boolean; Active : Boolean; Public : Boolean; Edit : Boolean; Wrap : Boolean; Blank : Boolean; Auto_Skip : Boolean; Null_Ok : Boolean; Pass_Ok : Boolean; Static : Boolean; end record; pragma Convention (C_Pass_By_Copy, Field_Option_Set); for Field_Option_Set use record Visible at 0 range Curses_Constants.O_VISIBLE_First .. Curses_Constants.O_VISIBLE_Last; Active at 0 range Curses_Constants.O_ACTIVE_First .. Curses_Constants.O_ACTIVE_Last; Public at 0 range Curses_Constants.O_PUBLIC_First .. Curses_Constants.O_PUBLIC_Last; Edit at 0 range Curses_Constants.O_EDIT_First .. Curses_Constants.O_EDIT_Last; Wrap at 0 range Curses_Constants.O_WRAP_First .. Curses_Constants.O_WRAP_Last; Blank at 0 range Curses_Constants.O_BLANK_First .. Curses_Constants.O_BLANK_Last; Auto_Skip at 0 range Curses_Constants.O_AUTOSKIP_First .. Curses_Constants.O_AUTOSKIP_Last; Null_Ok at 0 range Curses_Constants.O_NULLOK_First .. Curses_Constants.O_NULLOK_Last; Pass_Ok at 0 range Curses_Constants.O_PASSOK_First .. Curses_Constants.O_PASSOK_Last; Static at 0 range Curses_Constants.O_STATIC_First .. Curses_Constants.O_STATIC_Last; end record; pragma Warnings (Off); for Field_Option_Set'Size use Curses_Constants.Field_Options_Size; pragma Warnings (On); function Default_Field_Options return Field_Option_Set; -- The initial defaults for the field options. pragma Inline (Default_Field_Options); type Form_Option_Set is record NL_Overload : Boolean; BS_Overload : Boolean; end record; pragma Convention (C_Pass_By_Copy, Form_Option_Set); for Form_Option_Set use record NL_Overload at 0 range Curses_Constants.O_NL_OVERLOAD_First .. Curses_Constants.O_NL_OVERLOAD_Last; BS_Overload at 0 range Curses_Constants.O_BS_OVERLOAD_First .. Curses_Constants.O_BS_OVERLOAD_Last; end record; pragma Warnings (Off); for Form_Option_Set'Size use Curses_Constants.Field_Options_Size; pragma Warnings (On); function Default_Form_Options return Form_Option_Set; -- The initial defaults for the form options. pragma Inline (Default_Form_Options); type Buffer_Number is new Natural; type Field_Array is array (Positive range <>) of aliased Field; pragma Convention (C, Field_Array); type Field_Array_Access is access Field_Array; procedure Free (FA : in out Field_Array_Access; Free_Fields : Boolean := False); -- Release the memory for an allocated field array -- If Free_Fields is True, call Delete() for all the fields in -- the array. subtype Form_Request_Code is Key_Code range (Key_Max + 1) .. (Key_Max + 57); -- The prefix F_ stands for "Form Request" F_Next_Page : constant Form_Request_Code := Key_Max + 1; F_Previous_Page : constant Form_Request_Code := Key_Max + 2; F_First_Page : constant Form_Request_Code := Key_Max + 3; F_Last_Page : constant Form_Request_Code := Key_Max + 4; F_Next_Field : constant Form_Request_Code := Key_Max + 5; F_Previous_Field : constant Form_Request_Code := Key_Max + 6; F_First_Field : constant Form_Request_Code := Key_Max + 7; F_Last_Field : constant Form_Request_Code := Key_Max + 8; F_Sorted_Next_Field : constant Form_Request_Code := Key_Max + 9; F_Sorted_Previous_Field : constant Form_Request_Code := Key_Max + 10; F_Sorted_First_Field : constant Form_Request_Code := Key_Max + 11; F_Sorted_Last_Field : constant Form_Request_Code := Key_Max + 12; F_Left_Field : constant Form_Request_Code := Key_Max + 13; F_Right_Field : constant Form_Request_Code := Key_Max + 14; F_Up_Field : constant Form_Request_Code := Key_Max + 15; F_Down_Field : constant Form_Request_Code := Key_Max + 16; F_Next_Char : constant Form_Request_Code := Key_Max + 17; F_Previous_Char : constant Form_Request_Code := Key_Max + 18; F_Next_Line : constant Form_Request_Code := Key_Max + 19; F_Previous_Line : constant Form_Request_Code := Key_Max + 20; F_Next_Word : constant Form_Request_Code := Key_Max + 21; F_Previous_Word : constant Form_Request_Code := Key_Max + 22; F_Begin_Field : constant Form_Request_Code := Key_Max + 23; F_End_Field : constant Form_Request_Code := Key_Max + 24; F_Begin_Line : constant Form_Request_Code := Key_Max + 25; F_End_Line : constant Form_Request_Code := Key_Max + 26; F_Left_Char : constant Form_Request_Code := Key_Max + 27; F_Right_Char : constant Form_Request_Code := Key_Max + 28; F_Up_Char : constant Form_Request_Code := Key_Max + 29; F_Down_Char : constant Form_Request_Code := Key_Max + 30; F_New_Line : constant Form_Request_Code := Key_Max + 31; F_Insert_Char : constant Form_Request_Code := Key_Max + 32; F_Insert_Line : constant Form_Request_Code := Key_Max + 33; F_Delete_Char : constant Form_Request_Code := Key_Max + 34; F_Delete_Previous : constant Form_Request_Code := Key_Max + 35; F_Delete_Line : constant Form_Request_Code := Key_Max + 36; F_Delete_Word : constant Form_Request_Code := Key_Max + 37; F_Clear_EOL : constant Form_Request_Code := Key_Max + 38; F_Clear_EOF : constant Form_Request_Code := Key_Max + 39; F_Clear_Field : constant Form_Request_Code := Key_Max + 40; F_Overlay_Mode : constant Form_Request_Code := Key_Max + 41; F_Insert_Mode : constant Form_Request_Code := Key_Max + 42; -- Vertical Scrolling F_ScrollForward_Line : constant Form_Request_Code := Key_Max + 43; F_ScrollBackward_Line : constant Form_Request_Code := Key_Max + 44; F_ScrollForward_Page : constant Form_Request_Code := Key_Max + 45; F_ScrollBackward_Page : constant Form_Request_Code := Key_Max + 46; F_ScrollForward_HalfPage : constant Form_Request_Code := Key_Max + 47; F_ScrollBackward_HalfPage : constant Form_Request_Code := Key_Max + 48; -- Horizontal Scrolling F_HScrollForward_Char : constant Form_Request_Code := Key_Max + 49; F_HScrollBackward_Char : constant Form_Request_Code := Key_Max + 50; F_HScrollForward_Line : constant Form_Request_Code := Key_Max + 51; F_HScrollBackward_Line : constant Form_Request_Code := Key_Max + 52; F_HScrollForward_HalfLine : constant Form_Request_Code := Key_Max + 53; F_HScrollBackward_HalfLine : constant Form_Request_Code := Key_Max + 54; F_Validate_Field : constant Form_Request_Code := Key_Max + 55; F_Next_Choice : constant Form_Request_Code := Key_Max + 56; F_Previous_Choice : constant Form_Request_Code := Key_Max + 57; -- For those who like the old 'C' style request names REQ_NEXT_PAGE : Form_Request_Code renames F_Next_Page; REQ_PREV_PAGE : Form_Request_Code renames F_Previous_Page; REQ_FIRST_PAGE : Form_Request_Code renames F_First_Page; REQ_LAST_PAGE : Form_Request_Code renames F_Last_Page; REQ_NEXT_FIELD : Form_Request_Code renames F_Next_Field; REQ_PREV_FIELD : Form_Request_Code renames F_Previous_Field; REQ_FIRST_FIELD : Form_Request_Code renames F_First_Field; REQ_LAST_FIELD : Form_Request_Code renames F_Last_Field; REQ_SNEXT_FIELD : Form_Request_Code renames F_Sorted_Next_Field; REQ_SPREV_FIELD : Form_Request_Code renames F_Sorted_Previous_Field; REQ_SFIRST_FIELD : Form_Request_Code renames F_Sorted_First_Field; REQ_SLAST_FIELD : Form_Request_Code renames F_Sorted_Last_Field; REQ_LEFT_FIELD : Form_Request_Code renames F_Left_Field; REQ_RIGHT_FIELD : Form_Request_Code renames F_Right_Field; REQ_UP_FIELD : Form_Request_Code renames F_Up_Field; REQ_DOWN_FIELD : Form_Request_Code renames F_Down_Field; REQ_NEXT_CHAR : Form_Request_Code renames F_Next_Char; REQ_PREV_CHAR : Form_Request_Code renames F_Previous_Char; REQ_NEXT_LINE : Form_Request_Code renames F_Next_Line; REQ_PREV_LINE : Form_Request_Code renames F_Previous_Line; REQ_NEXT_WORD : Form_Request_Code renames F_Next_Word; REQ_PREV_WORD : Form_Request_Code renames F_Previous_Word; REQ_BEG_FIELD : Form_Request_Code renames F_Begin_Field; REQ_END_FIELD : Form_Request_Code renames F_End_Field; REQ_BEG_LINE : Form_Request_Code renames F_Begin_Line; REQ_END_LINE : Form_Request_Code renames F_End_Line; REQ_LEFT_CHAR : Form_Request_Code renames F_Left_Char; REQ_RIGHT_CHAR : Form_Request_Code renames F_Right_Char; REQ_UP_CHAR : Form_Request_Code renames F_Up_Char; REQ_DOWN_CHAR : Form_Request_Code renames F_Down_Char; REQ_NEW_LINE : Form_Request_Code renames F_New_Line; REQ_INS_CHAR : Form_Request_Code renames F_Insert_Char; REQ_INS_LINE : Form_Request_Code renames F_Insert_Line; REQ_DEL_CHAR : Form_Request_Code renames F_Delete_Char; REQ_DEL_PREV : Form_Request_Code renames F_Delete_Previous; REQ_DEL_LINE : Form_Request_Code renames F_Delete_Line; REQ_DEL_WORD : Form_Request_Code renames F_Delete_Word; REQ_CLR_EOL : Form_Request_Code renames F_Clear_EOL; REQ_CLR_EOF : Form_Request_Code renames F_Clear_EOF; REQ_CLR_FIELD : Form_Request_Code renames F_Clear_Field; REQ_OVL_MODE : Form_Request_Code renames F_Overlay_Mode; REQ_INS_MODE : Form_Request_Code renames F_Insert_Mode; REQ_SCR_FLINE : Form_Request_Code renames F_ScrollForward_Line; REQ_SCR_BLINE : Form_Request_Code renames F_ScrollBackward_Line; REQ_SCR_FPAGE : Form_Request_Code renames F_ScrollForward_Page; REQ_SCR_BPAGE : Form_Request_Code renames F_ScrollBackward_Page; REQ_SCR_FHPAGE : Form_Request_Code renames F_ScrollForward_HalfPage; REQ_SCR_BHPAGE : Form_Request_Code renames F_ScrollBackward_HalfPage; REQ_SCR_FCHAR : Form_Request_Code renames F_HScrollForward_Char; REQ_SCR_BCHAR : Form_Request_Code renames F_HScrollBackward_Char; REQ_SCR_HFLINE : Form_Request_Code renames F_HScrollForward_Line; REQ_SCR_HBLINE : Form_Request_Code renames F_HScrollBackward_Line; REQ_SCR_HFHALF : Form_Request_Code renames F_HScrollForward_HalfLine; REQ_SCR_HBHALF : Form_Request_Code renames F_HScrollBackward_HalfLine; REQ_VALIDATION : Form_Request_Code renames F_Validate_Field; REQ_NEXT_CHOICE : Form_Request_Code renames F_Next_Choice; REQ_PREV_CHOICE : Form_Request_Code renames F_Previous_Choice; procedure Request_Name (Key : Form_Request_Code; Name : out String); function Request_Name (Key : Form_Request_Code) return String; -- Same as function pragma Inline (Request_Name); ------------------ -- Exceptions -- ------------------ Form_Exception : exception; -- |===================================================================== -- | Man page form_field_new.3x -- |===================================================================== -- | function Create (Height : Line_Count; Width : Column_Count; Top : Line_Position; Left : Column_Position; Off_Screen : Natural := 0; More_Buffers : Buffer_Number := Buffer_Number'First) return Field; -- AKA: new_field() -- An overloaded Create is defined later. Pragma Inline appears there. -- | function New_Field (Height : Line_Count; Width : Column_Count; Top : Line_Position; Left : Column_Position; Off_Screen : Natural := 0; More_Buffers : Buffer_Number := Buffer_Number'First) return Field renames Create; -- AKA: new_field() pragma Inline (New_Field); -- | procedure Delete (Fld : in out Field); -- AKA: free_field() -- Reset Fld to Null_Field -- An overloaded Delete is defined later. Pragma Inline appears there. -- | function Duplicate (Fld : Field; Top : Line_Position; Left : Column_Position) return Field; -- AKA: dup_field() pragma Inline (Duplicate); -- | function Link (Fld : Field; Top : Line_Position; Left : Column_Position) return Field; -- AKA: link_field() pragma Inline (Link); -- |===================================================================== -- | Man page form_field_just.3x -- |===================================================================== -- | procedure Set_Justification (Fld : Field; Just : Field_Justification := None); -- AKA: set_field_just() pragma Inline (Set_Justification); -- | function Get_Justification (Fld : Field) return Field_Justification; -- AKA: field_just() pragma Inline (Get_Justification); -- |===================================================================== -- | Man page form_field_buffer.3x -- |===================================================================== -- | procedure Set_Buffer (Fld : Field; Buffer : Buffer_Number := Buffer_Number'First; Str : String); -- AKA: set_field_buffer() -- Not inlined -- | procedure Get_Buffer (Fld : Field; Buffer : Buffer_Number := Buffer_Number'First; Str : out String); -- AKA: field_buffer() function Get_Buffer (Fld : Field; Buffer : Buffer_Number := Buffer_Number'First) return String; -- AKA: field_buffer() -- Same but as function pragma Inline (Get_Buffer); -- | procedure Set_Status (Fld : Field; Status : Boolean := True); -- AKA: set_field_status() pragma Inline (Set_Status); -- | function Changed (Fld : Field) return Boolean; -- AKA: field_status() pragma Inline (Changed); -- | procedure Set_Maximum_Size (Fld : Field; Max : Natural := 0); -- AKA: set_field_max() pragma Inline (Set_Maximum_Size); -- |===================================================================== -- | Man page form_field_opts.3x -- |===================================================================== -- | procedure Set_Options (Fld : Field; Options : Field_Option_Set); -- AKA: set_field_opts() -- An overloaded version is defined later. Pragma Inline appears there -- | procedure Switch_Options (Fld : Field; Options : Field_Option_Set; On : Boolean := True); -- AKA: field_opts_on() -- AKA: field_opts_off() -- An overloaded version is defined later. Pragma Inline appears there -- | procedure Get_Options (Fld : Field; Options : out Field_Option_Set); -- AKA: field_opts() -- | function Get_Options (Fld : Field := Null_Field) return Field_Option_Set; -- AKA: field_opts() -- An overloaded version is defined later. Pragma Inline appears there -- |===================================================================== -- | Man page form_field_attributes.3x -- |===================================================================== -- | procedure Set_Foreground (Fld : Field; Fore : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: set_field_fore() pragma Inline (Set_Foreground); -- | procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set); -- AKA: field_fore() -- | procedure Foreground (Fld : Field; Fore : out Character_Attribute_Set; Color : out Color_Pair); -- AKA: field_fore() pragma Inline (Foreground); -- | procedure Set_Background (Fld : Field; Back : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First); -- AKA: set_field_back() pragma Inline (Set_Background); -- | procedure Background (Fld : Field; Back : out Character_Attribute_Set); -- AKA: field_back() -- | procedure Background (Fld : Field; Back : out Character_Attribute_Set; Color : out Color_Pair); -- AKA: field_back() pragma Inline (Background); -- | procedure Set_Pad_Character (Fld : Field; Pad : Character := Space); -- AKA: set_field_pad() pragma Inline (Set_Pad_Character); -- | procedure Pad_Character (Fld : Field; Pad : out Character); -- AKA: field_pad() pragma Inline (Pad_Character); -- |===================================================================== -- | Man page form_field_info.3x -- |===================================================================== -- | procedure Info (Fld : Field; Lines : out Line_Count; Columns : out Column_Count; First_Row : out Line_Position; First_Column : out Column_Position; Off_Screen : out Natural; Additional_Buffers : out Buffer_Number); -- AKA: field_info() pragma Inline (Info); -- | procedure Dynamic_Info (Fld : Field; Lines : out Line_Count; Columns : out Column_Count; Max : out Natural); -- AKA: dynamic_field_info() pragma Inline (Dynamic_Info); -- |===================================================================== -- | Man page form_win.3x -- |===================================================================== -- | procedure Set_Window (Frm : Form; Win : Window); -- AKA: set_form_win() pragma Inline (Set_Window); -- | function Get_Window (Frm : Form) return Window; -- AKA: form_win() pragma Inline (Get_Window); -- | procedure Set_Sub_Window (Frm : Form; Win : Window); -- AKA: set_form_sub() pragma Inline (Set_Sub_Window); -- | function Get_Sub_Window (Frm : Form) return Window; -- AKA: form_sub() pragma Inline (Get_Sub_Window); -- | procedure Scale (Frm : Form; Lines : out Line_Count; Columns : out Column_Count); -- AKA: scale_form() pragma Inline (Scale); -- |===================================================================== -- | Man page form_hook.3x -- |===================================================================== type Form_Hook_Function is access procedure (Frm : Form); pragma Convention (C, Form_Hook_Function); -- | procedure Set_Field_Init_Hook (Frm : Form; Proc : Form_Hook_Function); -- AKA: set_field_init() pragma Inline (Set_Field_Init_Hook); -- | procedure Set_Field_Term_Hook (Frm : Form; Proc : Form_Hook_Function); -- AKA: set_field_term() pragma Inline (Set_Field_Term_Hook); -- | procedure Set_Form_Init_Hook (Frm : Form; Proc : Form_Hook_Function); -- AKA: set_form_init() pragma Inline (Set_Form_Init_Hook); -- | procedure Set_Form_Term_Hook (Frm : Form; Proc : Form_Hook_Function); -- AKA: set_form_term() pragma Inline (Set_Form_Term_Hook); -- | function Get_Field_Init_Hook (Frm : Form) return Form_Hook_Function; -- AKA: field_init() pragma Import (C, Get_Field_Init_Hook, "field_init"); -- | function Get_Field_Term_Hook (Frm : Form) return Form_Hook_Function; -- AKA: field_term() pragma Import (C, Get_Field_Term_Hook, "field_term"); -- | function Get_Form_Init_Hook (Frm : Form) return Form_Hook_Function; -- AKA: form_init() pragma Import (C, Get_Form_Init_Hook, "form_init"); -- | function Get_Form_Term_Hook (Frm : Form) return Form_Hook_Function; -- AKA: form_term() pragma Import (C, Get_Form_Term_Hook, "form_term"); -- |===================================================================== -- | Man page form_field.3x -- |===================================================================== -- | procedure Redefine (Frm : Form; Flds : Field_Array_Access); -- AKA: set_form_fields() pragma Inline (Redefine); -- | procedure Set_Fields (Frm : Form; Flds : Field_Array_Access) renames Redefine; -- AKA: set_form_fields() -- pragma Inline (Set_Fields); -- | function Fields (Frm : Form; Index : Positive) return Field; -- AKA: form_fields() pragma Inline (Fields); -- | function Field_Count (Frm : Form) return Natural; -- AKA: field_count() pragma Inline (Field_Count); -- | procedure Move (Fld : Field; Line : Line_Position; Column : Column_Position); -- AKA: move_field() pragma Inline (Move); -- |===================================================================== -- | Man page form_new.3x -- |===================================================================== -- | function Create (Fields : Field_Array_Access) return Form; -- AKA: new_form() pragma Inline (Create); -- | function New_Form (Fields : Field_Array_Access) return Form renames Create; -- AKA: new_form() -- pragma Inline (New_Form); -- | procedure Delete (Frm : in out Form); -- AKA: free_form() -- Reset Frm to Null_Form pragma Inline (Delete); -- |===================================================================== -- | Man page form_opts.3x -- |===================================================================== -- | procedure Set_Options (Frm : Form; Options : Form_Option_Set); -- AKA: set_form_opts() pragma Inline (Set_Options); -- | procedure Switch_Options (Frm : Form; Options : Form_Option_Set; On : Boolean := True); -- AKA: form_opts_on() -- AKA: form_opts_off() pragma Inline (Switch_Options); -- | procedure Get_Options (Frm : Form; Options : out Form_Option_Set); -- AKA: form_opts() -- | function Get_Options (Frm : Form := Null_Form) return Form_Option_Set; -- AKA: form_opts() pragma Inline (Get_Options); -- |===================================================================== -- | Man page form_post.3x -- |===================================================================== -- | procedure Post (Frm : Form; Post : Boolean := True); -- AKA: post_form() -- AKA: unpost_form() pragma Inline (Post); -- |===================================================================== -- | Man page form_cursor.3x -- |===================================================================== -- | procedure Position_Cursor (Frm : Form); -- AKA: pos_form_cursor() pragma Inline (Position_Cursor); -- |===================================================================== -- | Man page form_data.3x -- |===================================================================== -- | function Data_Ahead (Frm : Form) return Boolean; -- AKA: data_ahead() pragma Inline (Data_Ahead); -- | function Data_Behind (Frm : Form) return Boolean; -- AKA: data_behind() pragma Inline (Data_Behind); -- |===================================================================== -- | Man page form_driver.3x -- |===================================================================== type Driver_Result is (Form_Ok, Request_Denied, Unknown_Request, Invalid_Field); -- | function Driver (Frm : Form; Key : Key_Code) return Driver_Result; -- AKA: form_driver() -- Driver not inlined -- |===================================================================== -- | Man page form_page.3x -- |===================================================================== type Page_Number is new Natural; -- | procedure Set_Current (Frm : Form; Fld : Field); -- AKA: set_current_field() pragma Inline (Set_Current); -- | function Current (Frm : Form) return Field; -- AKA: current_field() pragma Inline (Current); -- | procedure Set_Page (Frm : Form; Page : Page_Number := Page_Number'First); -- AKA: set_form_page() pragma Inline (Set_Page); -- | function Page (Frm : Form) return Page_Number; -- AKA: form_page() pragma Inline (Page); -- | function Get_Index (Fld : Field) return Positive; -- AKA: field_index() -- Please note that in this binding we start the numbering of fields -- with 1. So this is number is one more than you get from the low -- level call. pragma Inline (Get_Index); -- |===================================================================== -- | Man page form_new_page.3x -- |===================================================================== -- | procedure Set_New_Page (Fld : Field; New_Page : Boolean := True); -- AKA: set_new_page() pragma Inline (Set_New_Page); -- | function Is_New_Page (Fld : Field) return Boolean; -- AKA: new_page() pragma Inline (Is_New_Page); -- |===================================================================== -- | Man page form_requestname.3x -- |===================================================================== -- Not Implemented: form_request_name, form_request_by_name ------------------------------------------------------------------------------ private type Field is new System.Storage_Elements.Integer_Address; type Form is new System.Storage_Elements.Integer_Address; Null_Field : constant Field := 0; Null_Form : constant Form := 0; end Terminal_Interface.Curses.Forms;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-fixed_io__adb.htm 0000644 0001751 0000144 00000026562 13615673306 025725 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Fixed_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Text_IO; with Terminal_Interface.Curses.Text_IO.Aux; package body Terminal_Interface.Curses.Text_IO.Fixed_IO is package Aux renames Terminal_Interface.Curses.Text_IO.Aux; package FIXIO is new Ada.Text_IO.Fixed_IO (Num); procedure Put (Win : Window; Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is Buf : String (1 .. Field'Last); Len : Field := Fore + 1 + Aft; begin if Exp > 0 then Len := Len + 1 + Exp; end if; FIXIO.Put (Buf, Item, Aft, Exp); Aux.Put_Buf (Win, Buf, Len, False); end Put; procedure Put (Item : Num; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is begin Put (Get_Window, Item, Fore, Aft, Exp); end Put; end Terminal_Interface.Curses.Text_IO.Fixed_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_user_data__ads.htm 0000644 0001751 0000144 00000022303 13615673306 026732 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_User_Data -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1998-2003,2009 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 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type User is limited private; type User_Access is access User; package Terminal_Interface.Curses.Forms.Field_User_Data is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_User_Data); -- |===================================================================== -- | Man page form_field_userptr.3x -- |===================================================================== -- | procedure Set_User_Data (Fld : Field; Data : User_Access); -- AKA: set_field_userptr pragma Inline (Set_User_Data); -- | procedure Get_User_Data (Fld : Field; Data : out User_Access); -- AKA: field_userptr -- | function Get_User_Data (Fld : Field) return User_Access; -- AKA: field_userptr -- Sama as function pragma Inline (Get_User_Data); end Terminal_Interface.Curses.Forms.Field_User_Data;AdaCurses-20211021/doc/ada/terminal_interface-curses-trace__adb.htm 0000644 0001751 0000144 00000016752 13615673306 023564 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Trace -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2001-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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; use Interfaces.C; package body Terminal_Interface.Curses.Trace is procedure Trace_On (x : Trace_Attribute_Set) is procedure traceC (y : Trace_Attribute_Set); pragma Import (C, traceC, "trace"); begin traceC (x); end Trace_On; procedure Trace_Put (str : String) is procedure tracef (format : char_array; s : char_array); pragma Import (C, tracef, "_traces"); -- _traces() is defined in c_varargs_to_ada.h begin tracef (To_C ("%s"), To_C (str)); end Trace_Put; end Terminal_Interface.Curses.Trace;AdaCurses-20211021/doc/ada/files.htm 0000644 0001751 0000144 00000000512 12145772562 015454 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.User.Choice -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2008,2011 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.15 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Interfaces.C; package Terminal_Interface.Curses.Forms.Field_Types.User.Choice is pragma Preelaborate (Terminal_Interface.Curses.Forms.Field_Types.User.Choice); subtype C_Int is Interfaces.C.int; type User_Defined_Field_Type_With_Choice is abstract new User_Defined_Field_Type with null record; -- This is the root of the mechanism we use to create field types in -- Ada95 that allow the prev/next mechanism. You should your own type -- derive from this one and implement the Field_Check, Character_Check -- Next and Previous functions for your own type. type User_Defined_Field_Type_With_Choice_Access is access all User_Defined_Field_Type_With_Choice'Class; function Next (Fld : Field; Typ : User_Defined_Field_Type_With_Choice) return Boolean is abstract; -- If True is returned, the function successfully generated a next -- value into the fields buffer. function Previous (Fld : Field; Typ : User_Defined_Field_Type_With_Choice) return Boolean is abstract; -- If True is returned, the function successfully generated a previous -- value into the fields buffer. -- +---------------------------------------------------------------------- -- | Private Part. -- | private function C_Generic_Choice return C_Field_Type; function Generic_Next (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Next); -- This is the generic next Choice_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Next implementation for the type. function Generic_Prev (Fld : Field; Usr : System.Address) return Curses_Bool; pragma Convention (C, Generic_Prev); -- This is the generic prev Choice_Function for the low-level fieldtype -- representing all the User_Defined_Field_Type derivatives. It routes -- the call to the Previous implementation for the type. end Terminal_Interface.Curses.Forms.Field_Types.User.Choice;AdaCurses-20211021/doc/ada/terminal_interface-curses-menus__adb.htm 0000644 0001751 0000144 00000377472 13615673306 023626 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Menus -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2018,2020 Thomas E. Dickey -- -- Copyright 1999-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.34 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Ada.Unchecked_Deallocation; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Interfaces.C.Pointers; package body Terminal_Interface.Curses.Menus is type C_Item_Array is array (Natural range <>) of aliased Item; package I_Array is new Interfaces.C.Pointers (Natural, Item, C_Item_Array, Null_Item); subtype chars_ptr is Interfaces.C.Strings.chars_ptr; ------------------------------------------------------------------------------ procedure Request_Name (Key : Menu_Request_Code; Name : out String) is function Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Request_Name, "menu_request_name"); begin Fill_String (Request_Name (C_Int (Key)), Name); end Request_Name; function Request_Name (Key : Menu_Request_Code) return String is function Request_Name (Key : C_Int) return chars_ptr; pragma Import (C, Request_Name, "menu_request_name"); begin return Fill_String (Request_Name (C_Int (Key))); end Request_Name; function Create (Name : String; Description : String := "") return Item is type Char_Ptr is access all Interfaces.C.char; function Newitem (Name, Desc : Char_Ptr) return Item; pragma Import (C, Newitem, "new_item"); type Name_String is new char_array (0 .. Name'Length); type Name_String_Ptr is access Name_String; pragma Controlled (Name_String_Ptr); type Desc_String is new char_array (0 .. Description'Length); type Desc_String_Ptr is access Desc_String; pragma Controlled (Desc_String_Ptr); Name_Str : constant Name_String_Ptr := new Name_String; Desc_Str : constant Desc_String_Ptr := new Desc_String; Name_Len, Desc_Len : size_t; Result : Item; begin To_C (Name, Name_Str.all, Name_Len); To_C (Description, Desc_Str.all, Desc_Len); Result := Newitem (Name_Str.all (Name_Str.all'First)'Access, Desc_Str.all (Desc_Str.all'First)'Access); if Result = Null_Item then raise Eti_System_Error; end if; return Result; end Create; procedure Delete (Itm : in out Item) is function Descname (Itm : Item) return chars_ptr; pragma Import (C, Descname, "item_description"); function Itemname (Itm : Item) return chars_ptr; pragma Import (C, Itemname, "item_name"); function Freeitem (Itm : Item) return Eti_Error; pragma Import (C, Freeitem, "free_item"); Ptr : chars_ptr; begin Ptr := Descname (Itm); if Ptr /= Null_Ptr then Interfaces.C.Strings.Free (Ptr); end if; Ptr := Itemname (Itm); if Ptr /= Null_Ptr then Interfaces.C.Strings.Free (Ptr); end if; Eti_Exception (Freeitem (Itm)); Itm := Null_Item; end Delete; ------------------------------------------------------------------------------- procedure Set_Value (Itm : Item; Value : Boolean := True) is function Set_Item_Val (Itm : Item; Val : C_Int) return Eti_Error; pragma Import (C, Set_Item_Val, "set_item_value"); begin Eti_Exception (Set_Item_Val (Itm, Boolean'Pos (Value))); end Set_Value; function Value (Itm : Item) return Boolean is function Item_Val (Itm : Item) return C_Int; pragma Import (C, Item_Val, "item_value"); begin if Item_Val (Itm) = Curses_False then return False; else return True; end if; end Value; ------------------------------------------------------------------------------- function Visible (Itm : Item) return Boolean is function Item_Vis (Itm : Item) return C_Int; pragma Import (C, Item_Vis, "item_visible"); begin if Item_Vis (Itm) = Curses_False then return False; else return True; end if; end Visible; ------------------------------------------------------------------------------- procedure Set_Options (Itm : Item; Options : Item_Option_Set) is function Set_Item_Opts (Itm : Item; Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Set_Item_Opts, "set_item_opts"); begin Eti_Exception (Set_Item_Opts (Itm, Options)); end Set_Options; procedure Switch_Options (Itm : Item; Options : Item_Option_Set; On : Boolean := True) is function Item_Opts_On (Itm : Item; Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Item_Opts_On, "item_opts_on"); function Item_Opts_Off (Itm : Item; Opt : Item_Option_Set) return Eti_Error; pragma Import (C, Item_Opts_Off, "item_opts_off"); begin if On then Eti_Exception (Item_Opts_On (Itm, Options)); else Eti_Exception (Item_Opts_Off (Itm, Options)); end if; end Switch_Options; procedure Get_Options (Itm : Item; Options : out Item_Option_Set) is function Item_Opts (Itm : Item) return Item_Option_Set; pragma Import (C, Item_Opts, "item_opts"); begin Options := Item_Opts (Itm); end Get_Options; function Get_Options (Itm : Item := Null_Item) return Item_Option_Set is Ios : Item_Option_Set; begin Get_Options (Itm, Ios); return Ios; end Get_Options; ------------------------------------------------------------------------------- procedure Name (Itm : Item; Name : out String) is function Itemname (Itm : Item) return chars_ptr; pragma Import (C, Itemname, "item_name"); begin Fill_String (Itemname (Itm), Name); end Name; function Name (Itm : Item) return String is function Itemname (Itm : Item) return chars_ptr; pragma Import (C, Itemname, "item_name"); begin return Fill_String (Itemname (Itm)); end Name; procedure Description (Itm : Item; Description : out String) is function Descname (Itm : Item) return chars_ptr; pragma Import (C, Descname, "item_description"); begin Fill_String (Descname (Itm), Description); end Description; function Description (Itm : Item) return String is function Descname (Itm : Item) return chars_ptr; pragma Import (C, Descname, "item_description"); begin return Fill_String (Descname (Itm)); end Description; ------------------------------------------------------------------------------- procedure Set_Current (Men : Menu; Itm : Item) is function Set_Curr_Item (Men : Menu; Itm : Item) return Eti_Error; pragma Import (C, Set_Curr_Item, "set_current_item"); begin Eti_Exception (Set_Curr_Item (Men, Itm)); end Set_Current; function Current (Men : Menu) return Item is function Curr_Item (Men : Menu) return Item; pragma Import (C, Curr_Item, "current_item"); Res : constant Item := Curr_Item (Men); begin if Res = Null_Item then raise Menu_Exception; end if; return Res; end Current; procedure Set_Top_Row (Men : Menu; Line : Line_Position) is function Set_Toprow (Men : Menu; Line : C_Int) return Eti_Error; pragma Import (C, Set_Toprow, "set_top_row"); begin Eti_Exception (Set_Toprow (Men, C_Int (Line))); end Set_Top_Row; function Top_Row (Men : Menu) return Line_Position is function Toprow (Men : Menu) return C_Int; pragma Import (C, Toprow, "top_row"); Res : constant C_Int := Toprow (Men); begin if Res = Curses_Err then raise Menu_Exception; end if; return Line_Position (Res); end Top_Row; function Get_Index (Itm : Item) return Positive is function Get_Itemindex (Itm : Item) return C_Int; pragma Import (C, Get_Itemindex, "item_index"); Res : constant C_Int := Get_Itemindex (Itm); begin if Res = Curses_Err then raise Menu_Exception; end if; return Positive (Natural (Res) + Positive'First); end Get_Index; ------------------------------------------------------------------------------- procedure Post (Men : Menu; Post : Boolean := True) is function M_Post (Men : Menu) return Eti_Error; pragma Import (C, M_Post, "post_menu"); function M_Unpost (Men : Menu) return Eti_Error; pragma Import (C, M_Unpost, "unpost_menu"); begin if Post then Eti_Exception (M_Post (Men)); else Eti_Exception (M_Unpost (Men)); end if; end Post; ------------------------------------------------------------------------------- procedure Set_Options (Men : Menu; Options : Menu_Option_Set) is function Set_Menu_Opts (Men : Menu; Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Set_Menu_Opts, "set_menu_opts"); begin Eti_Exception (Set_Menu_Opts (Men, Options)); end Set_Options; procedure Switch_Options (Men : Menu; Options : Menu_Option_Set; On : Boolean := True) is function Menu_Opts_On (Men : Menu; Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Menu_Opts_On, "menu_opts_on"); function Menu_Opts_Off (Men : Menu; Opt : Menu_Option_Set) return Eti_Error; pragma Import (C, Menu_Opts_Off, "menu_opts_off"); begin if On then Eti_Exception (Menu_Opts_On (Men, Options)); else Eti_Exception (Menu_Opts_Off (Men, Options)); end if; end Switch_Options; procedure Get_Options (Men : Menu; Options : out Menu_Option_Set) is function Menu_Opts (Men : Menu) return Menu_Option_Set; pragma Import (C, Menu_Opts, "menu_opts"); begin Options := Menu_Opts (Men); end Get_Options; function Get_Options (Men : Menu := Null_Menu) return Menu_Option_Set is Mos : Menu_Option_Set; begin Get_Options (Men, Mos); return Mos; end Get_Options; ------------------------------------------------------------------------------- procedure Set_Window (Men : Menu; Win : Window) is function Set_Menu_Win (Men : Menu; Win : Window) return Eti_Error; pragma Import (C, Set_Menu_Win, "set_menu_win"); begin Eti_Exception (Set_Menu_Win (Men, Win)); end Set_Window; function Get_Window (Men : Menu) return Window is function Menu_Win (Men : Menu) return Window; pragma Import (C, Menu_Win, "menu_win"); W : constant Window := Menu_Win (Men); begin return W; end Get_Window; procedure Set_Sub_Window (Men : Menu; Win : Window) is function Set_Menu_Sub (Men : Menu; Win : Window) return Eti_Error; pragma Import (C, Set_Menu_Sub, "set_menu_sub"); begin Eti_Exception (Set_Menu_Sub (Men, Win)); end Set_Sub_Window; function Get_Sub_Window (Men : Menu) return Window is function Menu_Sub (Men : Menu) return Window; pragma Import (C, Menu_Sub, "menu_sub"); W : constant Window := Menu_Sub (Men); begin return W; end Get_Sub_Window; procedure Scale (Men : Menu; Lines : out Line_Count; Columns : out Column_Count) is type C_Int_Access is access all C_Int; function M_Scale (Men : Menu; Yp, Xp : C_Int_Access) return Eti_Error; pragma Import (C, M_Scale, "scale_menu"); X, Y : aliased C_Int; begin Eti_Exception (M_Scale (Men, Y'Access, X'Access)); Lines := Line_Count (Y); Columns := Column_Count (X); end Scale; ------------------------------------------------------------------------------- procedure Position_Cursor (Men : Menu) is function Pos_Menu_Cursor (Men : Menu) return Eti_Error; pragma Import (C, Pos_Menu_Cursor, "pos_menu_cursor"); begin Eti_Exception (Pos_Menu_Cursor (Men)); end Position_Cursor; ------------------------------------------------------------------------------- procedure Set_Mark (Men : Menu; Mark : String) is type Char_Ptr is access all Interfaces.C.char; function Set_Mark (Men : Menu; Mark : Char_Ptr) return Eti_Error; pragma Import (C, Set_Mark, "set_menu_mark"); Txt : char_array (0 .. Mark'Length); Len : size_t; begin To_C (Mark, Txt, Len); Eti_Exception (Set_Mark (Men, Txt (Txt'First)'Access)); end Set_Mark; procedure Mark (Men : Menu; Mark : out String) is function Get_Menu_Mark (Men : Menu) return chars_ptr; pragma Import (C, Get_Menu_Mark, "menu_mark"); begin Fill_String (Get_Menu_Mark (Men), Mark); end Mark; function Mark (Men : Menu) return String is function Get_Menu_Mark (Men : Menu) return chars_ptr; pragma Import (C, Get_Menu_Mark, "menu_mark"); begin return Fill_String (Get_Menu_Mark (Men)); end Mark; ------------------------------------------------------------------------------- procedure Set_Foreground (Men : Menu; Fore : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Set_Menu_Fore (Men : Menu; Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Fore, "set_menu_fore"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Fore); begin Eti_Exception (Set_Menu_Fore (Men, Ch)); end Set_Foreground; procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set) is function Menu_Fore (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Fore, "menu_fore"); begin Fore := Menu_Fore (Men).Attr; end Foreground; procedure Foreground (Men : Menu; Fore : out Character_Attribute_Set; Color : out Color_Pair) is function Menu_Fore (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Fore, "menu_fore"); begin Fore := Menu_Fore (Men).Attr; Color := Menu_Fore (Men).Color; end Foreground; procedure Set_Background (Men : Menu; Back : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Set_Menu_Back (Men : Menu; Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Back, "set_menu_back"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Back); begin Eti_Exception (Set_Menu_Back (Men, Ch)); end Set_Background; procedure Background (Men : Menu; Back : out Character_Attribute_Set) is function Menu_Back (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Back, "menu_back"); begin Back := Menu_Back (Men).Attr; end Background; procedure Background (Men : Menu; Back : out Character_Attribute_Set; Color : out Color_Pair) is function Menu_Back (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Back, "menu_back"); begin Back := Menu_Back (Men).Attr; Color := Menu_Back (Men).Color; end Background; procedure Set_Grey (Men : Menu; Grey : Character_Attribute_Set := Normal_Video; Color : Color_Pair := Color_Pair'First) is function Set_Menu_Grey (Men : Menu; Attr : Attributed_Character) return Eti_Error; pragma Import (C, Set_Menu_Grey, "set_menu_grey"); Ch : constant Attributed_Character := (Ch => Character'First, Color => Color, Attr => Grey); begin Eti_Exception (Set_Menu_Grey (Men, Ch)); end Set_Grey; procedure Grey (Men : Menu; Grey : out Character_Attribute_Set) is function Menu_Grey (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Grey, "menu_grey"); begin Grey := Menu_Grey (Men).Attr; end Grey; procedure Grey (Men : Menu; Grey : out Character_Attribute_Set; Color : out Color_Pair) is function Menu_Grey (Men : Menu) return Attributed_Character; pragma Import (C, Menu_Grey, "menu_grey"); begin Grey := Menu_Grey (Men).Attr; Color := Menu_Grey (Men).Color; end Grey; procedure Set_Pad_Character (Men : Menu; Pad : Character := Space) is function Set_Menu_Pad (Men : Menu; Ch : C_Int) return Eti_Error; pragma Import (C, Set_Menu_Pad, "set_menu_pad"); begin Eti_Exception (Set_Menu_Pad (Men, C_Int (Character'Pos (Pad)))); end Set_Pad_Character; procedure Pad_Character (Men : Menu; Pad : out Character) is function Menu_Pad (Men : Menu) return C_Int; pragma Import (C, Menu_Pad, "menu_pad"); begin Pad := Character'Val (Menu_Pad (Men)); end Pad_Character; ------------------------------------------------------------------------------- procedure Set_Spacing (Men : Menu; Descr : Column_Position := 0; Row : Line_Position := 0; Col : Column_Position := 0) is function Set_Spacing (Men : Menu; D, R, C : C_Int) return Eti_Error; pragma Import (C, Set_Spacing, "set_menu_spacing"); begin Eti_Exception (Set_Spacing (Men, C_Int (Descr), C_Int (Row), C_Int (Col))); end Set_Spacing; procedure Spacing (Men : Menu; Descr : out Column_Position; Row : out Line_Position; Col : out Column_Position) is type C_Int_Access is access all C_Int; function Get_Spacing (Men : Menu; D, R, C : C_Int_Access) return Eti_Error; pragma Import (C, Get_Spacing, "menu_spacing"); D, R, C : aliased C_Int; begin Eti_Exception (Get_Spacing (Men, D'Access, R'Access, C'Access)); Descr := Column_Position (D); Row := Line_Position (R); Col := Column_Position (C); end Spacing; ------------------------------------------------------------------------------- function Set_Pattern (Men : Menu; Text : String) return Boolean is type Char_Ptr is access all Interfaces.C.char; function Set_Pattern (Men : Menu; Pattern : Char_Ptr) return Eti_Error; pragma Import (C, Set_Pattern, "set_menu_pattern"); S : char_array (0 .. Text'Length); L : size_t; Res : Eti_Error; begin To_C (Text, S, L); Res := Set_Pattern (Men, S (S'First)'Access); case Res is when E_No_Match => return False; when others => Eti_Exception (Res); return True; end case; end Set_Pattern; procedure Pattern (Men : Menu; Text : out String) is function Get_Pattern (Men : Menu) return chars_ptr; pragma Import (C, Get_Pattern, "menu_pattern"); begin Fill_String (Get_Pattern (Men), Text); end Pattern; ------------------------------------------------------------------------------- procedure Set_Format (Men : Menu; Lines : Line_Count; Columns : Column_Count) is function Set_Menu_Fmt (Men : Menu; Lin : C_Int; Col : C_Int) return Eti_Error; pragma Import (C, Set_Menu_Fmt, "set_menu_format"); begin Eti_Exception (Set_Menu_Fmt (Men, C_Int (Lines), C_Int (Columns))); end Set_Format; procedure Format (Men : Menu; Lines : out Line_Count; Columns : out Column_Count) is type C_Int_Access is access all C_Int; function Menu_Fmt (Men : Menu; Y, X : C_Int_Access) return Eti_Error; pragma Import (C, Menu_Fmt, "menu_format"); L, C : aliased C_Int; begin Eti_Exception (Menu_Fmt (Men, L'Access, C'Access)); Lines := Line_Count (L); Columns := Column_Count (C); end Format; ------------------------------------------------------------------------------- procedure Set_Item_Init_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Item_Init (Men : Menu; Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Item_Init, "set_item_init"); begin Eti_Exception (Set_Item_Init (Men, Proc)); end Set_Item_Init_Hook; procedure Set_Item_Term_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Item_Term (Men : Menu; Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Item_Term, "set_item_term"); begin Eti_Exception (Set_Item_Term (Men, Proc)); end Set_Item_Term_Hook; procedure Set_Menu_Init_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Menu_Init (Men : Menu; Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Menu_Init, "set_menu_init"); begin Eti_Exception (Set_Menu_Init (Men, Proc)); end Set_Menu_Init_Hook; procedure Set_Menu_Term_Hook (Men : Menu; Proc : Menu_Hook_Function) is function Set_Menu_Term (Men : Menu; Proc : Menu_Hook_Function) return Eti_Error; pragma Import (C, Set_Menu_Term, "set_menu_term"); begin Eti_Exception (Set_Menu_Term (Men, Proc)); end Set_Menu_Term_Hook; function Get_Item_Init_Hook (Men : Menu) return Menu_Hook_Function is function Item_Init (Men : Menu) return Menu_Hook_Function; pragma Import (C, Item_Init, "item_init"); begin return Item_Init (Men); end Get_Item_Init_Hook; function Get_Item_Term_Hook (Men : Menu) return Menu_Hook_Function is function Item_Term (Men : Menu) return Menu_Hook_Function; pragma Import (C, Item_Term, "item_term"); begin return Item_Term (Men); end Get_Item_Term_Hook; function Get_Menu_Init_Hook (Men : Menu) return Menu_Hook_Function is function Menu_Init (Men : Menu) return Menu_Hook_Function; pragma Import (C, Menu_Init, "menu_init"); begin return Menu_Init (Men); end Get_Menu_Init_Hook; function Get_Menu_Term_Hook (Men : Menu) return Menu_Hook_Function is function Menu_Term (Men : Menu) return Menu_Hook_Function; pragma Import (C, Menu_Term, "menu_term"); begin return Menu_Term (Men); end Get_Menu_Term_Hook; ------------------------------------------------------------------------------- procedure Redefine (Men : Menu; Items : Item_Array_Access) is function Set_Items (Men : Menu; Items : System.Address) return Eti_Error; pragma Import (C, Set_Items, "set_menu_items"); begin pragma Assert (Items.all (Items'Last) = Null_Item); if Items.all (Items'Last) /= Null_Item then raise Menu_Exception; else Eti_Exception (Set_Items (Men, Items.all'Address)); end if; end Redefine; function Item_Count (Men : Menu) return Natural is function Count (Men : Menu) return C_Int; pragma Import (C, Count, "item_count"); begin return Natural (Count (Men)); end Item_Count; function Items (Men : Menu; Index : Positive) return Item is use I_Array; function C_Mitems (Men : Menu) return Pointer; pragma Import (C, C_Mitems, "menu_items"); P : Pointer := C_Mitems (Men); begin if P = null or else Index > Item_Count (Men) then raise Menu_Exception; else P := P + ptrdiff_t (C_Int (Index) - 1); return P.all; end if; end Items; ------------------------------------------------------------------------------- function Create (Items : Item_Array_Access) return Menu is function Newmenu (Items : System.Address) return Menu; pragma Import (C, Newmenu, "new_menu"); M : Menu; begin pragma Assert (Items.all (Items'Last) = Null_Item); if Items.all (Items'Last) /= Null_Item then raise Menu_Exception; else M := Newmenu (Items.all'Address); if M = Null_Menu then raise Menu_Exception; end if; return M; end if; end Create; procedure Delete (Men : in out Menu) is function Free (Men : Menu) return Eti_Error; pragma Import (C, Free, "free_menu"); begin Eti_Exception (Free (Men)); Men := Null_Menu; end Delete; ------------------------------------------------------------------------------ function Driver (Men : Menu; Key : Key_Code) return Driver_Result is function Driver (Men : Menu; Key : C_Int) return Eti_Error; pragma Import (C, Driver, "menu_driver"); R : constant Eti_Error := Driver (Men, C_Int (Key)); begin case R is when E_Unknown_Command => return Unknown_Request; when E_No_Match => return No_Match; when E_Request_Denied | E_Not_Selectable => return Request_Denied; when others => Eti_Exception (R); return Menu_Ok; end case; end Driver; procedure Free (IA : in out Item_Array_Access; Free_Items : Boolean := False) is procedure Release is new Ada.Unchecked_Deallocation (Item_Array, Item_Array_Access); begin if IA /= null and then Free_Items then for I in IA'First .. (IA'Last - 1) loop if IA.all (I) /= Null_Item then Delete (IA.all (I)); end if; end loop; end if; Release (IA); end Free; ------------------------------------------------------------------------------- function Default_Menu_Options return Menu_Option_Set is begin return Get_Options (Null_Menu); end Default_Menu_Options; function Default_Item_Options return Item_Option_Set is begin return Get_Options (Null_Item); end Default_Item_Options; ------------------------------------------------------------------------------- end Terminal_Interface.Curses.Menus;AdaCurses-20211021/doc/ada/terminal_interface-curses_constants__ads.htm 0000644 0001751 0000144 00000113060 14134122305 024554 0 ustar tom users
-- Generated by the C program ./generate (source ./gen.c). -- Do not edit this file directly. -- The values provided here may vary on your system. with System; package Terminal_Interface.Curses_Constants is pragma Pure; DFT_ARG_SUFFIX : constant String := ""; Bit_Order : constant System.Bit_Order := System.Low_Order_First; Sizeof_Bool : constant := 8; OK : constant := 0; ERR : constant := -1; pragma Warnings (Off); -- redefinition of Standard.True and False TRUE : constant := 1; FALSE : constant := 0; pragma Warnings (On); -- Version of the ncurses library from extensions(3NCURSES) NCURSES_VERSION_MAJOR : constant := 6; NCURSES_VERSION_MINOR : constant := 3; Version : constant String := "6.3"; -- Character non-color attributes from attr(3NCURSES) -- attr_t and chtype may be signed in C. type attr_t is mod 2 ** 32; A_CHARTEXT_First : constant := 0; A_CHARTEXT_Last : constant := 7; A_COLOR_First : constant := 8; A_COLOR_Last : constant := 15; Attr_First : constant := 16; Attr_Last : constant := 31; A_STANDOUT_First : constant := 16; A_STANDOUT_Last : constant := 16; A_UNDERLINE_First : constant := 17; A_UNDERLINE_Last : constant := 17; A_REVERSE_First : constant := 18; A_REVERSE_Last : constant := 18; A_BLINK_First : constant := 19; A_BLINK_Last : constant := 19; A_DIM_First : constant := 20; A_DIM_Last : constant := 20; A_BOLD_First : constant := 21; A_BOLD_Last : constant := 21; A_PROTECT_First : constant := 24; A_PROTECT_Last : constant := 24; A_INVIS_First : constant := 23; A_INVIS_Last : constant := 23; A_ALTCHARSET_First : constant := 22; A_ALTCHARSET_Last : constant := 22; A_HORIZONTAL_First : constant := 25; A_HORIZONTAL_Last : constant := 25; A_LEFT_First : constant := 26; A_LEFT_Last : constant := 26; A_LOW_First : constant := 27; A_LOW_Last : constant := 27; A_RIGHT_First : constant := 28; A_RIGHT_Last : constant := 28; A_TOP_First : constant := 29; A_TOP_Last : constant := 29; A_VERTICAL_First : constant := 30; A_VERTICAL_Last : constant := 30; chtype_Size : constant := 32; -- predefined color numbers from color(3NCURSES) COLOR_BLACK : constant := 0; COLOR_RED : constant := 1; COLOR_GREEN : constant := 2; COLOR_YELLOW : constant := 3; COLOR_BLUE : constant := 4; COLOR_MAGENTA : constant := 5; COLOR_CYAN : constant := 6; COLOR_WHITE : constant := 7; -- ETI return codes from ncurses.h E_OK : constant := 0; E_SYSTEM_ERROR : constant := -1; E_BAD_ARGUMENT : constant := -2; E_POSTED : constant := -3; E_CONNECTED : constant := -4; E_BAD_STATE : constant := -5; E_NO_ROOM : constant := -6; E_NOT_POSTED : constant := -7; E_UNKNOWN_COMMAND : constant := -8; E_NO_MATCH : constant := -9; E_NOT_SELECTABLE : constant := -10; E_NOT_CONNECTED : constant := -11; E_REQUEST_DENIED : constant := -12; E_INVALID_FIELD : constant := -13; E_CURRENT : constant := -14; -- Input key codes not defined in any ncurses manpage KEY_MIN : constant := 257; KEY_MAX : constant := 511; KEY_CODE_YES : constant := 256; -- Input key codes from getch(3NCURSES) KEY_BREAK : constant := 257; KEY_DOWN : constant := 258; KEY_UP : constant := 259; KEY_LEFT : constant := 260; KEY_RIGHT : constant := 261; KEY_HOME : constant := 262; KEY_BACKSPACE : constant := 263; KEY_F0 : constant := 264; KEY_F1 : constant := 265; KEY_F2 : constant := 266; KEY_F3 : constant := 267; KEY_F4 : constant := 268; KEY_F5 : constant := 269; KEY_F6 : constant := 270; KEY_F7 : constant := 271; KEY_F8 : constant := 272; KEY_F9 : constant := 273; KEY_F10 : constant := 274; KEY_F11 : constant := 275; KEY_F12 : constant := 276; KEY_F13 : constant := 277; KEY_F14 : constant := 278; KEY_F15 : constant := 279; KEY_F16 : constant := 280; KEY_F17 : constant := 281; KEY_F18 : constant := 282; KEY_F19 : constant := 283; KEY_F20 : constant := 284; KEY_F21 : constant := 285; KEY_F22 : constant := 286; KEY_F23 : constant := 287; KEY_F24 : constant := 288; KEY_DL : constant := 328; KEY_IL : constant := 329; KEY_DC : constant := 330; KEY_IC : constant := 331; KEY_EIC : constant := 332; KEY_CLEAR : constant := 333; KEY_EOS : constant := 334; KEY_EOL : constant := 335; KEY_SF : constant := 336; KEY_SR : constant := 337; KEY_NPAGE : constant := 338; KEY_PPAGE : constant := 339; KEY_STAB : constant := 340; KEY_CTAB : constant := 341; KEY_CATAB : constant := 342; KEY_ENTER : constant := 343; KEY_SRESET : constant := 344; KEY_RESET : constant := 345; KEY_PRINT : constant := 346; KEY_LL : constant := 347; KEY_A1 : constant := 348; KEY_A3 : constant := 349; KEY_B2 : constant := 350; KEY_C1 : constant := 351; KEY_C3 : constant := 352; KEY_BTAB : constant := 353; KEY_BEG : constant := 354; KEY_CANCEL : constant := 355; KEY_CLOSE : constant := 356; KEY_COMMAND : constant := 357; KEY_COPY : constant := 358; KEY_CREATE : constant := 359; KEY_END : constant := 360; KEY_EXIT : constant := 361; KEY_FIND : constant := 362; KEY_HELP : constant := 363; KEY_MARK : constant := 364; KEY_MESSAGE : constant := 365; KEY_MOVE : constant := 366; KEY_NEXT : constant := 367; KEY_OPEN : constant := 368; KEY_OPTIONS : constant := 369; KEY_PREVIOUS : constant := 370; KEY_REDO : constant := 371; KEY_REFERENCE : constant := 372; KEY_REFRESH : constant := 373; KEY_REPLACE : constant := 374; KEY_RESTART : constant := 375; KEY_RESUME : constant := 376; KEY_SAVE : constant := 377; KEY_SBEG : constant := 378; KEY_SCANCEL : constant := 379; KEY_SCOMMAND : constant := 380; KEY_SCOPY : constant := 381; KEY_SCREATE : constant := 382; KEY_SDC : constant := 383; KEY_SDL : constant := 384; KEY_SELECT : constant := 385; KEY_SEND : constant := 386; KEY_SEOL : constant := 387; KEY_SEXIT : constant := 388; KEY_SFIND : constant := 389; KEY_SHELP : constant := 390; KEY_SHOME : constant := 391; KEY_SIC : constant := 392; KEY_SLEFT : constant := 393; KEY_SMESSAGE : constant := 394; KEY_SMOVE : constant := 395; KEY_SNEXT : constant := 396; KEY_SOPTIONS : constant := 397; KEY_SPREVIOUS : constant := 398; KEY_SPRINT : constant := 399; KEY_SREDO : constant := 400; KEY_SREPLACE : constant := 401; KEY_SRIGHT : constant := 402; KEY_SRSUME : constant := 403; KEY_SSAVE : constant := 404; KEY_SSUSPEND : constant := 405; KEY_SUNDO : constant := 406; KEY_SUSPEND : constant := 407; KEY_UNDO : constant := 408; KEY_MOUSE : constant := 409; KEY_RESIZE : constant := 410; -- alternate character codes (ACS) from addch(3NCURSES) ACS_ULCORNER : constant := 108; ACS_LLCORNER : constant := 109; ACS_URCORNER : constant := 107; ACS_LRCORNER : constant := 106; ACS_LTEE : constant := 116; ACS_RTEE : constant := 117; ACS_BTEE : constant := 118; ACS_TTEE : constant := 119; ACS_HLINE : constant := 113; ACS_VLINE : constant := 120; ACS_PLUS : constant := 110; ACS_S1 : constant := 111; ACS_S9 : constant := 115; ACS_DIAMOND : constant := 96; ACS_CKBOARD : constant := 97; ACS_DEGREE : constant := 102; ACS_PLMINUS : constant := 103; ACS_BULLET : constant := 126; ACS_LARROW : constant := 44; ACS_RARROW : constant := 43; ACS_DARROW : constant := 46; ACS_UARROW : constant := 45; ACS_BOARD : constant := 104; ACS_LANTERN : constant := 105; ACS_BLOCK : constant := 48; ACS_S3 : constant := 112; ACS_S7 : constant := 114; ACS_LEQUAL : constant := 121; ACS_GEQUAL : constant := 122; ACS_PI : constant := 123; ACS_NEQUAL : constant := 124; ACS_STERLING : constant := 125; -- Menu_Options from opts(3MENU) O_ONEVALUE_First : constant := 0; O_ONEVALUE_Last : constant := 0; O_SHOWDESC_First : constant := 1; O_SHOWDESC_Last : constant := 1; O_ROWMAJOR_First : constant := 2; O_ROWMAJOR_Last : constant := 2; O_IGNORECASE_First : constant := 3; O_IGNORECASE_Last : constant := 3; O_SHOWMATCH_First : constant := 4; O_SHOWMATCH_Last : constant := 4; O_NONCYCLIC_First : constant := 5; O_NONCYCLIC_Last : constant := 5; Menu_Options_Size : constant := 32; -- Item_Options from menu_opts(3MENU) O_SELECTABLE_First : constant := 0; O_SELECTABLE_Last : constant := 0; Item_Options_Size : constant := 32; -- Field_Options from field_opts(3FORM) O_VISIBLE_First : constant := 0; O_VISIBLE_Last : constant := 0; O_ACTIVE_First : constant := 1; O_ACTIVE_Last : constant := 1; O_PUBLIC_First : constant := 2; O_PUBLIC_Last : constant := 2; O_EDIT_First : constant := 3; O_EDIT_Last : constant := 3; O_WRAP_First : constant := 4; O_WRAP_Last : constant := 4; O_BLANK_First : constant := 5; O_BLANK_Last : constant := 5; O_AUTOSKIP_First : constant := 6; O_AUTOSKIP_Last : constant := 6; O_NULLOK_First : constant := 7; O_NULLOK_Last : constant := 7; O_PASSOK_First : constant := 8; O_PASSOK_Last : constant := 8; O_STATIC_First : constant := 9; O_STATIC_Last : constant := 9; Field_Options_Size : constant := 32; -- Field_Options from opts(3FORM) O_NL_OVERLOAD_First : constant := 0; O_NL_OVERLOAD_Last : constant := 0; O_BS_OVERLOAD_First : constant := 1; O_BS_OVERLOAD_Last : constant := 1; -- MEVENT structure from mouse(3NCURSES) MEVENT_id_First : constant := 0; MEVENT_id_Last : constant := 15; MEVENT_x_First : constant := 32; MEVENT_x_Last : constant := 63; MEVENT_y_First : constant := 64; MEVENT_y_Last : constant := 95; MEVENT_z_First : constant := 96; MEVENT_z_Last : constant := 127; MEVENT_bstate_First : constant := 128; MEVENT_bstate_Last : constant := 159; MEVENT_Size : constant := 160; -- mouse events from mouse(3NCURSES) BUTTON1_RELEASED : constant := 1; BUTTON1_PRESSED : constant := 2; BUTTON1_CLICKED : constant := 4; BUTTON1_DOUBLE_CLICKED : constant := 8; BUTTON1_TRIPLE_CLICKED : constant := 16; all_events_button_1 : constant := 31; BUTTON2_RELEASED : constant := 32; BUTTON2_PRESSED : constant := 64; BUTTON2_CLICKED : constant := 128; BUTTON2_DOUBLE_CLICKED : constant := 256; BUTTON2_TRIPLE_CLICKED : constant := 512; all_events_button_2 : constant := 992; BUTTON3_RELEASED : constant := 1024; BUTTON3_PRESSED : constant := 2048; BUTTON3_CLICKED : constant := 4096; BUTTON3_DOUBLE_CLICKED : constant := 8192; BUTTON3_TRIPLE_CLICKED : constant := 16384; all_events_button_3 : constant := 31744; BUTTON4_RELEASED : constant := 32768; BUTTON4_PRESSED : constant := 65536; BUTTON4_CLICKED : constant := 131072; BUTTON4_DOUBLE_CLICKED : constant := 262144; BUTTON4_TRIPLE_CLICKED : constant := 524288; all_events_button_4 : constant := 1015808; BUTTON_CTRL : constant := 33554432; BUTTON_SHIFT : constant := 67108864; BUTTON_ALT : constant := 134217728; REPORT_MOUSE_POSITION : constant := 268435456; ALL_MOUSE_EVENTS : constant := 268435455; -- trace selection from trace(3NCURSES) TRACE_TIMES_First : constant := 0; TRACE_TIMES_Last : constant := 0; TRACE_TPUTS_First : constant := 1; TRACE_TPUTS_Last : constant := 1; TRACE_UPDATE_First : constant := 2; TRACE_UPDATE_Last : constant := 2; TRACE_MOVE_First : constant := 3; TRACE_MOVE_Last : constant := 3; TRACE_CHARPUT_First : constant := 4; TRACE_CHARPUT_Last : constant := 4; TRACE_CALLS_First : constant := 5; TRACE_CALLS_Last : constant := 5; TRACE_VIRTPUT_First : constant := 6; TRACE_VIRTPUT_Last : constant := 6; TRACE_IEVENT_First : constant := 7; TRACE_IEVENT_Last : constant := 7; TRACE_BITS_First : constant := 8; TRACE_BITS_Last : constant := 8; TRACE_ICALLS_First : constant := 9; TRACE_ICALLS_Last : constant := 9; TRACE_CCALLS_First : constant := 10; TRACE_CCALLS_Last : constant := 10; TRACE_DATABASE_First : constant := 11; TRACE_DATABASE_Last : constant := 11; TRACE_ATTRS_First : constant := 12; TRACE_ATTRS_Last : constant := 12; Trace_Size : constant := 32; end Terminal_Interface.Curses_Constants;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-complex_io__adb.htm 0000644 0001751 0000144 00000025101 13615673306 026261 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Complex_IO -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.12 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Text_IO.Float_IO; package body Terminal_Interface.Curses.Text_IO.Complex_IO is package FIO is new Terminal_Interface.Curses.Text_IO.Float_IO (Complex_Types.Real'Base); procedure Put (Win : Window; Item : Complex; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is begin Put (Win, '('); FIO.Put (Win, Item.Re, Fore, Aft, Exp); Put (Win, ','); FIO.Put (Win, Item.Im, Fore, Aft, Exp); Put (Win, ')'); end Put; procedure Put (Item : Complex; Fore : Field := Default_Fore; Aft : Field := Default_Aft; Exp : Field := Default_Exp) is begin Put (Get_Window, Item, Fore, Aft, Exp); end Put; end Terminal_Interface.Curses.Text_IO.Complex_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-terminfo__adb.htm 0000644 0001751 0000144 00000047377 13615673306 024320 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Terminfo -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 2000-2006,2009 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.7 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; with Interfaces.C; use Interfaces.C; with Interfaces.C.Strings; use Interfaces.C.Strings; with Ada.Unchecked_Conversion; package body Terminal_Interface.Curses.Terminfo is function Is_MinusOne_Pointer (P : chars_ptr) return Boolean; function Is_MinusOne_Pointer (P : chars_ptr) return Boolean is type Weird_Address is new System.Storage_Elements.Integer_Address; Invalid_Pointer : constant Weird_Address := -1; function To_Weird is new Ada.Unchecked_Conversion (Source => chars_ptr, Target => Weird_Address); begin if To_Weird (P) = Invalid_Pointer then return True; else return False; end if; end Is_MinusOne_Pointer; pragma Inline (Is_MinusOne_Pointer); ------------------------------------------------------------------------------ function Get_Flag (Name : String) return Boolean is function tigetflag (id : char_array) return Curses_Bool; pragma Import (C, tigetflag); Txt : char_array (0 .. Name'Length); Length : size_t; begin To_C (Name, Txt, Length); if tigetflag (Txt) = Curses_Bool (Curses_True) then return True; else return False; end if; end Get_Flag; ------------------------------------------------------------------------------ procedure Get_String (Name : String; Value : out Terminfo_String; Result : out Boolean) is function tigetstr (id : char_array) return chars_ptr; pragma Import (C, tigetstr, "tigetstr"); Txt : char_array (0 .. Name'Length); Length : size_t; Txt2 : chars_ptr; begin To_C (Name, Txt, Length); Txt2 := tigetstr (Txt); if Txt2 = Null_Ptr then Result := False; elsif Is_MinusOne_Pointer (Txt2) then raise Curses_Exception; else Value := Terminfo_String (Fill_String (Txt2)); Result := True; end if; end Get_String; ------------------------------------------------------------------------------ function Has_String (Name : String) return Boolean is function tigetstr (id : char_array) return chars_ptr; pragma Import (C, tigetstr, "tigetstr"); Txt : char_array (0 .. Name'Length); Length : size_t; Txt2 : chars_ptr; begin To_C (Name, Txt, Length); Txt2 := tigetstr (Txt); if Txt2 = Null_Ptr then return False; elsif Is_MinusOne_Pointer (Txt2) then raise Curses_Exception; else return True; end if; end Has_String; ------------------------------------------------------------------------------ function Get_Number (Name : String) return Integer is function tigetstr (s : char_array) return C_Int; pragma Import (C, tigetstr); Txt : char_array (0 .. Name'Length); Length : size_t; begin To_C (Name, Txt, Length); return Integer (tigetstr (Txt)); end Get_Number; ------------------------------------------------------------------------------ procedure Put_String (Str : Terminfo_String; affcnt : Natural := 1; putc : putctype := null) is function tputs (str : char_array; affcnt : C_Int; putc : putctype) return C_Int; function putp (str : char_array) return C_Int; pragma Import (C, tputs); pragma Import (C, putp); Txt : char_array (0 .. Str'Length); Length : size_t; Err : C_Int; begin To_C (String (Str), Txt, Length); if putc = null then Err := putp (Txt); else Err := tputs (Txt, C_Int (affcnt), putc); end if; if Err = Curses_Err then raise Curses_Exception; end if; end Put_String; end Terminal_Interface.Curses.Terminfo;AdaCurses-20211021/doc/ada/terminal_interface-curses-text_io-integer_io__ads.htm 0000644 0001751 0000144 00000020521 13615673306 026271 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Text_IO.Integer_IO -- -- -- -- S P E C -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-2003,2009 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.13 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ generic type Num is range <>; package Terminal_Interface.Curses.Text_IO.Integer_IO is Default_Width : Field := Num'Width; Default_Base : Number_Base := 10; procedure Put (Win : Window; Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base); procedure Put (Item : Num; Width : Field := Default_Width; Base : Number_Base := Default_Base); private pragma Inline (Put); end Terminal_Interface.Curses.Text_IO.Integer_IO;AdaCurses-20211021/doc/ada/terminal_interface-curses-forms-field_types-user__adb.htm 0000644 0001751 0000144 00000044677 13615673306 027104 0 ustar tom users
------------------------------------------------------------------------------ -- -- -- GNAT ncurses Binding -- -- -- -- Terminal_Interface.Curses.Forms.Field_Types.User -- -- -- -- B O D Y -- -- -- ------------------------------------------------------------------------------ -- Copyright 2020 Thomas E. Dickey -- -- Copyright 1999-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.24 @ -- @Date: 2020/02/02 23:34:34 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System.Address_To_Access_Conversions; with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux; package body Terminal_Interface.Curses.Forms.Field_Types.User is procedure Set_Field_Type (Fld : Field; Typ : User_Defined_Field_Type) is function Allocate_Arg (T : User_Defined_Field_Type'Class) return Argument_Access; function Set_Fld_Type (F : Field := Fld; Cft : C_Field_Type := C_Generic_Type; Arg1 : Argument_Access) return Eti_Error; pragma Import (C, Set_Fld_Type, "set_field_type_user"); function Allocate_Arg (T : User_Defined_Field_Type'Class) return Argument_Access is Ptr : constant Field_Type_Access := new User_Defined_Field_Type'Class'(T); begin return new Argument'(Usr => System.Null_Address, Typ => Ptr, Cft => Null_Field_Type); end Allocate_Arg; begin Eti_Exception (Set_Fld_Type (Arg1 => Allocate_Arg (Typ))); end Set_Field_Type; package Argument_Conversions is new System.Address_To_Access_Conversions (Argument); function Generic_Field_Check (Fld : Field; Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_Access := User_Defined_Field_Type_Access (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Field_Check (Fld, Udf.all); return Curses_Bool (Boolean'Pos (Result)); end Generic_Field_Check; function Generic_Char_Check (Ch : C_Int; Usr : System.Address) return Curses_Bool is Result : Boolean; Udf : constant User_Defined_Field_Type_Access := User_Defined_Field_Type_Access (Argument_Access (Argument_Conversions.To_Pointer (Usr)).all.Typ); begin Result := Character_Check (Character'Val (Ch), Udf.all); return Curses_Bool (Boolean'Pos (Result)); end Generic_Char_Check; -- ----------------------------------------------------------------------- -- function C_Generic_Type return C_Field_Type is Res : Eti_Error; T : C_Field_Type; begin if M_Generic_Type = Null_Field_Type then T := New_Fieldtype (Generic_Field_Check'Access, Generic_Char_Check'Access); if T = Null_Field_Type then raise Form_Exception; else Res := Set_Fieldtype_Arg (T, Make_Arg'Access, Copy_Arg'Access, Free_Arg'Access); Eti_Exception (Res); end if; M_Generic_Type := T; end if; pragma Assert (M_Generic_Type /= Null_Field_Type); return M_Generic_Type; end C_Generic_Type; end Terminal_Interface.Curses.Forms.Field_Types.User;AdaCurses-20211021/doc/Makefile.in 0000644 0001751 0000144 00000007404 14070103035 015145 0 ustar tom users # $Id: Makefile.in,v 1.9 2021/07/03 15:45:33 tom Exp $ ############################################################################## # Copyright 2019-2020,2021 Thomas E. Dickey # # Copyright 2011-2015,2018 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: Thomas E. Dickey # # Makefile for AdaCurses manual pages. SHELL = @SHELL@ VPATH = @srcdir@ DESTDIR = @DESTDIR@ srcdir = @srcdir@ prefix = @prefix@ exec_prefix = @exec_prefix@ datarootdir = @datarootdir@ datadir = @datadir@ mandir = @mandir@ INSTALL = @INSTALL@ @INSTALL_OPT_O@ INSTALL_DATA = @INSTALL_DATA@ DFT_ARG_SUFFIX = @DFT_ARG_SUFFIX@ THIS = @ADA_LIBNAME@ DOCDIR = $(DESTDIR)$(datadir)/doc/$(THIS) MANDIR = $(DESTDIR)$(mandir)/man1 ################################################################################ @MAKE_PHONY@.PHONY : all @MAKE_PHONY@.PHONY : check @MAKE_PHONY@.PHONY : clean @MAKE_PHONY@.PHONY : distclean @MAKE_PHONY@.PHONY : install @MAKE_PHONY@.PHONY : install.html @MAKE_PHONY@.PHONY : install.man @MAKE_PHONY@.PHONY : libs @MAKE_PHONY@.PHONY : lint @MAKE_PHONY@.PHONY : mostlyclean @MAKE_PHONY@.PHONY : realclean @MAKE_PHONY@.PHONY : sources @MAKE_PHONY@.PHONY : uninstall @MAKE_PHONY@.PHONY : uninstall.html @MAKE_PHONY@.PHONY : uninstall.man all \ sources \ tags : $(DOCDIR) \ $(MANDIR) : mkdir -p $@ install install.man : $(MANDIR) $(INSTALL_DATA) adacurses${DFT_ARG_SUFFIX}-config.1 $(MANDIR) uninstall uninstall.man : -rm -f $(MANDIR)/adacurses${DFT_ARG_SUFFIX}-config.1 # HTML documentation is optional, usually in a separate package. install.html : $(DOCDIR) ( cd $(srcdir) && tar -cf - *.htm* ada | tar -C $(DOCDIR) -xf - ) uninstall.html : -rm -rf $(DOCDIR) mostlyclean : -rm -f core tags TAGS *~ *.bak *.ln *.atac trace clean: mostlyclean distclean realclean: clean -rm -f Makefile *-config.1 AdaCurses-20211021/TODO 0000644 0001751 0000144 00000006123 14114005471 013024 0 ustar tom users ------------------------------------------------------------------------------- -- Copyright 2020,2021 Thomas E. Dickey -- -- Copyright 1998-1999,2006 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. -- ------------------------------------------------------------------------------- -- $Id: TODO,v 1.8 2021/09/01 23:22:33 tom Exp $ ------------------------------------------------------------------------------- -- Intensive testing Perhaps the delivery of the Beta will help a bit. -- Documentation Like most WEB pages: under continuous construction -- Style cleanup -- Alternate functions for procedures with out params Comfort purpose -- Sample program Under continuous construction (and it is not a WEB page!!!) -- Make the binding objects a shared library They are rather large, so it would make sense, otherwise Ada95 would look too large, although the generated code is as compact as C or C++. I'll wait a bit until the GNAT people provide some better support to construct shared libraries. -- Think about more inlining -- Check for memory leaks. Oh I would like it so much if the GNAT guys would put an optional GC into their system. AdaCurses-20211021/package/ 0000755 0001751 0000144 00000000000 14134402303 013722 5 ustar tom users AdaCurses-20211021/package/debian/ 0000755 0001751 0000144 00000000000 14134402303 015144 5 ustar tom users AdaCurses-20211021/package/debian/copyright 0000644 0001751 0000144 00000007366 13773570526 017140 0 ustar tom users Upstream source https://invisible-island.net/ncurses/Ada95.html Current ncurses maintainer: Thomas Dickey