ncurses 4.2
[ncurses.git] / Ada95 / ada_include / terminal_interface-curses.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                           GNAT ncurses Binding                           --
4 --                                                                          --
5 --                        Terminal_Interface.Curses                         --
6 --                                                                          --
7 --                                 B O D Y                                  --
8 --                                                                          --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 1998 Free Software Foundation, Inc.                        --
11 --                                                                          --
12 -- Permission is hereby granted, free of charge, to any person obtaining a  --
13 -- copy of this software and associated documentation files (the            --
14 -- "Software"), to deal in the Software without restriction, including      --
15 -- without limitation the rights to use, copy, modify, merge, publish,      --
16 -- distribute, distribute with modifications, sublicense, and/or sell       --
17 -- copies of the Software, and to permit persons to whom the Software is    --
18 -- furnished to do so, subject to the following conditions:                 --
19 --                                                                          --
20 -- The above copyright notice and this permission notice shall be included  --
21 -- in all copies or substantial portions of the Software.                   --
22 --                                                                          --
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS  --
24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF               --
25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.   --
26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM,   --
27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR    --
28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR    --
29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE.                               --
30 --                                                                          --
31 -- Except as contained in this notice, the name(s) of the above copyright   --
32 -- holders shall not be used in advertising or otherwise to promote the     --
33 -- sale, use or other dealings in this Software without prior written       --
34 -- authorization.                                                           --
35 ------------------------------------------------------------------------------
36 --  Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1996
37 --  Version Control:
38 --  $Revision: 1.15 $
39 --  Binding Version 00.93
40 ------------------------------------------------------------------------------
41 with System;
42
43 with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
44 with Interfaces.C;                  use Interfaces.C;
45 with Interfaces.C.Strings;          use Interfaces.C.Strings;
46 with Ada.Characters.Handling;       use Ada.Characters.Handling;
47 with Ada.Strings.Fixed;
48 with Unchecked_Conversion;
49
50 package body Terminal_Interface.Curses is
51
52    use type System.Bit_Order;
53
54    package ASF renames Ada.Strings.Fixed;
55
56    type chtype_array is array (size_t range <>)
57       of aliased Attributed_Character;
58    pragma Convention (C, chtype_array);
59
60 ------------------------------------------------------------------------------
61    function Key_Name (Key : in Real_Key_Code) return String
62    is
63       function Keyname (K : C_Int) return chars_ptr;
64       pragma Import (C, Keyname, "keyname");
65
66       Ch : Character;
67    begin
68       if Key <= Character'Pos (Character'Last) then
69          Ch := Character'Val (Key);
70          if Is_Control (Ch) then
71             return Un_Control (Attributed_Character'(Ch    => Ch,
72                                                      Color => Color_Pair'First,
73                                                      Attr  => Normal_Video));
74          elsif Is_Graphic (Ch) then
75             declare
76                S : String (1 .. 1);
77             begin
78                S (1) := Ch;
79                return S;
80             end;
81          else
82             return "";
83          end if;
84       else
85          return Fill_String (Keyname (C_Int (Key)));
86       end if;
87    end Key_Name;
88
89    procedure Key_Name (Key  : in  Real_Key_Code;
90                        Name : out String)
91    is
92    begin
93       ASF.Move (Key_Name (Key), Name);
94    end Key_Name;
95
96 ------------------------------------------------------------------------------
97    procedure Init_Screen
98    is
99       function Initscr return Window;
100       pragma Import (C, Initscr, "initscr");
101
102       function Check_Version (Major, Minor : C_Int) return C_Int;
103       pragma Import (C, Check_Version, "_nc_ada_vcheck");
104
105       W : Window;
106    begin
107       if (Check_Version (NC_Major_Version, NC_Minor_Version) = 0) then
108          raise Wrong_Curses_Version;
109       else
110          W := Initscr;
111          if W = Null_Window then
112             raise Curses_Exception;
113          end if;
114       end if;
115    end Init_Screen;
116
117    procedure End_Windows
118    is
119       function Endwin return C_Int;
120       pragma Import (C, Endwin, "endwin");
121    begin
122       if Endwin = Curses_Err then
123          raise Curses_Exception;
124       end if;
125    end End_Windows;
126
127    function Is_End_Window return Boolean
128    is
129       function Isendwin return C_Int;
130       pragma Import (C, Isendwin, "isendwin");
131    begin
132       if Isendwin = Curses_False then
133          return False;
134       else
135          return True;
136       end if;
137    end Is_End_Window;
138 ------------------------------------------------------------------------------
139    procedure Move_Cursor (Win    : in Window := Standard_Window;
140                           Line   : in Line_Position;
141                           Column : in Column_Position)
142    is
143       function Wmove (Win    : Window;
144                       Line   : C_Int;
145                       Column : C_Int
146                      ) return C_Int;
147       pragma Import (C, Wmove, "wmove");
148    begin
149       if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
150          raise Curses_Exception;
151       end if;
152    end Move_Cursor;
153 ------------------------------------------------------------------------------
154    procedure Add (Win : in Window := Standard_Window;
155                   Ch  : in Attributed_Character)
156    is
157       function Waddch (W  : Window;
158                        Ch : C_Int) return C_Int;
159       pragma Import (C, Waddch, "waddch");
160    begin
161       if Waddch (Win, Chtype_To_Cint (Ch)) = Curses_Err then
162          raise Curses_Exception;
163       end if;
164    end Add;
165
166    procedure Add (Win : in Window := Standard_Window;
167                   Ch  : in Character)
168    is
169    begin
170       Add (Win,
171            Attributed_Character'(Ch    => Ch,
172                                  Color => Color_Pair'First,
173                                  Attr  => Normal_Video));
174    end Add;
175
176    procedure Add
177      (Win    : in Window := Standard_Window;
178       Line   : in Line_Position;
179       Column : in Column_Position;
180       Ch     : in Attributed_Character)
181    is
182       function mvwaddch (W  : Window;
183                          Y  : C_Int;
184                          X  : C_Int;
185                          Ch : C_Int) return C_Int;
186       pragma Import (C, mvwaddch, "mvwaddch");
187    begin
188       if mvwaddch (Win, C_Int (Line),
189                    C_Int (Column),
190                    Chtype_To_CInt (Ch)) = Curses_Err then
191          raise Curses_Exception;
192       end if;
193    end Add;
194
195    procedure Add
196      (Win    : in Window := Standard_Window;
197       Line   : in Line_Position;
198       Column : in Column_Position;
199       Ch     : in Character)
200    is
201    begin
202       Add (Win,
203            Line,
204            Column,
205            Attributed_Character'(Ch    => Ch,
206                                  Color => Color_Pair'First,
207                                  Attr  => Normal_Video));
208    end Add;
209
210    procedure Add_With_Immediate_Echo
211      (Win : in Window := Standard_Window;
212       Ch  : in Attributed_Character)
213    is
214       function Wechochar (W  : Window;
215                           Ch : C_Int) return C_Int;
216       pragma Import (C, Wechochar, "wechochar");
217    begin
218       if Wechochar (Win, Chtype_To_CInt (Ch)) = Curses_Err then
219          raise Curses_Exception;
220       end if;
221    end Add_With_Immediate_Echo;
222
223    procedure Add_With_Immediate_Echo
224      (Win : in Window := Standard_Window;
225       Ch  : in Character)
226    is
227    begin
228       Add_With_Immediate_Echo
229         (Win,
230          Attributed_Character'(Ch    => Ch,
231                                Color => Color_Pair'First,
232                                Attr  => Normal_Video));
233    end Add_With_Immediate_Echo;
234 ------------------------------------------------------------------------------
235    function Create (Number_Of_Lines       : Line_Count;
236                     Number_Of_Columns     : Column_Count;
237                     First_Line_Position   : Line_Position;
238                     First_Column_Position : Column_Position) return Window
239    is
240       function Newwin (Number_Of_Lines       : C_Int;
241                        Number_Of_Columns     : C_Int;
242                        First_Line_Position   : C_Int;
243                        First_Column_Position : C_Int) return Window;
244       pragma Import (C, Newwin, "newwin");
245
246       W : Window;
247    begin
248       W := Newwin (C_Int (Number_Of_Lines),
249                    C_Int (Number_Of_Columns),
250                    C_Int (First_Line_Position),
251                    C_Int (First_Column_Position));
252       if W = Null_Window then
253          raise Curses_Exception;
254       end if;
255       return W;
256    end Create;
257
258    procedure Delete (Win : in out Window)
259    is
260       function Wdelwin (W : Window) return C_Int;
261       pragma Import (C, Wdelwin, "delwin");
262    begin
263       if Wdelwin (Win) = Curses_Err then
264          raise Curses_Exception;
265       end if;
266       Win := Null_Window;
267    end Delete;
268
269    function Sub_Window
270      (Win                   : Window := Standard_Window;
271       Number_Of_Lines       : Line_Count;
272       Number_Of_Columns     : Column_Count;
273       First_Line_Position   : Line_Position;
274       First_Column_Position : Column_Position) return Window
275    is
276       function Subwin
277         (Win                   : Window;
278          Number_Of_Lines       : C_Int;
279          Number_Of_Columns     : C_Int;
280          First_Line_Position   : C_Int;
281          First_Column_Position : C_Int) return Window;
282       pragma Import (C, Subwin, "subwin");
283
284       W : Window;
285    begin
286       W := Subwin (Win,
287                    C_Int (Number_Of_Lines),
288                    C_Int (Number_Of_Columns),
289                    C_Int (First_Line_Position),
290                    C_Int (First_Column_Position));
291       if W = Null_Window then
292          raise Curses_Exception;
293       end if;
294       return W;
295    end Sub_Window;
296
297    function Derived_Window
298      (Win                   : Window := Standard_Window;
299       Number_Of_Lines       : Line_Count;
300       Number_Of_Columns     : Column_Count;
301       First_Line_Position   : Line_Position;
302       First_Column_Position : Column_Position) return Window
303    is
304       function Derwin
305         (Win                   : Window;
306          Number_Of_Lines       : C_Int;
307          Number_Of_Columns     : C_Int;
308          First_Line_Position   : C_Int;
309          First_Column_Position : C_Int) return Window;
310       pragma Import (C, Derwin, "derwin");
311
312       W : Window;
313    begin
314       W := Derwin (Win,
315                    C_Int (Number_Of_Lines),
316                    C_Int (Number_Of_Columns),
317                    C_Int (First_Line_Position),
318                    C_Int (First_Column_Position));
319       if W = Null_Window then
320          raise Curses_Exception;
321       end if;
322       return W;
323    end Derived_Window;
324
325    function Duplicate (Win : Window) return Window
326    is
327       function Dupwin (Win : Window) return Window;
328       pragma Import (C, Dupwin, "dupwin");
329
330       W : Window := Dupwin (Win);
331    begin
332       if W = Null_Window then
333          raise Curses_Exception;
334       end if;
335       return W;
336    end Duplicate;
337
338    procedure Move_Window (Win    : in Window;
339                           Line   : in Line_Position;
340                           Column : in Column_Position)
341    is
342       function Mvwin (Win    : Window;
343                       Line   : C_Int;
344                       Column : C_Int) return C_Int;
345       pragma Import (C, Mvwin, "mvwin");
346    begin
347       if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
348          raise Curses_Exception;
349       end if;
350    end Move_Window;
351
352    procedure Move_Derived_Window (Win    : in Window;
353                                   Line   : in Line_Position;
354                                   Column : in Column_Position)
355    is
356       function Mvderwin (Win    : Window;
357                          Line   : C_Int;
358                          Column : C_Int) return C_Int;
359       pragma Import (C, Mvderwin, "mvderwin");
360    begin
361       if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
362          raise Curses_Exception;
363       end if;
364    end Move_Derived_Window;
365
366    procedure Set_Synch_Mode (Win  : in Window  := Standard_Window;
367                              Mode : in Boolean := False)
368    is
369       function Syncok (Win  : Window;
370                        Mode : C_Int) return C_Int;
371       pragma Import (C, Syncok, "syncok");
372    begin
373       if Syncok (Win, Boolean'Pos (Mode)) = Curses_Err then
374          raise Curses_Exception;
375       end if;
376    end Set_Synch_Mode;
377 ------------------------------------------------------------------------------
378    procedure Add (Win : in Window := Standard_Window;
379                   Str : in String;
380                   Len : in Integer := -1)
381    is
382       type Char_Ptr is access all Interfaces.C.Char;
383       function Waddnstr (Win : Window;
384                          Str : Char_Ptr;
385                          Len : C_Int := -1) return C_Int;
386       pragma Import (C, Waddnstr, "waddnstr");
387
388       Txt    : char_array (0 .. Str'Length);
389       Length : size_t;
390    begin
391       To_C (Str, Txt, Length);
392       if Waddnstr (Win, Txt (Txt'First)'Access, C_Int (Len)) = Curses_Err then
393          raise Curses_Exception;
394       end if;
395    end Add;
396
397    procedure Add
398      (Win    : in Window := Standard_Window;
399       Line   : in Line_Position;
400       Column : in Column_Position;
401       Str    : in String;
402       Len    : in Integer := -1)
403    is
404    begin
405       Move_Cursor (Win, Line, Column);
406       Add (Win, Str, Len);
407    end Add;
408 ------------------------------------------------------------------------------
409    procedure Add
410      (Win : in Window := Standard_Window;
411       Str : in Attributed_String;
412       Len : in Integer := -1)
413    is
414       type Chtype_Ptr is access all Attributed_Character;
415       function Waddchnstr (Win : Window;
416                            Str : Chtype_Ptr;
417                            Len : C_Int := -1) return C_Int;
418       pragma Import (C, Waddchnstr, "waddchnstr");
419
420       Txt : chtype_array (0 .. Str'Length);
421    begin
422       for Length in 1 .. size_t (Str'Length) loop
423          Txt (Length - 1) := Str (Natural (Length));
424       end loop;
425       Txt (Str'Length) := Default_Character;
426       if Waddchnstr (Win,
427                      Txt (Txt'First)'Access,
428                      C_Int (Len)) = Curses_Err then
429          raise Curses_Exception;
430       end if;
431    end Add;
432
433    procedure Add
434      (Win    : in Window := Standard_Window;
435       Line   : in Line_Position;
436       Column : in Column_Position;
437       Str    : in Attributed_String;
438       Len    : in Integer := -1)
439    is
440    begin
441       Move_Cursor (Win, Line, Column);
442       Add (Win, Str, Len);
443    end Add;
444 ------------------------------------------------------------------------------
445    procedure Border
446      (Win                       : in Window := Standard_Window;
447       Left_Side_Symbol          : in Attributed_Character := Default_Character;
448       Right_Side_Symbol         : in Attributed_Character := Default_Character;
449       Top_Side_Symbol           : in Attributed_Character := Default_Character;
450       Bottom_Side_Symbol        : in Attributed_Character := Default_Character;
451       Upper_Left_Corner_Symbol  : in Attributed_Character := Default_Character;
452       Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
453       Lower_Left_Corner_Symbol  : in Attributed_Character := Default_Character;
454       Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
455    is
456       function Wborder (W   : Window;
457                         LS  : C_Int;
458                         RS  : C_Int;
459                         TS  : C_Int;
460                         BS  : C_Int;
461                         ULC : C_Int;
462                         URC : C_Int;
463                         LLC : C_Int;
464                         LRC : C_Int) return C_Int;
465       pragma Import (C, Wborder, "wborder");
466    begin
467       if Wborder (Win,
468                   Chtype_To_CInt (Left_Side_Symbol),
469                   Chtype_To_CInt (Right_Side_Symbol),
470                   Chtype_To_CInt (Top_Side_Symbol),
471                   Chtype_To_CInt (Bottom_Side_Symbol),
472                   Chtype_To_CInt (Upper_Left_Corner_Symbol),
473                   Chtype_To_CInt (Upper_Right_Corner_Symbol),
474                   Chtype_To_CInt (Lower_Left_Corner_Symbol),
475                   Chtype_To_CInt (Lower_Right_Corner_Symbol)
476                   ) = Curses_Err
477       then
478          raise Curses_Exception;
479       end if;
480    end Border;
481
482    procedure Box
483      (Win               : in Window := Standard_Window;
484       Vertical_Symbol   : in Attributed_Character := Default_Character;
485       Horizontal_Symbol : in Attributed_Character := Default_Character)
486    is
487    begin
488       Border (Win,
489               Vertical_Symbol, Vertical_Symbol,
490               Horizontal_Symbol, Horizontal_Symbol);
491    end Box;
492
493    procedure Horizontal_Line
494      (Win         : in Window := Standard_Window;
495       Line_Size   : in Natural;
496       Line_Symbol : in Attributed_Character := Default_Character)
497    is
498       function Whline (W   : Window;
499                        Ch  : C_Int;
500                        Len : C_Int) return C_Int;
501       pragma Import (C, Whline, "whline");
502    begin
503       if Whline (Win,
504                  Chtype_To_CInt (Line_Symbol),
505                  C_Int (Line_Size)) = Curses_Err then
506          raise Curses_Exception;
507       end if;
508    end Horizontal_Line;
509
510    procedure Vertical_Line
511      (Win         : in Window := Standard_Window;
512       Line_Size   : in Natural;
513       Line_Symbol : in Attributed_Character := Default_Character)
514    is
515       function Wvline (W   : Window;
516                        Ch  : C_Int;
517                        Len : C_Int) return C_Int;
518       pragma Import (C, Wvline, "wvline");
519    begin
520       if Wvline (Win,
521                  Chtype_To_CInt (Line_Symbol),
522                  C_Int (Line_Size)) = Curses_Err then
523          raise Curses_Exception;
524       end if;
525    end Vertical_Line;
526
527 ------------------------------------------------------------------------------
528    function Get_Keystroke (Win : Window := Standard_Window)
529      return Real_Key_Code
530    is
531       function Wgetch (W : Window) return C_Int;
532       pragma Import (C, Wgetch, "wgetch");
533
534       C : constant C_Int := Wgetch (Win);
535    begin
536       if C = Curses_Err then
537          return Key_None;
538       else
539          return Real_Key_Code (C);
540       end if;
541    end Get_Keystroke;
542
543    procedure Undo_Keystroke (Key : in Real_Key_Code)
544    is
545       function Ungetch (Ch : C_Int) return C_Int;
546       pragma Import (C, Ungetch, "ungetch");
547    begin
548       if Ungetch (C_Int (Key)) = Curses_Err then
549          raise Curses_Exception;
550       end if;
551    end Undo_Keystroke;
552
553    function Has_Key (Key : Special_Key_Code) return Boolean
554    is
555       function Haskey (Key : C_Int) return C_Int;
556       pragma Import (C, Haskey, "has_key");
557    begin
558       if Haskey (C_Int (Key)) = Curses_False then
559          return False;
560       else
561          return True;
562       end if;
563    end Has_Key;
564
565    function Is_Function_Key (Key : Special_Key_Code) return Boolean
566    is
567       L : constant Special_Key_Code  := Special_Key_Code (Natural (Key_F0) +
568         Natural (Function_Key_Number'Last));
569    begin
570       if (Key >= Key_F0) and then (Key <= L) then
571          return True;
572       else
573          return False;
574       end if;
575    end Is_Function_Key;
576
577    function Function_Key (Key : Real_Key_Code)
578                           return Function_Key_Number
579    is
580    begin
581       if Is_Function_Key (Key) then
582          return Function_Key_Number (Key - Key_F0);
583       else
584          raise Constraint_Error;
585       end if;
586    end Function_Key;
587
588    function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
589    is
590    begin
591       return Real_Key_Code (Natural (Key_F0) + Natural (Key));
592    end Function_Key_Code;
593 ------------------------------------------------------------------------------
594    procedure Switch_Character_Attribute
595      (Win  : in Window := Standard_Window;
596       Attr : in Character_Attribute_Set := Normal_Video;
597       On   : in Boolean := True)
598    is
599       function Wattron (Win    : Window;
600                         C_Attr : C_Int) return C_Int;
601       pragma Import (C, Wattron, "wattr_on");
602       function Wattroff (Win    : Window;
603                          C_Attr : C_Int) return C_Int;
604       pragma Import (C, Wattroff, "wattr_off");
605       --  In Ada we use the On Boolean to control whether or not we want to
606       --  switch on or off the attributes in the set.
607       Err : C_Int;
608       AC  : constant Attributed_Character := (Ch    => Character'First,
609                                               Color => Color_Pair'First,
610                                               Attr  => Attr);
611    begin
612       if On then
613          Err := Wattron (Win, Chtype_To_CInt (AC));
614       else
615          Err := Wattroff (Win, Chtype_To_CInt (AC));
616       end if;
617       if Err = Curses_Err then
618          raise Curses_Exception;
619       end if;
620    end Switch_Character_Attribute;
621
622    procedure Set_Character_Attributes
623      (Win   : in Window := Standard_Window;
624       Attr  : in Character_Attribute_Set := Normal_Video;
625       Color : in Color_Pair := Color_Pair'First)
626    is
627       function Wattrset (Win    : Window;
628                          C_Attr : C_Int) return C_Int;
629       pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
630    begin
631       if Wattrset (Win,
632                    Chtype_To_CInt (Attributed_Character'
633                                    (Ch    => Character'First,
634                                     Color => Color,
635                                     Attr  => Attr))) = Curses_Err then
636          raise Curses_Exception;
637       end if;
638    end Set_Character_Attributes;
639
640    function Get_Character_Attribute (Win : Window := Standard_Window)
641                                      return Character_Attribute_Set
642    is
643       function Wattrget (Win : Window) return C_Int;
644       pragma Import (C, Wattrget, "wattr_get");
645
646       Ch : Attributed_Character := CInt_To_Chtype (Wattrget (Win));
647    begin
648       return Ch.Attr;
649    end Get_Character_Attribute;
650
651    function Get_Character_Attribute (Win : Window := Standard_Window)
652                                      return Color_Pair
653    is
654       function Wattrget (Win : Window) return C_Int;
655       pragma Import (C, Wattrget, "wattr_get");
656
657       Ch : Attributed_Character := CInt_To_Chtype (Wattrget (Win));
658    begin
659       return Ch.Color;
660    end Get_Character_Attribute;
661
662    procedure Change_Attributes
663      (Win   : in Window := Standard_Window;
664       Count : in Integer := -1;
665       Attr  : in Character_Attribute_Set := Normal_Video;
666       Color : in Color_Pair := Color_Pair'First)
667    is
668       function Wchgat (Win   : Window;
669                        Cnt   : C_Int;
670                        Attr  : C_Int;
671                        Color : C_Short;
672                        Opts  : System.Address := System.Null_Address)
673                        return C_Int;
674       pragma Import (C, Wchgat, "wchgat");
675
676       Ch : constant Attributed_Character :=
677         (Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
678    begin
679       if Wchgat (Win, C_Int (Count), Chtype_To_CInt (Ch),
680                  C_Short (Color)) = Curses_Err then
681          raise Curses_Exception;
682       end if;
683    end Change_Attributes;
684
685    procedure Change_Attributes
686      (Win    : in Window := Standard_Window;
687       Line   : in Line_Position := Line_Position'First;
688       Column : in Column_Position := Column_Position'First;
689       Count  : in Integer := -1;
690       Attr   : in Character_Attribute_Set := Normal_Video;
691       Color  : in Color_Pair := Color_Pair'First)
692    is
693    begin
694       Move_Cursor (Win, Line, Column);
695       Change_Attributes (Win, Count, Attr, Color);
696    end Change_Attributes;
697 ------------------------------------------------------------------------------
698    procedure Beep
699    is
700       function Beeper return C_Int;
701       pragma Import (C, Beeper, "beep");
702    begin
703       if Beeper = Curses_Err then
704          raise Curses_Exception;
705       end if;
706    end Beep;
707
708    procedure Flash_Screen
709    is
710       function Flash return C_Int;
711       pragma Import (C, Flash, "flash");
712    begin
713       if Flash = Curses_Err then
714          raise Curses_Exception;
715       end if;
716    end Flash_Screen;
717 ------------------------------------------------------------------------------
718    procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True)
719    is
720       function Cbreak return C_Int;
721       pragma Import (C, Cbreak, "cbreak");
722       function NoCbreak return C_Int;
723       pragma Import (C, NoCbreak, "nocbreak");
724
725       Err : C_Int;
726    begin
727       if SwitchOn then
728          Err := Cbreak;
729       else
730          Err := NoCbreak;
731       end if;
732       if Err = Curses_Err then
733          raise Curses_Exception;
734       end if;
735    end Set_Cbreak_Mode;
736
737    procedure Set_Raw_Mode (SwitchOn : in Boolean := True)
738    is
739       function Raw return C_Int;
740       pragma Import (C, Raw, "raw");
741       function NoRaw return C_Int;
742       pragma Import (C, NoRaw, "noraw");
743
744       Err : C_Int;
745    begin
746       if SwitchOn then
747          Err := Raw;
748       else
749          Err := NoRaw;
750       end if;
751       if Err = Curses_Err then
752          raise Curses_Exception;
753       end if;
754    end Set_Raw_Mode;
755
756    procedure Set_Echo_Mode (SwitchOn : in Boolean := True)
757    is
758       function Echo return C_Int;
759       pragma Import (C, Echo, "echo");
760       function NoEcho return C_Int;
761       pragma Import (C, NoEcho, "noecho");
762
763       Err : C_Int;
764    begin
765       if SwitchOn then
766          Err := Echo;
767       else
768          Err := NoEcho;
769       end if;
770       if Err = Curses_Err then
771          raise Curses_Exception;
772       end if;
773    end Set_Echo_Mode;
774
775    procedure Set_Meta_Mode (Win      : in Window := Standard_Window;
776                             SwitchOn : in Boolean := True)
777    is
778       function Meta (W : Window; Mode : C_Int) return C_Int;
779       pragma Import (C, Meta, "meta");
780    begin
781       if Meta (Win, Boolean'Pos (SwitchOn)) = Curses_Err then
782          raise Curses_Exception;
783       end if;
784    end Set_Meta_Mode;
785
786    procedure Set_KeyPad_Mode (Win      : in Window := Standard_Window;
787                               SwitchOn : in Boolean := True)
788    is
789       function Keypad (W : Window; Mode : C_Int) return C_Int;
790       pragma Import (C, Keypad, "keypad");
791    begin
792       if Keypad (Win, Boolean'Pos (SwitchOn)) = Curses_Err then
793          raise Curses_Exception;
794       end if;
795    end Set_KeyPad_Mode;
796
797    procedure Half_Delay (Amount : in Half_Delay_Amount)
798    is
799       function Halfdelay (Amount : C_Int) return C_Int;
800       pragma Import (C, Halfdelay, "halfdelay");
801    begin
802       if Halfdelay (C_Int (Amount)) = Curses_Err then
803          raise Curses_Exception;
804       end if;
805    end Half_Delay;
806
807    procedure Set_Flush_On_Interrupt_Mode
808      (Win  : in Window := Standard_Window;
809       Mode : in Boolean := True)
810    is
811       function Intrflush (Win : Window; Mode : C_Int) return C_Int;
812       pragma Import (C, Intrflush, "intrflush");
813    begin
814       if Intrflush (Win, Boolean'Pos (Mode)) = Curses_Err then
815          raise Curses_Exception;
816       end if;
817    end Set_Flush_On_Interrupt_Mode;
818
819    procedure Set_Queue_Interrupt_Mode
820      (Win   : in Window := Standard_Window;
821       Flush : in Boolean := True)
822    is
823       procedure Qiflush;
824       pragma Import (C, Qiflush, "qiflush");
825       procedure No_Qiflush;
826       pragma Import (C, No_Qiflush, "noqiflush");
827    begin
828       if Flush then
829          Qiflush;
830       else
831          No_Qiflush;
832       end if;
833    end Set_Queue_Interrupt_Mode;
834
835    procedure Set_NoDelay_Mode
836      (Win  : in Window := Standard_Window;
837       Mode : in Boolean := False)
838    is
839       function Nodelay (Win : Window; Mode : C_Int) return C_Int;
840       pragma Import (C, Nodelay, "nodelay");
841    begin
842       if Nodelay (Win, Boolean'Pos (Mode)) = Curses_Err then
843          raise Curses_Exception;
844       end if;
845    end Set_NoDelay_Mode;
846
847    procedure Set_Timeout_Mode (Win    : in Window := Standard_Window;
848                                Mode   : in Timeout_Mode;
849                                Amount : in Natural)
850    is
851       function Wtimeout (Win : Window; Amount : C_Int) return C_Int;
852       pragma Import (C, Wtimeout, "wtimeout");
853
854       Time : C_Int;
855    begin
856       case Mode is
857          when Blocking     => Time := -1;
858          when Non_Blocking => Time := 0;
859          when Delayed      =>
860             if Amount = 0 then
861                raise CONSTRAINT_ERROR;
862             end if;
863             Time := C_Int (Amount);
864       end case;
865       if Wtimeout (Win, Time) = Curses_Err then
866          raise Curses_Exception;
867       end if;
868    end Set_Timeout_Mode;
869
870    procedure Set_Escape_Timer_Mode
871      (Win       : in Window := Standard_Window;
872       Timer_Off : in Boolean := False)
873    is
874       function Notimeout (Win : Window; Mode : C_Int) return C_Int;
875       pragma Import (C, Notimeout, "notimeout");
876    begin
877       if Notimeout (Win, Boolean'Pos (Timer_Off)) = Curses_Err then
878          raise Curses_Exception;
879       end if;
880    end Set_Escape_Timer_Mode;
881
882 ------------------------------------------------------------------------------
883    procedure Set_NL_Mode (SwitchOn : in Boolean := True)
884    is
885       function NL return C_Int;
886       pragma Import (C, NL, "nl");
887       function NoNL return C_Int;
888       pragma Import (C, NoNL, "nonl");
889
890       Err : C_Int;
891    begin
892       if SwitchOn then
893          Err := NL;
894       else
895          Err := NoNL;
896       end if;
897       if Err = Curses_Err then
898          raise Curses_Exception;
899       end if;
900    end Set_NL_Mode;
901
902    procedure Clear_On_Next_Update
903      (Win      : in Window := Standard_Window;
904       Do_Clear : in Boolean := True)
905    is
906       function Clear_Ok (W : Window; Flag : C_Int) return C_Int;
907       pragma Import (C, Clear_Ok, "clearok");
908    begin
909       if Clear_Ok (Win, Boolean'Pos (Do_Clear)) = Curses_Err then
910          raise Curses_Exception;
911       end if;
912    end Clear_On_Next_Update;
913
914    procedure Use_Insert_Delete_Line
915      (Win    : in Window := Standard_Window;
916       Do_Idl : in Boolean := True)
917    is
918       function IDL_Ok (W : Window; Flag : C_Int) return C_Int;
919       pragma Import (C, IDL_Ok, "idlok");
920    begin
921       if IDL_Ok (Win, Boolean'Pos (Do_Idl)) = Curses_Err then
922          raise Curses_Exception;
923       end if;
924    end Use_Insert_Delete_Line;
925
926    procedure Use_Insert_Delete_Character
927      (Win    : in Window := Standard_Window;
928       Do_Idc : in Boolean := True)
929    is
930       function IDC_Ok (W : Window; Flag : C_Int) return C_Int;
931       pragma Import (C, IDC_Ok, "idcok");
932    begin
933       if IDC_Ok (Win, Boolean'Pos (Do_Idc)) = Curses_Err then
934          raise Curses_Exception;
935       end if;
936    end Use_Insert_Delete_Character;
937
938    procedure Leave_Cursor_After_Update
939      (Win      : in Window := Standard_Window;
940       Do_Leave : in Boolean := True)
941    is
942       function Leave_Ok (W : Window; Flag : C_Int) return C_Int;
943       pragma Import (C, Leave_Ok, "leaveok");
944    begin
945       if Leave_Ok (Win, Boolean'Pos (Do_Leave)) = Curses_Err then
946          raise Curses_Exception;
947       end if;
948    end Leave_Cursor_After_Update;
949
950    procedure Immediate_Update_Mode
951      (Win  : in Window := Standard_Window;
952       Mode : in Boolean := False)
953    is
954       function Immedok (Win : Window; Mode : C_Int) return C_Int;
955       pragma Import (C, Immedok, "immedok");
956    begin
957       if Immedok (Win, Boolean'Pos (Mode)) = Curses_Err then
958          raise Curses_Exception;
959       end if;
960    end Immediate_Update_Mode;
961
962    procedure Allow_Scrolling
963      (Win  : in Window  := Standard_Window;
964       Mode : in Boolean := False)
965    is
966       function Scrollok (Win : Window; Mode : C_Int) return C_Int;
967       pragma Import (C, Scrollok, "scrollok");
968    begin
969       if Scrollok (Win, Boolean'Pos (Mode)) = Curses_Err then
970          raise Curses_Exception;
971       end if;
972    end Allow_Scrolling;
973
974    function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean
975    is
976       function Is_Scroll (Win : Window) return C_Int;
977       pragma Import (C, Is_Scroll, "_nc_ada_isscroll");
978
979       Res : constant C_Int := Is_Scroll (Win);
980    begin
981       case Res is
982          when Curses_True  => return True;
983          when Curses_False => return False;
984          when others       => raise Curses_Exception;
985       end case;
986    end Scrolling_Allowed;
987
988    procedure Set_Scroll_Region
989      (Win         : in Window := Standard_Window;
990       Top_Line    : in Line_Position;
991       Bottom_Line : in Line_Position)
992    is
993       function Wsetscrreg (Win : Window;
994                            Lin : C_Int;
995                            Col : C_Int) return C_Int;
996       pragma Import (C, Wsetscrreg, "wsetscrreg");
997    begin
998       if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
999         = Curses_Err then
1000          raise Curses_Exception;
1001       end if;
1002    end Set_Scroll_Region;
1003 ------------------------------------------------------------------------------
1004    procedure Update_Screen
1005    is
1006       function Do_Update return C_Int;
1007       pragma Import (C, Do_Update, "doupdate");
1008    begin
1009       if Do_Update = Curses_Err then
1010          raise Curses_Exception;
1011       end if;
1012    end Update_Screen;
1013
1014    procedure Refresh (Win : in Window := Standard_Window)
1015    is
1016       function Wrefresh (W : Window) return C_Int;
1017       pragma Import (C, Wrefresh, "wrefresh");
1018    begin
1019       if Wrefresh (Win) = Curses_Err then
1020          raise Curses_Exception;
1021       end if;
1022    end Refresh;
1023
1024    procedure Refresh_Without_Update
1025      (Win : in Window := Standard_Window)
1026    is
1027       function Wnoutrefresh (W : Window) return C_Int;
1028       pragma Import (C, Wnoutrefresh, "wnoutrefresh");
1029    begin
1030       if Wnoutrefresh (Win) = Curses_Err then
1031          raise Curses_Exception;
1032       end if;
1033    end Refresh_Without_Update;
1034
1035    procedure Redraw (Win : in Window := Standard_Window)
1036    is
1037       function Redrawwin (Win : Window) return C_Int;
1038       pragma Import (C, Redrawwin, "redrawwin");
1039    begin
1040       if Redrawwin (Win) = Curses_Err then
1041          raise Curses_Exception;
1042       end if;
1043    end Redraw;
1044
1045    procedure Redraw
1046      (Win        : in Window := Standard_Window;
1047       Begin_Line : in Line_Position;
1048       Line_Count : in Positive)
1049    is
1050       function Wredrawln (Win : Window; First : C_Int; Cnt : C_Int)
1051                           return C_Int;
1052       pragma Import (C, Wredrawln, "wredrawln");
1053    begin
1054       if Wredrawln (Win,
1055                     C_Int (Begin_Line),
1056                     C_Int (Line_Count)) = Curses_Err then
1057          raise Curses_Exception;
1058       end if;
1059    end Redraw;
1060
1061 ------------------------------------------------------------------------------
1062    procedure Erase (Win : in Window := Standard_Window)
1063    is
1064       function Werase (W : Window) return C_Int;
1065       pragma Import (C, Werase, "werase");
1066    begin
1067       if Werase (Win) = Curses_Err then
1068          raise Curses_Exception;
1069       end if;
1070    end Erase;
1071
1072    procedure Clear (Win : in Window := Standard_Window)
1073    is
1074       function Wclear (W : Window) return C_Int;
1075       pragma Import (C, Wclear, "wclear");
1076    begin
1077       if Wclear (Win) = Curses_Err then
1078          raise Curses_Exception;
1079       end if;
1080    end Clear;
1081
1082    procedure Clear_To_End_Of_Screen (Win : in Window := Standard_Window)
1083    is
1084       function Wclearbot (W : Window) return C_Int;
1085       pragma Import (C, Wclearbot, "wclrtobot");
1086    begin
1087       if Wclearbot (Win) = Curses_Err then
1088          raise Curses_Exception;
1089       end if;
1090    end Clear_To_End_Of_Screen;
1091
1092    procedure Clear_To_End_Of_Line (Win : in Window := Standard_Window)
1093    is
1094       function Wcleareol (W : Window) return C_Int;
1095       pragma Import (C, Wcleareol, "wclrtoeol");
1096    begin
1097       if Wcleareol (Win) = Curses_Err then
1098          raise Curses_Exception;
1099       end if;
1100    end Clear_To_End_Of_Line;
1101 ------------------------------------------------------------------------------
1102    procedure Set_Background
1103      (Win : in Window := Standard_Window;
1104       Ch  : in Attributed_Character)
1105    is
1106       procedure WBackground (W : in Window; Ch : in C_Int);
1107       pragma Import (C, WBackground, "wbkgdset");
1108    begin
1109       WBackground (Win, Chtype_To_CInt (Ch));
1110    end Set_Background;
1111
1112    procedure Change_Background
1113      (Win : in Window := Standard_Window;
1114       Ch  : in Attributed_Character)
1115    is
1116       function WChangeBkgd (W : Window; Ch : C_Int)
1117                             return C_Int;
1118       pragma Import (C, WChangeBkgd, "wbkgd");
1119    begin
1120       if WChangeBkgd (Win, Chtype_To_CInt (Ch)) = Curses_Err then
1121          raise Curses_Exception;
1122       end if;
1123    end Change_Background;
1124
1125    function Get_Background (Win : Window := Standard_Window)
1126      return Attributed_Character
1127    is
1128       function Wgetbkgd (Win : Window) return C_Int;
1129       pragma Import (C, Wgetbkgd, "getbkgd");
1130    begin
1131       return CInt_To_Chtype (Wgetbkgd (Win));
1132    end Get_Background;
1133 ------------------------------------------------------------------------------
1134    procedure Change_Lines_Status (Win   : in Window := Standard_Window;
1135                                   Start : in Line_Position;
1136                                   Count : in Positive;
1137                                   State : in Boolean)
1138    is
1139       function Wtouchln (Win : Window;
1140                          Sta : C_Int;
1141                          Cnt : C_Int;
1142                          Chg : C_Int) return C_Int;
1143       pragma Import (C, Wtouchln, "wtouchln");
1144    begin
1145       if Wtouchln (Win, C_Int (Start), C_Int (Count),
1146                    C_Int (Boolean'Pos (State))) = Curses_Err then
1147          raise Curses_Exception;
1148       end if;
1149    end Change_Lines_Status;
1150
1151    procedure Touch (Win : in Window := Standard_Window)
1152    is
1153       Y : Line_Position;
1154       X : Column_Position;
1155    begin
1156       Get_Size (Win, Y, X);
1157       Change_Lines_Status (Win, 0, Positive (Y), True);
1158    end Touch;
1159
1160    procedure Untouch (Win : in Window := Standard_Window)
1161    is
1162       Y : Line_Position;
1163       X : Column_Position;
1164    begin
1165       Get_Size (Win, Y, X);
1166       Change_Lines_Status (Win, 0, Positive (Y), False);
1167    end Untouch;
1168
1169    procedure Touch (Win   : in Window := Standard_Window;
1170                     Start : in Line_Position;
1171                     Count : in Positive)
1172    is
1173    begin
1174       Change_Lines_Status (Win, Start, Count, True);
1175    end Touch;
1176
1177    function Is_Touched
1178      (Win  : Window := Standard_Window;
1179       Line : Line_Position) return Boolean
1180    is
1181       function WLineTouched (W : Window; L : C_Int) return C_Int;
1182       pragma Import (C, WLineTouched, "is_linetouched");
1183    begin
1184       if WLineTouched (Win, C_Int (Line)) = Curses_False then
1185          return False;
1186       else
1187          return True;
1188       end if;
1189    end Is_Touched;
1190
1191    function Is_Touched
1192      (Win : Window := Standard_Window) return Boolean
1193    is
1194       function WWinTouched (W : Window) return C_Int;
1195       pragma Import (C, WWinTouched, "is_wintouched");
1196    begin
1197       if WWinTouched (Win) = Curses_False then
1198          return False;
1199       else
1200          return True;
1201       end if;
1202    end Is_Touched;
1203 ------------------------------------------------------------------------------
1204    procedure Copy
1205      (Source_Window            : in Window;
1206       Destination_Window       : in Window;
1207       Source_Top_Row           : in Line_Position;
1208       Source_Left_Column       : in Column_Position;
1209       Destination_Top_Row      : in Line_Position;
1210       Destination_Left_Column  : in Column_Position;
1211       Destination_Bottom_Row   : in Line_Position;
1212       Destination_Right_Column : in Column_Position;
1213       Non_Destructive_Mode     : in Boolean := True)
1214    is
1215       function Copywin (Src : Window;
1216                         Dst : Window;
1217                         Str : C_Int;
1218                         Slc : C_Int;
1219                         Dtr : C_Int;
1220                         Dlc : C_Int;
1221                         Dbr : C_Int;
1222                         Drc : C_Int;
1223                         Ndm : C_Int) return C_Int;
1224       pragma Import (C, Copywin, "copywin");
1225    begin
1226       if Copywin (Source_Window,
1227                   Destination_Window,
1228                   C_Int (Source_Top_Row),
1229                   C_Int (Source_Left_Column),
1230                   C_Int (Destination_Top_Row),
1231                   C_Int (Destination_Left_Column),
1232                   C_Int (Destination_Bottom_Row),
1233                   C_Int (Destination_Right_Column),
1234                   Boolean'Pos (Non_Destructive_Mode)
1235                 ) = Curses_Err then
1236          raise Curses_Exception;
1237       end if;
1238    end Copy;
1239
1240    procedure Overwrite
1241      (Source_Window      : in Window;
1242       Destination_Window : in Window)
1243    is
1244       function Overwrite (Src : Window; Dst : Window) return C_Int;
1245       pragma Import (C, Overwrite, "overwrite");
1246    begin
1247       if Overwrite (Source_Window, Destination_Window) = Curses_Err then
1248          raise Curses_Exception;
1249       end if;
1250    end Overwrite;
1251
1252    procedure Overlay
1253      (Source_Window      : in Window;
1254       Destination_Window : in Window)
1255    is
1256       function Overlay (Src : Window; Dst : Window) return C_Int;
1257       pragma Import (C, Overlay, "overlay");
1258    begin
1259       if Overlay (Source_Window, Destination_Window) = Curses_Err then
1260          raise Curses_Exception;
1261       end if;
1262    end Overlay;
1263
1264 ------------------------------------------------------------------------------
1265    procedure Insert_Delete_Lines
1266      (Win   : in Window := Standard_Window;
1267       Lines : in Integer       := 1) -- default is to insert one line above
1268    is
1269       function Winsdelln (W : Window; N : C_Int) return C_Int;
1270       pragma Import (C, Winsdelln, "winsdelln");
1271    begin
1272       if Winsdelln (Win, C_Int (Lines)) = Curses_Err then
1273          raise Curses_Exception;
1274       end if;
1275    end Insert_Delete_Lines;
1276
1277    procedure Delete_Line (Win : in Window := Standard_Window)
1278    is
1279    begin
1280       Insert_Delete_Lines (Win, -1);
1281    end Delete_Line;
1282
1283    procedure Insert_Line (Win : in Window := Standard_Window)
1284    is
1285    begin
1286       Insert_Delete_Lines (Win, 1);
1287    end Insert_Line;
1288 ------------------------------------------------------------------------------
1289    procedure Get_Size
1290      (Win               : in Window := Standard_Window;
1291       Number_Of_Lines   : out Line_Count;
1292       Number_Of_Columns : out Column_Count)
1293    is
1294       type Int_Access is access all C_Int;
1295       function Getmaxyx (W : Window; Y, X : Int_Access) return C_Int;
1296       pragma Import (C, Getmaxyx, "_nc_ada_getmaxyx");
1297
1298       Y, X : aliased C_Int;
1299       Err  : constant C_Int := Getmaxyx (Win, Y'Access, X'Access);
1300    begin
1301       if Err = Curses_Err then
1302          raise Curses_Exception;
1303       else
1304          Number_Of_Lines   := Line_Count (Y);
1305          Number_Of_Columns := Column_Count (X);
1306       end if;
1307    end Get_Size;
1308
1309    procedure Get_Window_Position
1310      (Win             : in Window := Standard_Window;
1311       Top_Left_Line   : out Line_Position;
1312       Top_Left_Column : out Column_Position)
1313    is
1314       type Int_Access is access all C_Int;
1315       function Getbegyx (W : Window; Y, X : Int_Access) return C_Int;
1316       pragma Import (C, Getbegyx, "_nc_ada_getbegyx");
1317
1318       Y, X : aliased C_Int;
1319       Err  : constant C_Int := Getbegyx (Win, Y'Access, X'Access);
1320    begin
1321       if Err = Curses_Err then
1322          raise Curses_Exception;
1323       else
1324          Top_Left_Line   := Line_Position (Y);
1325          Top_Left_Column := Column_Position (X);
1326       end if;
1327    end Get_Window_Position;
1328
1329    procedure Get_Cursor_Position
1330      (Win    : in  Window := Standard_Window;
1331       Line   : out Line_Position;
1332       Column : out Column_Position)
1333    is
1334       type Int_Access is access all C_Int;
1335       function Getyx (W : Window; Y, X : Int_Access) return C_Int;
1336       pragma Import (C, Getyx, "_nc_ada_getyx");
1337
1338       Y, X : aliased C_Int;
1339       Err  : constant C_Int := Getyx (Win, Y'Access, X'Access);
1340    begin
1341       if Err = Curses_Err then
1342          raise Curses_Exception;
1343       else
1344          Line   := Line_Position (Y);
1345          Column := Column_Position (X);
1346       end if;
1347    end Get_Cursor_Position;
1348
1349    procedure Get_Origin_Relative_To_Parent
1350      (Win                : in  Window;
1351       Top_Left_Line      : out Line_Position;
1352       Top_Left_Column    : out Column_Position;
1353       Is_Not_A_Subwindow : out Boolean)
1354    is
1355       type Int_Access is access all C_Int;
1356       function Getparyx (W : Window; Y, X : Int_Access) return C_Int;
1357       pragma Import (C, Getparyx, "_nc_ada_getparyx");
1358
1359       Y, X : aliased C_Int;
1360       Err  : constant C_Int := Getparyx (Win, Y'Access, X'Access);
1361    begin
1362       if Err = Curses_Err then
1363          raise Curses_Exception;
1364       else
1365          if Y = -1 then
1366             Top_Left_Line   := Line_Position'Last;
1367             Top_Left_Column := Column_Position'Last;
1368             Is_Not_A_Subwindow := True;
1369          else
1370             Top_Left_Line   := Line_Position (Y);
1371             Top_Left_Column := Column_Position (X);
1372             Is_Not_A_Subwindow := False;
1373          end if;
1374       end if;
1375    end Get_Origin_Relative_To_Parent;
1376 ------------------------------------------------------------------------------
1377    function New_Pad (Lines   : Line_Count;
1378                      Columns : Column_Count) return Window
1379    is
1380       function Newpad (Lines : C_Int; Columns : C_Int) return Window;
1381       pragma Import (C, Newpad, "newpad");
1382
1383       W : Window;
1384    begin
1385       W := Newpad (C_Int (Lines), C_Int (Columns));
1386       if W = Null_Window then
1387          raise Curses_Exception;
1388       end if;
1389       return W;
1390    end New_Pad;
1391
1392    function Sub_Pad
1393      (Pad                   : Window;
1394       Number_Of_Lines       : Line_Count;
1395       Number_Of_Columns     : Column_Count;
1396       First_Line_Position   : Line_Position;
1397       First_Column_Position : Column_Position) return Window
1398    is
1399       function Subpad
1400         (Pad                   : Window;
1401          Number_Of_Lines       : C_Int;
1402          Number_Of_Columns     : C_Int;
1403          First_Line_Position   : C_Int;
1404          First_Column_Position : C_Int) return Window;
1405       pragma Import (C, Subpad, "subpad");
1406
1407       W : Window;
1408    begin
1409       W := Subpad (Pad,
1410                    C_Int (Number_Of_Lines),
1411                    C_Int (Number_Of_Columns),
1412                    C_Int (First_Line_Position),
1413                    C_Int (First_Column_Position));
1414       if W = Null_Window then
1415          raise Curses_Exception;
1416       end if;
1417       return W;
1418    end Sub_Pad;
1419
1420    procedure Refresh
1421      (Pad                      : in Window;
1422       Source_Top_Row           : in Line_Position;
1423       Source_Left_Column       : in Column_Position;
1424       Destination_Top_Row      : in Line_Position;
1425       Destination_Left_Column  : in Column_Position;
1426       Destination_Bottom_Row   : in Line_Position;
1427       Destination_Right_Column : in Column_Position)
1428    is
1429       function Prefresh
1430         (Pad                      : Window;
1431          Source_Top_Row           : C_Int;
1432          Source_Left_Column       : C_Int;
1433          Destination_Top_Row      : C_Int;
1434          Destination_Left_Column  : C_Int;
1435          Destination_Bottom_Row   : C_Int;
1436          Destination_Right_Column : C_Int) return C_Int;
1437       pragma Import (C, Prefresh, "prefresh");
1438    begin
1439       if Prefresh (Pad,
1440                    C_Int (Source_Top_Row),
1441                    C_Int (Source_Left_Column),
1442                    C_Int (Destination_Top_Row),
1443                    C_Int (Destination_Left_Column),
1444                    C_Int (Destination_Bottom_Row),
1445                    C_Int (Destination_Right_Column)) = Curses_Err then
1446          raise Curses_Exception;
1447       end if;
1448    end Refresh;
1449
1450    procedure Refresh_Without_Update
1451      (Pad                      : in Window;
1452       Source_Top_Row           : in Line_Position;
1453       Source_Left_Column       : in Column_Position;
1454       Destination_Top_Row      : in Line_Position;
1455       Destination_Left_Column  : in Column_Position;
1456       Destination_Bottom_Row   : in Line_Position;
1457       Destination_Right_Column : in Column_Position)
1458    is
1459       function Pnoutrefresh
1460         (Pad                      : Window;
1461          Source_Top_Row           : C_Int;
1462          Source_Left_Column       : C_Int;
1463          Destination_Top_Row      : C_Int;
1464          Destination_Left_Column  : C_Int;
1465          Destination_Bottom_Row   : C_Int;
1466          Destination_Right_Column : C_Int) return C_Int;
1467       pragma Import (C, Pnoutrefresh, "pnoutrefresh");
1468    begin
1469       if Pnoutrefresh (Pad,
1470                        C_Int (Source_Top_Row),
1471                        C_Int (Source_Left_Column),
1472                        C_Int (Destination_Top_Row),
1473                        C_Int (Destination_Left_Column),
1474                        C_Int (Destination_Bottom_Row),
1475                        C_Int (Destination_Right_Column)) = Curses_Err then
1476          raise Curses_Exception;
1477       end if;
1478    end Refresh_Without_Update;
1479
1480    procedure Add_Character_To_Pad_And_Echo_It
1481      (Pad : in Window;
1482       Ch  : in Attributed_Character)
1483    is
1484       function Pechochar (Pad : Window; Ch : C_Int)
1485                           return C_Int;
1486       pragma Import (C, Pechochar, "pechochar");
1487    begin
1488       if Pechochar (Pad, Chtype_To_CInt (Ch)) = Curses_Err then
1489          raise Curses_Exception;
1490       end if;
1491    end Add_Character_To_Pad_And_Echo_It;
1492
1493    procedure Add_Character_To_Pad_And_Echo_It
1494      (Pad : in Window;
1495       Ch  : in Character)
1496    is
1497    begin
1498       Add_Character_To_Pad_And_Echo_It
1499         (Pad,
1500          Attributed_Character'(Ch    => Ch,
1501                                Color => Color_Pair'First,
1502                                Attr  => Normal_Video));
1503    end Add_Character_To_Pad_And_Echo_It;
1504 ------------------------------------------------------------------------------
1505    procedure Scroll (Win    : in Window := Standard_Window;
1506                      Amount : in Integer := 1)
1507    is
1508       function Wscrl (Win : Window; N : C_Int) return C_Int;
1509       pragma Import (C, Wscrl, "wscrl");
1510
1511    begin
1512       if Wscrl (Win, C_Int (Amount)) = Curses_Err then
1513          raise Curses_Exception;
1514       end if;
1515    end Scroll;
1516
1517 ------------------------------------------------------------------------------
1518    procedure Delete_Character (Win : in Window := Standard_Window)
1519    is
1520       function Wdelch (Win : Window) return C_Int;
1521       pragma Import (C, Wdelch, "wdelch");
1522    begin
1523       if Wdelch (Win) = Curses_Err then
1524          raise Curses_Exception;
1525       end if;
1526    end Delete_Character;
1527
1528    procedure Delete_Character
1529      (Win    : in Window := Standard_Window;
1530       Line   : in Line_Position;
1531       Column : in Column_Position)
1532    is
1533       function Mvwdelch (Win : Window;
1534                          Lin : C_Int;
1535                          Col : C_Int) return C_Int;
1536       pragma Import (C, Mvwdelch, "mvwdelch");
1537    begin
1538       if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
1539          raise Curses_Exception;
1540       end if;
1541    end Delete_Character;
1542 ------------------------------------------------------------------------------
1543    function Peek (Win : Window := Standard_Window)
1544      return Attributed_Character
1545    is
1546       function Winch (Win : Window) return C_Int;
1547       pragma Import (C, Winch, "winch");
1548    begin
1549       return CInt_To_Chtype (Winch (Win));
1550    end Peek;
1551
1552    function Peek
1553      (Win    : Window := Standard_Window;
1554       Line   : Line_Position;
1555       Column : Column_Position) return Attributed_Character
1556    is
1557       function Mvwinch (Win : Window;
1558                         Lin : C_Int;
1559                         Col : C_Int) return C_Int;
1560       pragma Import (C, Mvwinch, "mvwinch");
1561    begin
1562       return CInt_To_Chtype (Mvwinch (Win, C_Int (Line), C_Int (Column)));
1563    end Peek;
1564 ------------------------------------------------------------------------------
1565    procedure Insert (Win : in Window := Standard_Window;
1566                      Ch  : in Attributed_Character)
1567    is
1568       function Winsch (Win : Window; Ch : C_Int) return C_Int;
1569       pragma Import (C, Winsch, "winsch");
1570    begin
1571       if Winsch (Win, Chtype_To_CInt (Ch)) = Curses_Err then
1572          raise Curses_Exception;
1573       end if;
1574    end Insert;
1575
1576    procedure Insert
1577      (Win    : in Window := Standard_Window;
1578       Line   : in Line_Position;
1579       Column : in Column_Position;
1580       Ch     : in Attributed_Character)
1581    is
1582       function Mvwinsch (Win : Window;
1583                          Lin : C_Int;
1584                          Col : C_Int;
1585                          Ch  : C_Int) return C_Int;
1586       pragma Import (C, Mvwinsch, "mvwinsch");
1587    begin
1588       if Mvwinsch (Win,
1589                    C_Int (Line),
1590                    C_Int (Column),
1591                    Chtype_To_CInt (Ch)) = Curses_Err then
1592          raise Curses_Exception;
1593       end if;
1594    end Insert;
1595 ------------------------------------------------------------------------------
1596    procedure Insert (Win : in Window := Standard_Window;
1597                      Str : in String;
1598                      Len : in Integer := -1)
1599    is
1600       type Char_Ptr is access all Interfaces.C.Char;
1601       function Winsnstr (Win : Window;
1602                          Str : Char_Ptr;
1603                          Len : Integer := -1) return C_Int;
1604       pragma Import (C, Winsnstr, "winsnstr");
1605
1606       Txt    : char_array (0 .. Str'Length);
1607       Length : size_t;
1608    begin
1609       To_C (Str, Txt, Length);
1610       if Winsnstr (Win, Txt (Txt'First)'Access, Len) = Curses_Err then
1611          raise Curses_Exception;
1612       end if;
1613    end Insert;
1614
1615    procedure Insert
1616      (Win    : in Window := Standard_Window;
1617       Line   : in Line_Position;
1618       Column : in Column_Position;
1619       Str    : in String;
1620       Len    : in Integer := -1)
1621    is
1622       type Char_Ptr is access all Interfaces.C.Char;
1623       function Mvwinsnstr (Win    : Window;
1624                            Line   : C_Int;
1625                            Column : C_Int;
1626                            Str    : Char_Ptr;
1627                            Len    : C_Int) return C_Int;
1628       pragma Import (C, Mvwinsnstr, "mvwinsnstr");
1629
1630       Txt    : char_array (0 .. Str'Length);
1631       Length : size_t;
1632    begin
1633       To_C (Str, Txt, Length);
1634       if Mvwinsnstr (Win, C_Int (Line), C_Int (Column),
1635                      Txt (Txt'First)'Access, C_Int (Len))
1636         = Curses_Err then
1637          raise Curses_Exception;
1638       end if;
1639    end Insert;
1640 ------------------------------------------------------------------------------
1641    procedure Peek (Win : in  Window := Standard_Window;
1642                    Str : out String;
1643                    Len : in  Integer := -1)
1644    is
1645       function Winnstr (Win : Window;
1646                         Str : char_array;
1647                         Len : C_Int) return C_Int;
1648       pragma Import (C, Winnstr, "winnstr");
1649
1650       N   : Integer := Len;
1651       Txt : char_array (0 .. Str'Length);
1652       Cnt : Natural;
1653    begin
1654       if N < 0 then
1655          N := Str'Length;
1656       end if;
1657       if N > Str'Length then
1658          raise Constraint_Error;
1659       end if;
1660       Txt (0) := Interfaces.C.char'First;
1661       if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then
1662          raise Curses_Exception;
1663       end if;
1664       To_Ada (Txt, Str, Cnt, True);
1665       if Cnt < Str'Length then
1666          Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1667       end if;
1668    end Peek;
1669
1670    procedure Peek
1671      (Win    : in  Window := Standard_Window;
1672       Line   : in  Line_Position;
1673       Column : in  Column_Position;
1674       Str    : out String;
1675       Len    : in  Integer := -1)
1676    is
1677    begin
1678       Move_Cursor (Win, Line, Column);
1679       Peek (Win, Str, Len);
1680    end Peek;
1681 ------------------------------------------------------------------------------
1682    procedure Peek
1683      (Win : in  Window := Standard_Window;
1684       Str : out Attributed_String;
1685       Len : in  Integer := -1)
1686    is
1687       type Chtype_Ptr is access all Attributed_Character;
1688       function Winchnstr (Win : Window;
1689                           Str : Chtype_Ptr;
1690                           Len : C_Int) return C_Int;
1691       pragma Import (C, Winchnstr, "winchnstr");
1692
1693       N   : Integer := Len;
1694       Txt : chtype_array (0 .. Str'Length);
1695       Cnt : Natural := 0;
1696    begin
1697       if N < 0 then
1698          N := Str'Length;
1699       end if;
1700       if N > Str'Length then
1701          raise Constraint_Error;
1702       end if;
1703       if Winchnstr (Win, Txt (Txt'First)'Access, C_Int (N)) = Curses_Err then
1704          raise Curses_Exception;
1705       end if;
1706       for To in Str'Range loop
1707          exit when Txt (size_t (Cnt)) = Default_Character;
1708          Str (To) := Txt (size_t (Cnt));
1709          Cnt := Cnt + 1;
1710       end loop;
1711       if Cnt < Str'Length then
1712          Str ((Str'First + Cnt) .. Str'Last) :=
1713            (others => (Ch => ' ',
1714                        Color => Color_Pair'First,
1715                        Attr => Normal_Video));
1716       end if;
1717    end Peek;
1718
1719    procedure Peek
1720      (Win    : in  Window := Standard_Window;
1721       Line   : in  Line_Position;
1722       Column : in  Column_Position;
1723       Str    : out Attributed_String;
1724       Len    : in Integer := -1)
1725    is
1726    begin
1727       Move_Cursor (Win, Line, Column);
1728       Peek (Win, Str, Len);
1729    end Peek;
1730 ------------------------------------------------------------------------------
1731    procedure Get (Win : in  Window := Standard_Window;
1732                   Str : out String;
1733                   Len : in  Integer := -1)
1734    is
1735       function Wgetnstr (Win : Window;
1736                          Str : char_array;
1737                          Len : C_Int) return C_Int;
1738       pragma Import (C, Wgetnstr, "wgetnstr");
1739
1740       N   : Integer := Len;
1741       Txt : char_array (0 .. Str'Length);
1742       Cnt : Natural;
1743    begin
1744       if N < 0 then
1745          N := Str'Length;
1746       end if;
1747       if N > Str'Length then
1748          raise Constraint_Error;
1749       end if;
1750       Txt (0) := Interfaces.C.char'First;
1751       if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then
1752          raise Curses_Exception;
1753       end if;
1754       To_Ada (Txt, Str, Cnt, True);
1755       if Cnt < Str'Length then
1756          Str ((Str'First + Cnt) .. Str'Last) := (others => ' ');
1757       end if;
1758    end Get;
1759
1760    procedure Get
1761      (Win    : in  Window := Standard_Window;
1762       Line   : in  Line_Position;
1763       Column : in  Column_Position;
1764       Str    : out String;
1765       Len    : in  Integer := -1)
1766    is
1767    begin
1768       Move_Cursor (Win, Line, Column);
1769       Get (Win, Str, Len);
1770    end Get;
1771 ------------------------------------------------------------------------------
1772    procedure Init_Soft_Label_Keys
1773      (Format : in Soft_Label_Key_Format := Three_Two_Three)
1774    is
1775       function Slk_Init (Fmt : C_Int) return C_Int;
1776       pragma Import (C, Slk_Init, "slk_init");
1777    begin
1778       if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then
1779          raise Curses_Exception;
1780       end if;
1781    end Init_Soft_Label_Keys;
1782
1783    procedure Set_Soft_Label_Key (Label : in Label_Number;
1784                                  Text  : in String;
1785                                  Fmt   : in Label_Justification := Left)
1786    is
1787       type Char_Ptr is access all Interfaces.C.Char;
1788       function Slk_Set (Label : C_Int;
1789                         Txt   : Char_Ptr;
1790                         Fmt   : C_Int) return C_Int;
1791       pragma Import (C, Slk_Set, "slk_set");
1792
1793       Txt : char_array (0 .. Text'Length);
1794       Len : size_t;
1795    begin
1796       To_C (Text, Txt, Len);
1797       if Slk_Set (C_Int (Label),
1798                   Txt (Txt'First)'Access,
1799                   C_Int (Label_Justification'Pos (Fmt)))
1800         = Curses_Err then
1801          raise Curses_Exception;
1802       end if;
1803    end Set_Soft_Label_Key;
1804
1805    procedure Refresh_Soft_Label_Keys
1806    is
1807       function Slk_Refresh return C_Int;
1808       pragma Import (C, Slk_Refresh, "slk_refresh");
1809    begin
1810       if Slk_Refresh = Curses_Err then
1811          raise Curses_Exception;
1812       end if;
1813    end Refresh_Soft_Label_Keys;
1814
1815    procedure Refresh_Soft_Label_Keys_Without_Update
1816    is
1817       function Slk_Noutrefresh return C_Int;
1818       pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh");
1819    begin
1820       if Slk_Noutrefresh = Curses_Err then
1821          raise Curses_Exception;
1822       end if;
1823    end Refresh_Soft_Label_Keys_Without_Update;
1824
1825    procedure Get_Soft_Label_Key (Label : in Label_Number;
1826                                  Text  : out String)
1827    is
1828       function Slk_Label (Label : C_Int) return chars_ptr;
1829       pragma Import (C, Slk_Label, "slk_label");
1830    begin
1831       Fill_String (Slk_Label (C_Int (Label)), Text);
1832    end Get_Soft_Label_Key;
1833
1834    function Get_Soft_Label_Key (Label : in Label_Number) return String
1835    is
1836       function Slk_Label (Label : C_Int) return chars_ptr;
1837       pragma Import (C, Slk_Label, "slk_label");
1838    begin
1839       return Fill_String (Slk_Label (C_Int (Label)));
1840    end Get_Soft_Label_Key;
1841
1842    procedure Clear_Soft_Label_Keys
1843    is
1844       function Slk_Clear return C_Int;
1845       pragma Import (C, Slk_Clear, "slk_clear");
1846    begin
1847       if Slk_Clear = Curses_Err then
1848          raise Curses_Exception;
1849       end if;
1850    end Clear_Soft_Label_Keys;
1851
1852    procedure Restore_Soft_Label_Keys
1853    is
1854       function Slk_Restore return C_Int;
1855       pragma Import (C, Slk_Restore, "slk_restore");
1856    begin
1857       if Slk_Restore = Curses_Err then
1858          raise Curses_Exception;
1859       end if;
1860    end Restore_Soft_Label_Keys;
1861
1862    procedure Touch_Soft_Label_Keys
1863    is
1864       function Slk_Touch return C_Int;
1865       pragma Import (C, Slk_Touch, "slk_touch");
1866    begin
1867       if Slk_Touch = Curses_Err then
1868          raise Curses_Exception;
1869       end if;
1870    end Touch_Soft_Label_Keys;
1871
1872    procedure Switch_Soft_Label_Key_Attributes
1873      (Attr : in Character_Attribute_Set;
1874       On   : in Boolean := True)
1875    is
1876       function Slk_Attron (Ch : C_Int) return C_Int;
1877       pragma Import (C, Slk_Attron, "slk_attron");
1878       function Slk_Attroff (Ch : C_Int) return C_Int;
1879       pragma Import (C, Slk_Attroff, "slk_attroff");
1880
1881       Err : C_Int;
1882       Ch  : constant Attributed_Character := (Ch    => Character'First,
1883                                               Attr  => Attr,
1884                                               Color => Color_Pair'First);
1885    begin
1886       if On then
1887          Err := Slk_Attron  (Chtype_To_CInt (Ch));
1888       else
1889          Err := Slk_Attroff (Chtype_To_CInt (Ch));
1890       end if;
1891       if Err = Curses_Err then
1892          raise Curses_Exception;
1893       end if;
1894    end Switch_Soft_Label_Key_Attributes;
1895
1896    procedure Set_Soft_Label_Key_Attributes
1897      (Attr  : in Character_Attribute_Set := Normal_Video;
1898       Color : in Color_Pair := Color_Pair'First)
1899    is
1900       function Slk_Attrset (Ch : C_Int) return C_Int;
1901       pragma Import (C, Slk_Attrset, "slk_attrset");
1902
1903       Ch : constant Attributed_Character := (Ch    => Character'First,
1904                                              Attr  => Attr,
1905                                              Color => Color);
1906    begin
1907       if Slk_Attrset (Chtype_To_CInt (Ch)) = Curses_Err then
1908          raise Curses_Exception;
1909       end if;
1910    end Set_Soft_Label_Key_Attributes;
1911
1912    function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
1913    is
1914       function Slk_Attr return C_Int;
1915       pragma Import (C, Slk_Attr, "slk_attr");
1916
1917       Attr : constant C_Int := Slk_Attr;
1918    begin
1919       return CInt_To_Chtype (Attr).Attr;
1920    end Get_Soft_Label_Key_Attributes;
1921
1922    function Get_Soft_Label_Key_Attributes return Color_Pair
1923    is
1924       function Slk_Attr return C_Int;
1925       pragma Import (C, Slk_Attr, "slk_attr");
1926
1927       Attr : constant C_Int := Slk_Attr;
1928    begin
1929       return CInt_To_Chtype (Attr).Color;
1930    end Get_Soft_Label_Key_Attributes;
1931 ------------------------------------------------------------------------------
1932    procedure Enable_Key (Key    : in Special_Key_Code;
1933                          Enable : in Boolean := True)
1934    is
1935       function Keyok (Keycode : C_Int;
1936                       On_Off  : C_Int) return C_Int;
1937       pragma Import (C, Keyok, "keyok");
1938    begin
1939       if Keyok (C_Int (Key), Boolean'Pos (Enable)) = Curses_Err then
1940          raise Curses_Exception;
1941       end if;
1942    end Enable_Key;
1943 ------------------------------------------------------------------------------
1944    procedure Define_Key (Definition : in String;
1945                          Key        : in Special_Key_Code)
1946    is
1947       type Char_Ptr is access all Interfaces.C.Char;
1948       function Defkey (Def : Char_Ptr;
1949                        Key : C_Int) return C_Int;
1950       pragma Import (C, Defkey, "define_key");
1951
1952       Txt    : char_array (0 .. Definition'Length);
1953       Length : size_t;
1954    begin
1955       To_C (Definition, Txt, Length);
1956       if Defkey (Txt (Txt'First)'Access, C_Int (Key)) = Curses_Err then
1957          raise Curses_Exception;
1958       end if;
1959    end Define_Key;
1960 ------------------------------------------------------------------------------
1961    procedure Un_Control (Ch  : in Attributed_Character;
1962                          Str : out String)
1963    is
1964       function Unctrl (Ch : C_Int) return chars_ptr;
1965       pragma Import (C, Unctrl, "unctrl");
1966    begin
1967       Fill_String (Unctrl (Chtype_To_CInt (Ch)), Str);
1968    end Un_Control;
1969
1970    function Un_Control (Ch : in Attributed_Character) return String
1971    is
1972       function Unctrl (Ch : C_Int) return chars_ptr;
1973       pragma Import (C, Unctrl, "unctrl");
1974    begin
1975       return Fill_String (Unctrl (Chtype_To_CInt (Ch)));
1976    end Un_Control;
1977
1978    procedure Delay_Output (Msecs : in Natural)
1979    is
1980       function Delayoutput (Msecs : C_Int) return C_Int;
1981       pragma Import (C, Delayoutput, "delay_output");
1982    begin
1983       if Delayoutput (C_Int (Msecs)) = Curses_Err then
1984          raise Curses_Exception;
1985       end if;
1986    end Delay_Output;
1987
1988    procedure Flush_Input
1989    is
1990       function Flushinp return C_Int;
1991       pragma Import (C, Flushinp, "flushinp");
1992    begin
1993       if Flushinp = Curses_Err then  -- docu says that never happens, but...
1994          raise Curses_Exception;
1995       end if;
1996    end Flush_Input;
1997 ------------------------------------------------------------------------------
1998    function Baudrate return Natural
1999    is
2000       function Baud return C_Int;
2001       pragma Import (C, Baud, "baudrate");
2002    begin
2003       return Natural (Baud);
2004    end Baudrate;
2005
2006    function Erase_Character return Character
2007    is
2008       function Erasechar return C_Int;
2009       pragma Import (C, Erasechar, "erasechar");
2010    begin
2011       return Character'Val (Erasechar);
2012    end Erase_Character;
2013
2014    function Kill_Character return Character
2015    is
2016       function Killchar return C_Int;
2017       pragma Import (C, Killchar, "killchar");
2018    begin
2019       return Character'Val (Killchar);
2020    end Kill_Character;
2021
2022    function Has_Insert_Character return Boolean
2023    is
2024       function Has_Ic return C_Int;
2025       pragma Import (C, Has_Ic, "has_ic");
2026    begin
2027       if Has_Ic = Curses_False then
2028          return False;
2029       else
2030          return True;
2031       end if;
2032    end Has_Insert_Character;
2033
2034    function Has_Insert_Line return Boolean
2035    is
2036       function Has_Il return C_Int;
2037       pragma Import (C, Has_Il, "has_il");
2038    begin
2039       if Has_Il = Curses_False then
2040          return False;
2041       else
2042          return True;
2043       end if;
2044    end Has_Insert_Line;
2045
2046    function Supported_Attributes return Character_Attribute_Set
2047    is
2048       function Termattrs return C_Int;
2049       pragma Import (C, Termattrs, "termattrs");
2050
2051       Ch : constant Attributed_Character := CInt_To_Chtype (Termattrs);
2052    begin
2053       return Ch.Attr;
2054    end Supported_Attributes;
2055
2056    procedure Long_Name (Name : out String)
2057    is
2058       function Longname return chars_ptr;
2059       pragma Import (C, Longname, "longname");
2060    begin
2061       Fill_String (Longname, Name);
2062    end Long_Name;
2063
2064    function Long_Name return String
2065    is
2066       function Longname return chars_ptr;
2067       pragma Import (C, Longname, "longname");
2068    begin
2069       return Fill_String (Longname);
2070    end Long_Name;
2071
2072    procedure Terminal_Name (Name : out String)
2073    is
2074       function Termname return chars_ptr;
2075       pragma Import (C, Termname, "termname");
2076    begin
2077       Fill_String (Termname, Name);
2078    end Terminal_Name;
2079
2080    function Terminal_Name return String
2081    is
2082       function Termname return chars_ptr;
2083       pragma Import (C, Termname, "termname");
2084    begin
2085       return Fill_String (Termname);
2086    end Terminal_Name;
2087 ------------------------------------------------------------------------------
2088    procedure Init_Pair (Pair : in Redefinable_Color_Pair;
2089                         Fore : in Color_Number;
2090                         Back : in Color_Number)
2091    is
2092       function Initpair (Pair : C_Short;
2093                          Fore : C_Short;
2094                          Back : C_Short) return C_Int;
2095       pragma Import (C, Initpair, "init_pair");
2096    begin
2097       if Integer (Pair) >= Number_Of_Color_Pairs then
2098          raise Constraint_Error;
2099       end if;
2100       if Integer (Fore) >= Number_Of_Colors or else
2101         Integer (Back) >= Number_Of_Colors then raise Constraint_Error;
2102       end if;
2103       if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back))
2104         = Curses_Err then
2105          raise Curses_Exception;
2106       end if;
2107    end Init_Pair;
2108
2109    procedure Pair_Content (Pair : in Color_Pair;
2110                            Fore : out Color_Number;
2111                            Back : out Color_Number)
2112    is
2113       type C_Short_Access is access all C_Short;
2114       function Paircontent (Pair : C_Short;
2115                             Fp   : C_Short_Access;
2116                             Bp   : C_Short_Access) return C_Int;
2117       pragma Import (C, Paircontent, "pair_content");
2118
2119       F, B : aliased C_Short;
2120    begin
2121       if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then
2122          raise Curses_Exception;
2123       else
2124          Fore := Color_Number (F);
2125          Back := Color_Number (B);
2126       end if;
2127    end Pair_Content;
2128
2129    function Has_Colors return Boolean
2130    is
2131       function Hascolors return C_Int;
2132       pragma Import (C, Hascolors, "has_colors");
2133    begin
2134       if Hascolors = Curses_False then
2135          return False;
2136       else
2137          return True;
2138       end if;
2139    end Has_Colors;
2140
2141    procedure Init_Color (Color : in Color_Number;
2142                          Red   : in RGB_Value;
2143                          Green : in RGB_Value;
2144                          Blue  : in RGB_Value)
2145    is
2146       function Initcolor (Col   : C_Short;
2147                           Red   : C_Short;
2148                           Green : C_Short;
2149                           Blue  : C_Short) return C_Int;
2150       pragma Import (C, Initcolor, "init_color");
2151    begin
2152       if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green),
2153                     C_Short (Blue)) = Curses_Err then
2154             raise Curses_Exception;
2155       end if;
2156    end Init_Color;
2157
2158    function Can_Change_Color return Boolean
2159    is
2160       function Canchangecolor return C_Int;
2161       pragma Import (C, Canchangecolor, "can_change_color");
2162    begin
2163       if Canchangecolor = Curses_False then
2164          return False;
2165       else
2166          return True;
2167       end if;
2168    end Can_Change_Color;
2169
2170    procedure Color_Content (Color : in  Color_Number;
2171                             Red   : out RGB_Value;
2172                             Green : out RGB_Value;
2173                             Blue  : out RGB_Value)
2174    is
2175       type C_Short_Access is access all C_Short;
2176
2177       function Colorcontent (Color : C_Short; R, G, B : C_Short_Access)
2178                              return C_Int;
2179       pragma Import (C, Colorcontent, "color_content");
2180
2181       R, G, B : aliased C_Short;
2182    begin
2183       if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) =
2184         Curses_Err then
2185          raise Curses_Exception;
2186       else
2187          Red   := RGB_Value (R);
2188          Green := RGB_Value (G);
2189          Blue  := RGB_Value (B);
2190       end if;
2191    end Color_Content;
2192
2193 ------------------------------------------------------------------------------
2194    procedure Save_Curses_Mode (Mode : in Curses_Mode)
2195    is
2196       function Def_Prog_Mode return C_Int;
2197       pragma Import (C, Def_Prog_Mode, "def_prog_mode");
2198       function Def_Shell_Mode return C_Int;
2199       pragma Import (C, Def_Shell_Mode, "def_shell_mode");
2200
2201       Err : C_Int;
2202    begin
2203       case Mode is
2204          when Curses => Err := Def_Prog_Mode;
2205          when Shell  => Err := Def_Shell_Mode;
2206       end case;
2207       if Err = Curses_Err then
2208          raise Curses_Exception;
2209       end if;
2210    end Save_Curses_Mode;
2211
2212    procedure Reset_Curses_Mode (Mode : in Curses_Mode)
2213    is
2214       function Reset_Prog_Mode return C_Int;
2215       pragma Import (C, Reset_Prog_Mode, "reset_prog_mode");
2216       function Reset_Shell_Mode return C_Int;
2217       pragma Import (C, Reset_Shell_Mode, "reset_shell_mode");
2218
2219       Err : C_Int;
2220    begin
2221       case Mode is
2222          when Curses => Err := Reset_Prog_Mode;
2223          when Shell  => Err := Reset_Shell_Mode;
2224       end case;
2225       if Err = Curses_Err then
2226          raise Curses_Exception;
2227       end if;
2228    end Reset_Curses_Mode;
2229
2230    procedure Save_Terminal_State
2231    is
2232       function Savetty return C_Int;
2233       pragma Import (C, Savetty, "savetty");
2234    begin
2235       if Savetty = Curses_Err then
2236          raise Curses_Exception;
2237       end if;
2238    end Save_Terminal_State;
2239
2240    procedure Reset_Terminal_State
2241    is
2242       function Resetty return C_Int;
2243       pragma Import (C, Resetty, "resetty");
2244    begin
2245       if Resetty = Curses_Err then
2246          raise Curses_Exception;
2247       end if;
2248    end Reset_Terminal_State;
2249
2250    procedure Rip_Off_Lines (Lines : in Integer;
2251                             Proc  : in Stdscr_Init_Proc)
2252    is
2253       function Ripoffline (Lines : C_Int;
2254                            Proc  : Stdscr_Init_Proc) return C_Int;
2255       pragma Import (C, Ripoffline, "_nc_ripoffline");
2256    begin
2257       if Ripoffline (C_Int (Lines), Proc) = Curses_Err then
2258          raise Curses_Exception;
2259       end if;
2260    end Rip_Off_Lines;
2261
2262    procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility)
2263    is
2264       function Curs_Set (Curs : C_Int) return C_Int;
2265       pragma Import (C, Curs_Set, "curs_set");
2266
2267       Res : C_Int;
2268    begin
2269       Res := Curs_Set (Cursor_Visibility'Pos (Visibility));
2270       if Res /= Curses_Err then
2271          Visibility := Cursor_Visibility'Val (Res);
2272       end if;
2273    end Set_Cursor_Visibility;
2274
2275    procedure Nap_Milli_Seconds (Ms : in Natural)
2276    is
2277       function Napms (Ms : C_Int) return C_Int;
2278       pragma Import (C, Napms, "napms");
2279    begin
2280       if Napms (C_Int (Ms)) = Curses_Err then
2281          raise Curses_Exception;
2282       end if;
2283    end Nap_Milli_Seconds;
2284 ------------------------------------------------------------------------------
2285
2286    function Standard_Window return Window
2287    is
2288       Stdscr : Window;
2289       pragma Import (C, Stdscr, "stdscr");
2290    begin
2291       return Stdscr;
2292    end Standard_Window;
2293
2294    function Lines return Line_Count
2295    is
2296       C_Lines : C_Int;
2297       pragma Import (C, C_Lines, "LINES");
2298    begin
2299       return Line_Count (C_Lines);
2300    end Lines;
2301
2302    function Columns return Column_Count
2303    is
2304       C_Columns : C_Int;
2305       pragma Import (C, C_Columns, "COLS");
2306    begin
2307       return Column_Count (C_Columns);
2308    end Columns;
2309
2310    function Tab_Size return Natural
2311    is
2312       C_Tab_Size : C_Int;
2313       pragma Import (C, C_Tab_Size, "TABSIZE");
2314    begin
2315       return Natural (C_Tab_Size);
2316    end Tab_Size;
2317
2318    function Number_Of_Colors return Natural
2319    is
2320       C_Number_Of_Colors : C_Int;
2321       pragma Import (C, C_Number_Of_Colors, "COLORS");
2322    begin
2323       return Natural (C_Number_Of_Colors);
2324    end Number_Of_Colors;
2325
2326    function Number_Of_Color_Pairs return Natural
2327    is
2328       C_Number_Of_Color_Pairs : C_Int;
2329       pragma Import (C, C_Number_Of_Color_Pairs, "COLOR_PAIRS");
2330    begin
2331       return Natural (C_Number_Of_Color_Pairs);
2332    end Number_Of_Color_Pairs;
2333 ------------------------------------------------------------------------------
2334    procedure Transform_Coordinates
2335      (W      : in Window := Standard_Window;
2336       Line   : in out Line_Position;
2337       Column : in out Column_Position;
2338       Dir    : in Transform_Direction := From_Screen)
2339    is
2340       type Int_Access is access all C_Int;
2341       function Transform (W    : Window;
2342                           Y, X : Int_Access;
2343                           Dir  : C_Int) return C_Int;
2344       pragma Import (C, Transform, "_nc_ada_coord_transform");
2345
2346       X : aliased C_Int := C_Int (Column);
2347       Y : aliased C_Int := C_Int (Line);
2348       D : C_Int := 0;
2349       R : C_Int;
2350    begin
2351       if Dir = To_Screen then
2352          D := 1;
2353       end if;
2354       R := Transform (W, Y'Access, X'Access, D);
2355       if R = Curses_False then
2356          raise Curses_Exception;
2357       else
2358          Line   := Line_Position (Y);
2359          Column := Column_Position (X);
2360       end if;
2361    end Transform_Coordinates;
2362
2363 end Terminal_Interface.Curses;