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