Ada95/src/terminal_interface-curses.adb

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