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