Ada95/gen/terminal_interface-curses.adb.m4

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