1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding --
5 -- Terminal_Interface.Curses.Termcap --
9 ------------------------------------------------------------------------------
10 -- Copyright 2020 Thomas E. Dickey --
11 -- Copyright 2000-2006,2009 Free Software Foundation, Inc. --
13 -- Permission is hereby granted, free of charge, to any person obtaining a --
14 -- copy of this software and associated documentation files (the --
15 -- "Software"), to deal in the Software without restriction, including --
16 -- without limitation the rights to use, copy, modify, merge, publish, --
17 -- distribute, distribute with modifications, sublicense, and/or sell --
18 -- copies of the Software, and to permit persons to whom the Software is --
19 -- furnished to do so, subject to the following conditions: --
21 -- The above copyright notice and this permission notice shall be included --
22 -- in all copies or substantial portions of the Software. --
24 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
25 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
26 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
27 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
28 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
29 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
30 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
32 -- Except as contained in this notice, the name(s) of the above copyright --
33 -- holders shall not be used in advertising or otherwise to promote the --
34 -- sale, use or other dealings in this Software without prior written --
36 ------------------------------------------------------------------------------
37 -- Author: Juergen Pfeifer, 1996
40 -- $Date: 2020/02/02 23:34:34 $
41 -- Binding Version 01.00
42 ------------------------------------------------------------------------------
44 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
45 with Interfaces.C; use Interfaces.C;
46 with Interfaces.C.Strings; use Interfaces.C.Strings;
48 package body Terminal_Interface.Curses.Termcap is
50 function Get_Entry (Name : String) return Boolean
52 function tgetent (name : char_array; val : char_array)
54 pragma Import (C, tgetent, "tgetent");
55 NameTxt : char_array (0 .. Name'Length);
57 ignored : constant char_array (0 .. 0) := (0 => nul);
60 To_C (Name, NameTxt, Length);
61 result := tgetent (char_array (ignored), NameTxt);
63 raise Curses_Exception;
65 return Boolean'Val (result);
69 ------------------------------------------------------------------------------
70 function Get_Flag (Name : String) return Boolean
72 function tgetflag (id : char_array) return C_Int;
73 pragma Import (C, tgetflag, "tgetflag");
74 Txt : char_array (0 .. Name'Length);
77 To_C (Name, Txt, Length);
78 if tgetflag (Txt) = 0 then
85 ------------------------------------------------------------------------------
86 procedure Get_Number (Name : String;
90 function tgetnum (id : char_array) return C_Int;
91 pragma Import (C, tgetnum, "tgetnum");
92 Txt : char_array (0 .. Name'Length);
95 To_C (Name, Txt, Length);
96 Value := Integer (tgetnum (Txt));
104 ------------------------------------------------------------------------------
105 procedure Get_String (Name : String;
107 Result : out Boolean)
109 function tgetstr (id : char_array;
110 buf : char_array) return chars_ptr;
111 pragma Import (C, tgetstr, "tgetstr");
112 Txt : char_array (0 .. Name'Length);
115 type t is new char_array (0 .. 1024); -- does it need to be 1024?
116 Return_Buffer : constant t := (others => nul);
118 To_C (Name, Txt, Length);
119 Txt2 := tgetstr (Txt, char_array (Return_Buffer));
120 if Txt2 = Null_Ptr then
123 Value := Fill_String (Txt2);
128 function Get_String (Name : String) return Boolean
130 function tgetstr (Id : char_array;
131 buf : char_array) return chars_ptr;
132 pragma Import (C, tgetstr, "tgetstr");
133 Txt : char_array (0 .. Name'Length);
136 type t is new char_array (0 .. 1024); -- does it need to be 1024?
137 Phony_Txt : constant t := (others => nul);
139 To_C (Name, Txt, Length);
140 Txt2 := tgetstr (Txt, char_array (Phony_Txt));
141 if Txt2 = Null_Ptr then
148 ------------------------------------------------------------------------------
149 function TGoto (Cap : String;
150 Col : Column_Position;
151 Row : Line_Position) return Termcap_String is
152 function tgoto (cap : char_array;
154 row : C_Int) return chars_ptr;
155 pragma Import (C, tgoto);
156 Txt : char_array (0 .. Cap'Length);
159 To_C (Cap, Txt, Length);
160 return Termcap_String (Fill_String
161 (tgoto (Txt, C_Int (Col), C_Int (Row))));
164 end Terminal_Interface.Curses.Termcap;