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