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