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