Ada95/ada_include/terminal_interface-curses.adb

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