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