Ada95/gen/terminal_interface-curses.adb.m4

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