File : terminal_interface-curses.adb
------------------------------------------------------------------------------
-- --
-- GNAT ncurses Binding --
-- --
-- Terminal_Interface.Curses --
-- --
-- B O D Y --
-- --
------------------------------------------------------------------------------
-- Copyright (c) 1998 Free Software Foundation, Inc. --
-- --
-- Permission is hereby granted, free of charge, to any person obtaining a --
-- copy of this software and associated documentation files (the --
-- "Software"), to deal in the Software without restriction, including --
-- without limitation the rights to use, copy, modify, merge, publish, --
-- distribute, distribute with modifications, sublicense, and/or sell --
-- copies of the Software, and to permit persons to whom the Software is --
-- furnished to do so, subject to the following conditions: --
-- --
-- The above copyright notice and this permission notice shall be included --
-- in all copies or substantial portions of the Software. --
-- --
-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
-- --
-- Except as contained in this notice, the name(s) of the above copyright --
-- holders shall not be used in advertising or otherwise to promote the --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
-- Author: Jürgen Pfeifer, 1996
-- Contact: www.familiepfeifer.de/Contact.aspx?Lang=en
-- Version Control:
-- @Revision: 1.28 @
-- Binding Version 01.00
------------------------------------------------------------------------------
with System;
with Terminal_Interface.Curses.Aux;
with Interfaces.C; use Interfaces.C;
with Interfaces.C.Strings; use Interfaces.C.Strings;
with Interfaces.C.Pointers;
with Ada.Characters.Handling; use Ada.Characters.Handling;
with Ada.Strings.Fixed;
with Ada.Unchecked_Conversion;
package body Terminal_Interface.Curses is
use Aux;
use type System.Bit_Order;
package ASF renames Ada.Strings.Fixed;
type chtype_array is array (size_t range <>)
of aliased Attributed_Character;
pragma Convention (C, chtype_array);
------------------------------------------------------------------------------
generic
type Element is (<>);
function W_Get_Element (Win : in Window;
Offset : in Natural) return Element;
function W_Get_Element (Win : in Window;
Offset : in Natural) return Element is
type E_Array is array (Natural range <>) of aliased Element;
package C_E_Array is new
Interfaces.C.Pointers (Natural, Element, E_Array, Element'Val (0));
use C_E_Array;
function To_Pointer is new
Ada.Unchecked_Conversion (Window, Pointer);
P : Pointer := To_Pointer (Win);
begin
if Win = Null_Window then
raise Curses_Exception;
else
P := P + ptrdiff_t (Offset);
return P.all;
end if;
end W_Get_Element;
function W_Get_Int is new W_Get_Element (C_Int);
function W_Get_Short is new W_Get_Element (C_Short);
function W_Get_Byte is new W_Get_Element (Interfaces.C.unsigned_char);
function Get_Flag (Win : Window;
Offset : Natural) return Boolean;
function Get_Flag (Win : Window;
Offset : Natural) return Boolean
is
Res : C_Int;
begin
case Sizeof_bool is
when 1 => Res := C_Int (W_Get_Byte (Win, Offset));
when 2 => Res := C_Int (W_Get_Short (Win, Offset));
when 4 => Res := C_Int (W_Get_Int (Win, Offset));
when others => raise Curses_Exception;
end case;
case Res is
when 0 => return False;
when others => return True;
end case;
end Get_Flag;
------------------------------------------------------------------------------
function Key_Name (Key : in Real_Key_Code) return String
is
function Keyname (K : C_Int) return chars_ptr;
pragma Import (C, Keyname, "keyname");
Ch : Character;
begin
if Key <= Character'Pos (Character'Last) then
Ch := Character'Val (Key);
if Is_Control (Ch) then
return Un_Control (Attributed_Character'(Ch => Ch,
Color => Color_Pair'First,
Attr => Normal_Video));
elsif Is_Graphic (Ch) then
declare
S : String (1 .. 1);
begin
S (1) := Ch;
return S;
end;
else
return "";
end if;
else
return Fill_String (Keyname (C_Int (Key)));
end if;
end Key_Name;
procedure Key_Name (Key : in Real_Key_Code;
Name : out String)
is
begin
ASF.Move (Key_Name (Key), Name);
end Key_Name;
------------------------------------------------------------------------------
procedure Init_Screen
is
function Initscr return Window;
pragma Import (C, Initscr, "initscr");
W : Window;
begin
W := Initscr;
if W = Null_Window then
raise Curses_Exception;
end if;
end Init_Screen;
procedure End_Windows
is
function Endwin return C_Int;
pragma Import (C, Endwin, "endwin");
begin
if Endwin = Curses_Err then
raise Curses_Exception;
end if;
end End_Windows;
function Is_End_Window return Boolean
is
function Isendwin return Curses_Bool;
pragma Import (C, Isendwin, "isendwin");
begin
if Isendwin = Curses_Bool_False then
return False;
else
return True;
end if;
end Is_End_Window;
------------------------------------------------------------------------------
procedure Move_Cursor (Win : in Window := Standard_Window;
Line : in Line_Position;
Column : in Column_Position)
is
function Wmove (Win : Window;
Line : C_Int;
Column : C_Int
) return C_Int;
pragma Import (C, Wmove, "wmove");
begin
if Wmove (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
raise Curses_Exception;
end if;
end Move_Cursor;
------------------------------------------------------------------------------
procedure Add (Win : in Window := Standard_Window;
Ch : in Attributed_Character)
is
function Waddch (W : Window;
Ch : C_Chtype) return C_Int;
pragma Import (C, Waddch, "waddch");
begin
if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Add;
procedure Add (Win : in Window := Standard_Window;
Ch : in Character)
is
begin
Add (Win,
Attributed_Character'(Ch => Ch,
Color => Color_Pair'First,
Attr => Normal_Video));
end Add;
procedure Add
(Win : in Window := Standard_Window;
Line : in Line_Position;
Column : in Column_Position;
Ch : in Attributed_Character)
is
function mvwaddch (W : Window;
Y : C_Int;
X : C_Int;
Ch : C_Chtype) return C_Int;
pragma Import (C, mvwaddch, "mvwaddch");
begin
if mvwaddch (Win, C_Int (Line),
C_Int (Column),
AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Add;
procedure Add
(Win : in Window := Standard_Window;
Line : in Line_Position;
Column : in Column_Position;
Ch : in Character)
is
begin
Add (Win,
Line,
Column,
Attributed_Character'(Ch => Ch,
Color => Color_Pair'First,
Attr => Normal_Video));
end Add;
procedure Add_With_Immediate_Echo
(Win : in Window := Standard_Window;
Ch : in Attributed_Character)
is
function Wechochar (W : Window;
Ch : C_Chtype) return C_Int;
pragma Import (C, Wechochar, "wechochar");
begin
if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Add_With_Immediate_Echo;
procedure Add_With_Immediate_Echo
(Win : in Window := Standard_Window;
Ch : in Character)
is
begin
Add_With_Immediate_Echo
(Win,
Attributed_Character'(Ch => Ch,
Color => Color_Pair'First,
Attr => Normal_Video));
end Add_With_Immediate_Echo;
------------------------------------------------------------------------------
function Create (Number_Of_Lines : Line_Count;
Number_Of_Columns : Column_Count;
First_Line_Position : Line_Position;
First_Column_Position : Column_Position) return Window
is
function Newwin (Number_Of_Lines : C_Int;
Number_Of_Columns : C_Int;
First_Line_Position : C_Int;
First_Column_Position : C_Int) return Window;
pragma Import (C, Newwin, "newwin");
W : Window;
begin
W := Newwin (C_Int (Number_Of_Lines),
C_Int (Number_Of_Columns),
C_Int (First_Line_Position),
C_Int (First_Column_Position));
if W = Null_Window then
raise Curses_Exception;
end if;
return W;
end Create;
procedure Delete (Win : in out Window)
is
function Wdelwin (W : Window) return C_Int;
pragma Import (C, Wdelwin, "delwin");
begin
if Wdelwin (Win) = Curses_Err then
raise Curses_Exception;
end if;
Win := Null_Window;
end Delete;
function Sub_Window
(Win : Window := Standard_Window;
Number_Of_Lines : Line_Count;
Number_Of_Columns : Column_Count;
First_Line_Position : Line_Position;
First_Column_Position : Column_Position) return Window
is
function Subwin
(Win : Window;
Number_Of_Lines : C_Int;
Number_Of_Columns : C_Int;
First_Line_Position : C_Int;
First_Column_Position : C_Int) return Window;
pragma Import (C, Subwin, "subwin");
W : Window;
begin
W := Subwin (Win,
C_Int (Number_Of_Lines),
C_Int (Number_Of_Columns),
C_Int (First_Line_Position),
C_Int (First_Column_Position));
if W = Null_Window then
raise Curses_Exception;
end if;
return W;
end Sub_Window;
function Derived_Window
(Win : Window := Standard_Window;
Number_Of_Lines : Line_Count;
Number_Of_Columns : Column_Count;
First_Line_Position : Line_Position;
First_Column_Position : Column_Position) return Window
is
function Derwin
(Win : Window;
Number_Of_Lines : C_Int;
Number_Of_Columns : C_Int;
First_Line_Position : C_Int;
First_Column_Position : C_Int) return Window;
pragma Import (C, Derwin, "derwin");
W : Window;
begin
W := Derwin (Win,
C_Int (Number_Of_Lines),
C_Int (Number_Of_Columns),
C_Int (First_Line_Position),
C_Int (First_Column_Position));
if W = Null_Window then
raise Curses_Exception;
end if;
return W;
end Derived_Window;
function Duplicate (Win : Window) return Window
is
function Dupwin (Win : Window) return Window;
pragma Import (C, Dupwin, "dupwin");
W : Window := Dupwin (Win);
begin
if W = Null_Window then
raise Curses_Exception;
end if;
return W;
end Duplicate;
procedure Move_Window (Win : in Window;
Line : in Line_Position;
Column : in Column_Position)
is
function Mvwin (Win : Window;
Line : C_Int;
Column : C_Int) return C_Int;
pragma Import (C, Mvwin, "mvwin");
begin
if Mvwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
raise Curses_Exception;
end if;
end Move_Window;
procedure Move_Derived_Window (Win : in Window;
Line : in Line_Position;
Column : in Column_Position)
is
function Mvderwin (Win : Window;
Line : C_Int;
Column : C_Int) return C_Int;
pragma Import (C, Mvderwin, "mvderwin");
begin
if Mvderwin (Win, C_Int (Line), C_Int (Column)) = Curses_Err then
raise Curses_Exception;
end if;
end Move_Derived_Window;
procedure Set_Synch_Mode (Win : in Window := Standard_Window;
Mode : in Boolean := False)
is
function Syncok (Win : Window;
Mode : Curses_Bool) return C_Int;
pragma Import (C, Syncok, "syncok");
begin
if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Synch_Mode;
------------------------------------------------------------------------------
procedure Add (Win : in Window := Standard_Window;
Str : in String;
Len : in Integer := -1)
is
function Waddnstr (Win : Window;
Str : char_array;
Len : C_Int := -1) return C_Int;
pragma Import (C, Waddnstr, "waddnstr");
Txt : char_array (0 .. Str'Length);
Length : size_t;
begin
To_C (Str, Txt, Length);
if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
raise Curses_Exception;
end if;
end Add;
procedure Add
(Win : in Window := Standard_Window;
Line : in Line_Position;
Column : in Column_Position;
Str : in String;
Len : in Integer := -1)
is
begin
Move_Cursor (Win, Line, Column);
Add (Win, Str, Len);
end Add;
------------------------------------------------------------------------------
procedure Add
(Win : in Window := Standard_Window;
Str : in Attributed_String;
Len : in Integer := -1)
is
function Waddchnstr (Win : Window;
Str : chtype_array;
Len : C_Int := -1) return C_Int;
pragma Import (C, Waddchnstr, "waddchnstr");
Txt : chtype_array (0 .. Str'Length);
begin
for Length in 1 .. size_t (Str'Length) loop
Txt (Length - 1) := Str (Natural (Length));
end loop;
Txt (Str'Length) := Default_Character;
if Waddchnstr (Win,
Txt,
C_Int (Len)) = Curses_Err then
raise Curses_Exception;
end if;
end Add;
procedure Add
(Win : in Window := Standard_Window;
Line : in Line_Position;
Column : in Column_Position;
Str : in Attributed_String;
Len : in Integer := -1)
is
begin
Move_Cursor (Win, Line, Column);
Add (Win, Str, Len);
end Add;
------------------------------------------------------------------------------
procedure Border
(Win : in Window := Standard_Window;
Left_Side_Symbol : in Attributed_Character := Default_Character;
Right_Side_Symbol : in Attributed_Character := Default_Character;
Top_Side_Symbol : in Attributed_Character := Default_Character;
Bottom_Side_Symbol : in Attributed_Character := Default_Character;
Upper_Left_Corner_Symbol : in Attributed_Character := Default_Character;
Upper_Right_Corner_Symbol : in Attributed_Character := Default_Character;
Lower_Left_Corner_Symbol : in Attributed_Character := Default_Character;
Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
is
function Wborder (W : Window;
LS : C_Chtype;
RS : C_Chtype;
TS : C_Chtype;
BS : C_Chtype;
ULC : C_Chtype;
URC : C_Chtype;
LLC : C_Chtype;
LRC : C_Chtype) return C_Int;
pragma Import (C, Wborder, "wborder");
begin
if Wborder (Win,
AttrChar_To_Chtype (Left_Side_Symbol),
AttrChar_To_Chtype (Right_Side_Symbol),
AttrChar_To_Chtype (Top_Side_Symbol),
AttrChar_To_Chtype (Bottom_Side_Symbol),
AttrChar_To_Chtype (Upper_Left_Corner_Symbol),
AttrChar_To_Chtype (Upper_Right_Corner_Symbol),
AttrChar_To_Chtype (Lower_Left_Corner_Symbol),
AttrChar_To_Chtype (Lower_Right_Corner_Symbol)
) = Curses_Err
then
raise Curses_Exception;
end if;
end Border;
procedure Box
(Win : in Window := Standard_Window;
Vertical_Symbol : in Attributed_Character := Default_Character;
Horizontal_Symbol : in Attributed_Character := Default_Character)
is
begin
Border (Win,
Vertical_Symbol, Vertical_Symbol,
Horizontal_Symbol, Horizontal_Symbol);
end Box;
procedure Horizontal_Line
(Win : in Window := Standard_Window;
Line_Size : in Natural;
Line_Symbol : in Attributed_Character := Default_Character)
is
function Whline (W : Window;
Ch : C_Chtype;
Len : C_Int) return C_Int;
pragma Import (C, Whline, "whline");
begin
if Whline (Win,
AttrChar_To_Chtype (Line_Symbol),
C_Int (Line_Size)) = Curses_Err then
raise Curses_Exception;
end if;
end Horizontal_Line;
procedure Vertical_Line
(Win : in Window := Standard_Window;
Line_Size : in Natural;
Line_Symbol : in Attributed_Character := Default_Character)
is
function Wvline (W : Window;
Ch : C_Chtype;
Len : C_Int) return C_Int;
pragma Import (C, Wvline, "wvline");
begin
if Wvline (Win,
AttrChar_To_Chtype (Line_Symbol),
C_Int (Line_Size)) = Curses_Err then
raise Curses_Exception;
end if;
end Vertical_Line;
------------------------------------------------------------------------------
function Get_Keystroke (Win : Window := Standard_Window)
return Real_Key_Code
is
function Wgetch (W : Window) return C_Int;
pragma Import (C, Wgetch, "wgetch");
C : constant C_Int := Wgetch (Win);
begin
if C = Curses_Err then
return Key_None;
else
return Real_Key_Code (C);
end if;
end Get_Keystroke;
procedure Undo_Keystroke (Key : in Real_Key_Code)
is
function Ungetch (Ch : C_Int) return C_Int;
pragma Import (C, Ungetch, "ungetch");
begin
if Ungetch (C_Int (Key)) = Curses_Err then
raise Curses_Exception;
end if;
end Undo_Keystroke;
function Has_Key (Key : Special_Key_Code) return Boolean
is
function Haskey (Key : C_Int) return C_Int;
pragma Import (C, Haskey, "has_key");
begin
if Haskey (C_Int (Key)) = Curses_False then
return False;
else
return True;
end if;
end Has_Key;
function Is_Function_Key (Key : Special_Key_Code) return Boolean
is
L : constant Special_Key_Code := Special_Key_Code (Natural (Key_F0) +
Natural (Function_Key_Number'Last));
begin
if (Key >= Key_F0) and then (Key <= L) then
return True;
else
return False;
end if;
end Is_Function_Key;
function Function_Key (Key : Real_Key_Code)
return Function_Key_Number
is
begin
if Is_Function_Key (Key) then
return Function_Key_Number (Key - Key_F0);
else
raise Constraint_Error;
end if;
end Function_Key;
function Function_Key_Code (Key : Function_Key_Number) return Real_Key_Code
is
begin
return Real_Key_Code (Natural (Key_F0) + Natural (Key));
end Function_Key_Code;
------------------------------------------------------------------------------
procedure Standout (Win : Window := Standard_Window;
On : Boolean := True)
is
function wstandout (Win : Window) return C_Int;
pragma Import (C, wstandout, "wstandout");
function wstandend (Win : Window) return C_Int;
pragma Import (C, wstandend, "wstandend");
Err : C_Int;
begin
if On then
Err := wstandout (Win);
else
Err := wstandend (Win);
end if;
if Err = Curses_Err then
raise Curses_Exception;
end if;
end Standout;
procedure Switch_Character_Attribute
(Win : in Window := Standard_Window;
Attr : in Character_Attribute_Set := Normal_Video;
On : in Boolean := True)
is
function Wattron (Win : Window;
C_Attr : C_AttrType) return C_Int;
pragma Import (C, Wattron, "wattr_on");
function Wattroff (Win : Window;
C_Attr : C_AttrType) return C_Int;
pragma Import (C, Wattroff, "wattr_off");
-- In Ada we use the On Boolean to control whether or not we want to
-- switch on or off the attributes in the set.
Err : C_Int;
AC : constant Attributed_Character := (Ch => Character'First,
Color => Color_Pair'First,
Attr => Attr);
begin
if On then
Err := Wattron (Win, AttrChar_To_AttrType (AC));
else
Err := Wattroff (Win, AttrChar_To_AttrType (AC));
end if;
if Err = Curses_Err then
raise Curses_Exception;
end if;
end Switch_Character_Attribute;
procedure Set_Character_Attributes
(Win : in Window := Standard_Window;
Attr : in Character_Attribute_Set := Normal_Video;
Color : in Color_Pair := Color_Pair'First)
is
function Wattrset (Win : Window;
C_Attr : C_AttrType) return C_Int;
pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
begin
if Wattrset (Win,
AttrChar_To_AttrType (Attributed_Character'
(Ch => Character'First,
Color => Color,
Attr => Attr))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Character_Attributes;
function Get_Character_Attribute (Win : Window := Standard_Window)
return Character_Attribute_Set
is
function Wattrget (Win : Window;
Atr : access C_AttrType;
Col : access C_Short;
Opt : System.Address) return C_Int;
pragma Import (C, Wattrget, "wattr_get");
Attr : aliased C_AttrType;
Col : aliased C_Short;
Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
System.Null_Address);
Ch : Attributed_Character;
begin
if Res = Curses_Ok then
Ch := AttrType_To_AttrChar (Attr);
return Ch.Attr;
else
raise Curses_Exception;
end if;
end Get_Character_Attribute;
function Get_Character_Attribute (Win : Window := Standard_Window)
return Color_Pair
is
function Wattrget (Win : Window;
Atr : access C_AttrType;
Col : access C_Short;
Opt : System.Address) return C_Int;
pragma Import (C, Wattrget, "wattr_get");
Attr : aliased C_AttrType;
Col : aliased C_Short;
Res : constant C_Int := Wattrget (Win, Attr'Access, Col'Access,
System.Null_Address);
Ch : Attributed_Character;
begin
if Res = Curses_Ok then
Ch := AttrType_To_AttrChar (Attr);
return Ch.Color;
else
raise Curses_Exception;
end if;
end Get_Character_Attribute;
procedure Set_Color (Win : in Window := Standard_Window;
Pair : in Color_Pair)
is
function Wset_Color (Win : Window;
Color : C_Short;
Opts : C_Void_Ptr) return C_Int;
pragma Import (C, Wset_Color, "wcolor_set");
begin
if Wset_Color (Win,
C_Short (Pair),
C_Void_Ptr (System.Null_Address)) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Color;
procedure Change_Attributes
(Win : in Window := Standard_Window;
Count : in Integer := -1;
Attr : in Character_Attribute_Set := Normal_Video;
Color : in Color_Pair := Color_Pair'First)
is
function Wchgat (Win : Window;
Cnt : C_Int;
Attr : C_AttrType;
Color : C_Short;
Opts : System.Address := System.Null_Address)
return C_Int;
pragma Import (C, Wchgat, "wchgat");
Ch : constant Attributed_Character :=
(Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
begin
if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
C_Short (Color)) = Curses_Err then
raise Curses_Exception;
end if;
end Change_Attributes;
procedure Change_Attributes
(Win : in Window := Standard_Window;
Line : in Line_Position := Line_Position'First;
Column : in Column_Position := Column_Position'First;
Count : in Integer := -1;
Attr : in Character_Attribute_Set := Normal_Video;
Color : in Color_Pair := Color_Pair'First)
is
begin
Move_Cursor (Win, Line, Column);
Change_Attributes (Win, Count, Attr, Color);
end Change_Attributes;
------------------------------------------------------------------------------
procedure Beep
is
function Beeper return C_Int;
pragma Import (C, Beeper, "beep");
begin
if Beeper = Curses_Err then
raise Curses_Exception;
end if;
end Beep;
procedure Flash_Screen
is
function Flash return C_Int;
pragma Import (C, Flash, "flash");
begin
if Flash = Curses_Err then
raise Curses_Exception;
end if;
end Flash_Screen;
------------------------------------------------------------------------------
procedure Set_Cbreak_Mode (SwitchOn : in Boolean := True)
is
function Cbreak return C_Int;
pragma Import (C, Cbreak, "cbreak");
function NoCbreak return C_Int;
pragma Import (C, NoCbreak, "nocbreak");
Err : C_Int;
begin
if SwitchOn then
Err := Cbreak;
else
Err := NoCbreak;
end if;
if Err = Curses_Err then
raise Curses_Exception;
end if;
end Set_Cbreak_Mode;
procedure Set_Raw_Mode (SwitchOn : in Boolean := True)
is
function Raw return C_Int;
pragma Import (C, Raw, "raw");
function NoRaw return C_Int;
pragma Import (C, NoRaw, "noraw");
Err : C_Int;
begin
if SwitchOn then
Err := Raw;
else
Err := NoRaw;
end if;
if Err = Curses_Err then
raise Curses_Exception;
end if;
end Set_Raw_Mode;
procedure Set_Echo_Mode (SwitchOn : in Boolean := True)
is
function Echo return C_Int;
pragma Import (C, Echo, "echo");
function NoEcho return C_Int;
pragma Import (C, NoEcho, "noecho");
Err : C_Int;
begin
if SwitchOn then
Err := Echo;
else
Err := NoEcho;
end if;
if Err = Curses_Err then
raise Curses_Exception;
end if;
end Set_Echo_Mode;
procedure Set_Meta_Mode (Win : in Window := Standard_Window;
SwitchOn : in Boolean := True)
is
function Meta (W : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Meta, "meta");
begin
if Meta (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Meta_Mode;
procedure Set_KeyPad_Mode (Win : in Window := Standard_Window;
SwitchOn : in Boolean := True)
is
function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Keypad, "keypad");
begin
if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_KeyPad_Mode;
function Get_KeyPad_Mode (Win : in Window := Standard_Window)
return Boolean
is
begin
return Get_Flag (Win, Offset_use_keypad);
end Get_KeyPad_Mode;
procedure Half_Delay (Amount : in Half_Delay_Amount)
is
function Halfdelay (Amount : C_Int) return C_Int;
pragma Import (C, Halfdelay, "halfdelay");
begin
if Halfdelay (C_Int (Amount)) = Curses_Err then
raise Curses_Exception;
end if;
end Half_Delay;
procedure Set_Flush_On_Interrupt_Mode
(Win : in Window := Standard_Window;
Mode : in Boolean := True)
is
function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Intrflush, "intrflush");
begin
if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Flush_On_Interrupt_Mode;
procedure Set_Queue_Interrupt_Mode
(Win : in Window := Standard_Window;
Flush : in Boolean := True)
is
procedure Qiflush;
pragma Import (C, Qiflush, "qiflush");
procedure No_Qiflush;
pragma Import (C, No_Qiflush, "noqiflush");
begin
if Flush then
Qiflush;
else
No_Qiflush;
end if;
end Set_Queue_Interrupt_Mode;
procedure Set_NoDelay_Mode
(Win : in Window := Standard_Window;
Mode : in Boolean := False)
is
function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Nodelay, "nodelay");
begin
if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_NoDelay_Mode;
procedure Set_Timeout_Mode (Win : in Window := Standard_Window;
Mode : in Timeout_Mode;
Amount : in Natural)
is
function Wtimeout (Win : Window; Amount : C_Int) return C_Int;
pragma Import (C, Wtimeout, "wtimeout");
Time : C_Int;
begin
case Mode is
when Blocking => Time := -1;
when Non_Blocking => Time := 0;
when Delayed =>
if Amount = 0 then
raise Constraint_Error;
end if;
Time := C_Int (Amount);
end case;
if Wtimeout (Win, Time) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Timeout_Mode;
procedure Set_Escape_Timer_Mode
(Win : in Window := Standard_Window;
Timer_Off : in Boolean := False)
is
function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Notimeout, "notimeout");
begin
if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
= Curses_Err then
raise Curses_Exception;
end if;
end Set_Escape_Timer_Mode;
------------------------------------------------------------------------------
procedure Set_NL_Mode (SwitchOn : in Boolean := True)
is
function NL return C_Int;
pragma Import (C, NL, "nl");
function NoNL return C_Int;
pragma Import (C, NoNL, "nonl");
Err : C_Int;
begin
if SwitchOn then
Err := NL;
else
Err := NoNL;
end if;
if Err = Curses_Err then
raise Curses_Exception;
end if;
end Set_NL_Mode;
procedure Clear_On_Next_Update
(Win : in Window := Standard_Window;
Do_Clear : in Boolean := True)
is
function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, Clear_Ok, "clearok");
begin
if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
raise Curses_Exception;
end if;
end Clear_On_Next_Update;
procedure Use_Insert_Delete_Line
(Win : in Window := Standard_Window;
Do_Idl : in Boolean := True)
is
function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, IDL_Ok, "idlok");
begin
if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
raise Curses_Exception;
end if;
end Use_Insert_Delete_Line;
procedure Use_Insert_Delete_Character
(Win : in Window := Standard_Window;
Do_Idc : in Boolean := True)
is
function IDC_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, IDC_Ok, "idcok");
begin
if IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))) = Curses_Err then
raise Curses_Exception;
end if;
end Use_Insert_Delete_Character;
procedure Leave_Cursor_After_Update
(Win : in Window := Standard_Window;
Do_Leave : in Boolean := True)
is
function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, Leave_Ok, "leaveok");
begin
if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
raise Curses_Exception;
end if;
end Leave_Cursor_After_Update;
procedure Immediate_Update_Mode
(Win : in Window := Standard_Window;
Mode : in Boolean := False)
is
function Immedok (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Immedok, "immedok");
begin
if Immedok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Immediate_Update_Mode;
procedure Allow_Scrolling
(Win : in Window := Standard_Window;
Mode : in Boolean := False)
is
function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Scrollok, "scrollok");
begin
if Scrollok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Allow_Scrolling;
function Scrolling_Allowed (Win : Window := Standard_Window)
return Boolean
is
begin
return Get_Flag (Win, Offset_scroll);
end Scrolling_Allowed;
procedure Set_Scroll_Region
(Win : in Window := Standard_Window;
Top_Line : in Line_Position;
Bottom_Line : in Line_Position)
is
function Wsetscrreg (Win : Window;
Lin : C_Int;
Col : C_Int) return C_Int;
pragma Import (C, Wsetscrreg, "wsetscrreg");
begin
if Wsetscrreg (Win, C_Int (Top_Line), C_Int (Bottom_Line))
= Curses_Err then
raise Curses_Exception;
end if;
end Set_Scroll_Region;
------------------------------------------------------------------------------
procedure Update_Screen
is
function Do_Update return C_Int;
pragma Import (C, Do_Update, "doupdate");
begin
if Do_Update = Curses_Err then
raise Curses_Exception;
end if;
end Update_Screen;
procedure Refresh (Win : in Window := Standard_Window)
is
function Wrefresh (W : Window) return C_Int;
pragma Import (C, Wrefresh, "wrefresh");
begin
if Wrefresh (Win) = Curses_Err then
raise Curses_Exception;
end if;
end Refresh;
procedure Refresh_Without_Update
(Win : in Window := Standard_Window)
is
function Wnoutrefresh (W : Window) return C_Int;
pragma Import (C, Wnoutrefresh, "wnoutrefresh");
begin
if Wnoutrefresh (Win) = Curses_Err then
raise Curses_Exception;
end if;
end Refresh_Without_Update;
procedure Redraw (Win : in Window := Standard_Window)
is
function Redrawwin (Win : Window) return C_Int;
pragma Import (C,