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