-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
--- Author: Juergen Pfeifer <Juergen.Pfeifer@T-Online.de> 1996
+-- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996
-- Version Control:
--- $Revision: 1.15 $
--- Binding Version 00.93
+-- $Revision: 1.25 $
+-- Binding Version 01.00
------------------------------------------------------------------------------
with System;
-with Terminal_Interface.Curses.Aux; use Terminal_Interface.Curses.Aux;
+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 Unchecked_Conversion;
+with Ada.Unchecked_Conversion;
package body Terminal_Interface.Curses is
+ use Aux;
use type System.Bit_Order;
package ASF renames Ada.Strings.Fixed;
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 Key_Name (Key : in Real_Key_Code) return String
is
function Initscr return Window;
pragma Import (C, Initscr, "initscr");
- function Check_Version (Major, Minor : C_Int) return C_Int;
- pragma Import (C, Check_Version, "_nc_ada_vcheck");
-
W : Window;
begin
- if (Check_Version (NC_Major_Version, NC_Minor_Version) = 0) then
- raise Wrong_Curses_Version;
- else
- W := Initscr;
- if W = Null_Window then
- raise Curses_Exception;
- end if;
+ W := Initscr;
+ if W = Null_Window then
+ raise Curses_Exception;
end if;
end Init_Screen;
function Is_End_Window return Boolean
is
- function Isendwin return C_Int;
+ function Isendwin return Curses_Bool;
pragma Import (C, Isendwin, "isendwin");
begin
- if Isendwin = Curses_False then
+ if Isendwin = Curses_Bool_False then
return False;
else
return True;
Ch : in Attributed_Character)
is
function Waddch (W : Window;
- Ch : C_Int) return C_Int;
+ Ch : C_Chtype) return C_Int;
pragma Import (C, Waddch, "waddch");
begin
- if Waddch (Win, Chtype_To_Cint (Ch)) = Curses_Err then
+ if Waddch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Add;
function mvwaddch (W : Window;
Y : C_Int;
X : C_Int;
- Ch : C_Int) return C_Int;
+ Ch : C_Chtype) return C_Int;
pragma Import (C, mvwaddch, "mvwaddch");
begin
if mvwaddch (Win, C_Int (Line),
C_Int (Column),
- Chtype_To_CInt (Ch)) = Curses_Err then
+ AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Add;
Ch : in Attributed_Character)
is
function Wechochar (W : Window;
- Ch : C_Int) return C_Int;
+ Ch : C_Chtype) return C_Int;
pragma Import (C, Wechochar, "wechochar");
begin
- if Wechochar (Win, Chtype_To_CInt (Ch)) = Curses_Err then
+ if Wechochar (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Add_With_Immediate_Echo;
Mode : in Boolean := False)
is
function Syncok (Win : Window;
- Mode : C_Int) return C_Int;
+ Mode : Curses_Bool) return C_Int;
pragma Import (C, Syncok, "syncok");
begin
- if Syncok (Win, Boolean'Pos (Mode)) = Curses_Err then
+ if Syncok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Synch_Mode;
Str : in String;
Len : in Integer := -1)
is
- type Char_Ptr is access all Interfaces.C.Char;
+ type Char_Ptr is access all Interfaces.C.char;
function Waddnstr (Win : Window;
Str : Char_Ptr;
Len : C_Int := -1) return C_Int;
Lower_Right_Corner_Symbol : in Attributed_Character := Default_Character)
is
function Wborder (W : Window;
- LS : C_Int;
- RS : C_Int;
- TS : C_Int;
- BS : C_Int;
- ULC : C_Int;
- URC : C_Int;
- LLC : C_Int;
- LRC : C_Int) return C_Int;
+ 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,
- Chtype_To_CInt (Left_Side_Symbol),
- Chtype_To_CInt (Right_Side_Symbol),
- Chtype_To_CInt (Top_Side_Symbol),
- Chtype_To_CInt (Bottom_Side_Symbol),
- Chtype_To_CInt (Upper_Left_Corner_Symbol),
- Chtype_To_CInt (Upper_Right_Corner_Symbol),
- Chtype_To_CInt (Lower_Left_Corner_Symbol),
- Chtype_To_CInt (Lower_Right_Corner_Symbol)
+ 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;
Line_Symbol : in Attributed_Character := Default_Character)
is
function Whline (W : Window;
- Ch : C_Int;
+ Ch : C_Chtype;
Len : C_Int) return C_Int;
pragma Import (C, Whline, "whline");
begin
if Whline (Win,
- Chtype_To_CInt (Line_Symbol),
+ AttrChar_To_Chtype (Line_Symbol),
C_Int (Line_Size)) = Curses_Err then
raise Curses_Exception;
end if;
Line_Symbol : in Attributed_Character := Default_Character)
is
function Wvline (W : Window;
- Ch : C_Int;
+ Ch : C_Chtype;
Len : C_Int) return C_Int;
pragma Import (C, Wvline, "wvline");
begin
if Wvline (Win,
- Chtype_To_CInt (Line_Symbol),
+ AttrChar_To_Chtype (Line_Symbol),
C_Int (Line_Size)) = Curses_Err then
raise Curses_Exception;
end if;
On : in Boolean := True)
is
function Wattron (Win : Window;
- C_Attr : C_Int) return C_Int;
+ C_Attr : C_AttrType) return C_Int;
pragma Import (C, Wattron, "wattr_on");
function Wattroff (Win : Window;
- C_Attr : C_Int) return C_Int;
+ 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.
Attr => Attr);
begin
if On then
- Err := Wattron (Win, Chtype_To_CInt (AC));
+ Err := Wattron (Win, AttrChar_To_AttrType (AC));
else
- Err := Wattroff (Win, Chtype_To_CInt (AC));
+ Err := Wattroff (Win, AttrChar_To_AttrType (AC));
end if;
if Err = Curses_Err then
raise Curses_Exception;
Color : in Color_Pair := Color_Pair'First)
is
function Wattrset (Win : Window;
- C_Attr : C_Int) return C_Int;
+ C_Attr : C_AttrType) return C_Int;
pragma Import (C, Wattrset, "wattrset"); -- ??? wattr_set
begin
if Wattrset (Win,
- Chtype_To_CInt (Attributed_Character'
- (Ch => Character'First,
- Color => Color,
- Attr => Attr))) = Curses_Err then
+ 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) return C_Int;
+ function Wattrget (Win : Window;
+ Atr : access C_AttrType;
+ Col : access C_Short;
+ Opt : System.Address) return C_Int;
pragma Import (C, Wattrget, "wattr_get");
- Ch : Attributed_Character := CInt_To_Chtype (Wattrget (Win));
+ 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
- return Ch.Attr;
+ 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) return C_Int;
+ function Wattrget (Win : Window;
+ Atr : access C_AttrType;
+ Col : access C_Short;
+ Opt : System.Address) return C_Int;
pragma Import (C, Wattrget, "wattr_get");
- Ch : Attributed_Character := CInt_To_Chtype (Wattrget (Win));
+ 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
- return Ch.Color;
+ 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;
is
function Wchgat (Win : Window;
Cnt : C_Int;
- Attr : C_Int;
+ Attr : C_AttrType;
Color : C_Short;
Opts : System.Address := System.Null_Address)
return C_Int;
Ch : constant Attributed_Character :=
(Ch => Character'First, Color => Color_Pair'First, Attr => Attr);
begin
- if Wchgat (Win, C_Int (Count), Chtype_To_CInt (Ch),
+ if Wchgat (Win, C_Int (Count), AttrChar_To_AttrType (Ch),
C_Short (Color)) = Curses_Err then
raise Curses_Exception;
end if;
procedure Set_Meta_Mode (Win : in Window := Standard_Window;
SwitchOn : in Boolean := True)
is
- function Meta (W : Window; Mode : C_Int) return C_Int;
+ function Meta (W : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Meta, "meta");
begin
- if Meta (Win, Boolean'Pos (SwitchOn)) = Curses_Err then
+ 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 : C_Int) return C_Int;
+ function Keypad (W : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Keypad, "keypad");
begin
- if Keypad (Win, Boolean'Pos (SwitchOn)) = Curses_Err then
+ if Keypad (Win, Curses_Bool (Boolean'Pos (SwitchOn))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_KeyPad_Mode;
(Win : in Window := Standard_Window;
Mode : in Boolean := True)
is
- function Intrflush (Win : Window; Mode : C_Int) return C_Int;
+ function Intrflush (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Intrflush, "intrflush");
begin
- if Intrflush (Win, Boolean'Pos (Mode)) = Curses_Err then
+ if Intrflush (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Flush_On_Interrupt_Mode;
(Win : in Window := Standard_Window;
Mode : in Boolean := False)
is
- function Nodelay (Win : Window; Mode : C_Int) return C_Int;
+ function Nodelay (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Nodelay, "nodelay");
begin
- if Nodelay (Win, Boolean'Pos (Mode)) = Curses_Err then
+ if Nodelay (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_NoDelay_Mode;
(Win : in Window := Standard_Window;
Timer_Off : in Boolean := False)
is
- function Notimeout (Win : Window; Mode : C_Int) return C_Int;
+ function Notimeout (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Notimeout, "notimeout");
begin
- if Notimeout (Win, Boolean'Pos (Timer_Off)) = Curses_Err then
+ if Notimeout (Win, Curses_Bool (Boolean'Pos (Timer_Off)))
+ = Curses_Err then
raise Curses_Exception;
end if;
end Set_Escape_Timer_Mode;
(Win : in Window := Standard_Window;
Do_Clear : in Boolean := True)
is
- function Clear_Ok (W : Window; Flag : C_Int) return C_Int;
+ function Clear_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, Clear_Ok, "clearok");
begin
- if Clear_Ok (Win, Boolean'Pos (Do_Clear)) = Curses_Err then
+ if Clear_Ok (Win, Curses_Bool (Boolean'Pos (Do_Clear))) = Curses_Err then
raise Curses_Exception;
end if;
end Clear_On_Next_Update;
(Win : in Window := Standard_Window;
Do_Idl : in Boolean := True)
is
- function IDL_Ok (W : Window; Flag : C_Int) return C_Int;
+ function IDL_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, IDL_Ok, "idlok");
begin
- if IDL_Ok (Win, Boolean'Pos (Do_Idl)) = Curses_Err then
+ if IDL_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idl))) = Curses_Err then
raise Curses_Exception;
end if;
end Use_Insert_Delete_Line;
(Win : in Window := Standard_Window;
Do_Idc : in Boolean := True)
is
- function IDC_Ok (W : Window; Flag : C_Int) return C_Int;
+ function IDC_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, IDC_Ok, "idcok");
begin
- if IDC_Ok (Win, Boolean'Pos (Do_Idc)) = Curses_Err then
+ if IDC_Ok (Win, Curses_Bool (Boolean'Pos (Do_Idc))) = Curses_Err then
raise Curses_Exception;
end if;
end Use_Insert_Delete_Character;
(Win : in Window := Standard_Window;
Do_Leave : in Boolean := True)
is
- function Leave_Ok (W : Window; Flag : C_Int) return C_Int;
+ function Leave_Ok (W : Window; Flag : Curses_Bool) return C_Int;
pragma Import (C, Leave_Ok, "leaveok");
begin
- if Leave_Ok (Win, Boolean'Pos (Do_Leave)) = Curses_Err then
+ if Leave_Ok (Win, Curses_Bool (Boolean'Pos (Do_Leave))) = Curses_Err then
raise Curses_Exception;
end if;
end Leave_Cursor_After_Update;
(Win : in Window := Standard_Window;
Mode : in Boolean := False)
is
- function Immedok (Win : Window; Mode : C_Int) return C_Int;
+ function Immedok (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Immedok, "immedok");
begin
- if Immedok (Win, Boolean'Pos (Mode)) = Curses_Err then
+ if Immedok (Win, Curses_Bool (Boolean'Pos (Mode))) = Curses_Err then
raise Curses_Exception;
end if;
end Immediate_Update_Mode;
(Win : in Window := Standard_Window;
Mode : in Boolean := False)
is
- function Scrollok (Win : Window; Mode : C_Int) return C_Int;
+ function Scrollok (Win : Window; Mode : Curses_Bool) return C_Int;
pragma Import (C, Scrollok, "scrollok");
begin
- if Scrollok (Win, Boolean'Pos (Mode)) = Curses_Err then
+ 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
- function Is_Scroll (Win : Window) return C_Int;
- pragma Import (C, Is_Scroll, "_nc_ada_isscroll");
-
- Res : constant C_Int := Is_Scroll (Win);
+ Res : C_Int;
begin
+ case Sizeof_bool is
+ when 1 => Res := C_Int (W_Get_Byte (Win, Offset_scroll));
+ when 2 => Res := C_Int (W_Get_Short (Win, Offset_scroll));
+ when 4 => Res := C_Int (W_Get_Int (Win, Offset_scroll));
+ when others => raise Curses_Exception;
+ end case;
+
case Res is
- when Curses_True => return True;
- when Curses_False => return False;
- when others => raise Curses_Exception;
+ when 0 => return False;
+ when others => return True;
end case;
end Scrolling_Allowed;
(Win : in Window := Standard_Window;
Ch : in Attributed_Character)
is
- procedure WBackground (W : in Window; Ch : in C_Int);
+ procedure WBackground (W : in Window; Ch : in C_Chtype);
pragma Import (C, WBackground, "wbkgdset");
begin
- WBackground (Win, Chtype_To_CInt (Ch));
+ WBackground (Win, AttrChar_To_Chtype (Ch));
end Set_Background;
procedure Change_Background
(Win : in Window := Standard_Window;
Ch : in Attributed_Character)
is
- function WChangeBkgd (W : Window; Ch : C_Int)
- return C_Int;
+ function WChangeBkgd (W : Window; Ch : C_Chtype) return C_Int;
pragma Import (C, WChangeBkgd, "wbkgd");
begin
- if WChangeBkgd (Win, Chtype_To_CInt (Ch)) = Curses_Err then
+ if WChangeBkgd (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Change_Background;
function Get_Background (Win : Window := Standard_Window)
return Attributed_Character
is
- function Wgetbkgd (Win : Window) return C_Int;
+ function Wgetbkgd (Win : Window) return C_Chtype;
pragma Import (C, Wgetbkgd, "getbkgd");
begin
- return CInt_To_Chtype (Wgetbkgd (Win));
+ return Chtype_To_AttrChar (Wgetbkgd (Win));
end Get_Background;
------------------------------------------------------------------------------
procedure Change_Lines_Status (Win : in Window := Standard_Window;
(Win : Window := Standard_Window;
Line : Line_Position) return Boolean
is
- function WLineTouched (W : Window; L : C_Int) return C_Int;
+ function WLineTouched (W : Window; L : C_Int) return Curses_Bool;
pragma Import (C, WLineTouched, "is_linetouched");
begin
- if WLineTouched (Win, C_Int (Line)) = Curses_False then
+ if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then
return False;
else
return True;
function Is_Touched
(Win : Window := Standard_Window) return Boolean
is
- function WWinTouched (W : Window) return C_Int;
+ function WWinTouched (W : Window) return Curses_Bool;
pragma Import (C, WWinTouched, "is_wintouched");
begin
- if WWinTouched (Win) = Curses_False then
+ if WWinTouched (Win) = Curses_Bool_False then
return False;
else
return True;
Insert_Delete_Lines (Win, 1);
end Insert_Line;
------------------------------------------------------------------------------
+
+
procedure Get_Size
(Win : in Window := Standard_Window;
Number_Of_Lines : out Line_Count;
Number_Of_Columns : out Column_Count)
is
- type Int_Access is access all C_Int;
- function Getmaxyx (W : Window; Y, X : Int_Access) return C_Int;
- pragma Import (C, Getmaxyx, "_nc_ada_getmaxyx");
-
- Y, X : aliased C_Int;
- Err : constant C_Int := Getmaxyx (Win, Y'Access, X'Access);
+ -- Please note: in ncurses they are one off.
+ -- This might be different in other implementations of curses
+ Y : C_Int := C_Int (W_Get_Short (Win, Offset_maxy)) + C_Int (Offset_XY);
+ X : C_Int := C_Int (W_Get_Short (Win, Offset_maxx)) + C_Int (Offset_XY);
begin
- if Err = Curses_Err then
- raise Curses_Exception;
- else
- Number_Of_Lines := Line_Count (Y);
- Number_Of_Columns := Column_Count (X);
- end if;
+ Number_Of_Lines := Line_Count (Y);
+ Number_Of_Columns := Column_Count (X);
end Get_Size;
procedure Get_Window_Position
Top_Left_Line : out Line_Position;
Top_Left_Column : out Column_Position)
is
- type Int_Access is access all C_Int;
- function Getbegyx (W : Window; Y, X : Int_Access) return C_Int;
- pragma Import (C, Getbegyx, "_nc_ada_getbegyx");
-
- Y, X : aliased C_Int;
- Err : constant C_Int := Getbegyx (Win, Y'Access, X'Access);
+ Y : C_Short := W_Get_Short (Win, Offset_begy);
+ X : C_Short := W_Get_Short (Win, Offset_begx);
begin
- if Err = Curses_Err then
- raise Curses_Exception;
- else
- Top_Left_Line := Line_Position (Y);
- Top_Left_Column := Column_Position (X);
- end if;
+ Top_Left_Line := Line_Position (Y);
+ Top_Left_Column := Column_Position (X);
end Get_Window_Position;
procedure Get_Cursor_Position
Line : out Line_Position;
Column : out Column_Position)
is
- type Int_Access is access all C_Int;
- function Getyx (W : Window; Y, X : Int_Access) return C_Int;
- pragma Import (C, Getyx, "_nc_ada_getyx");
-
- Y, X : aliased C_Int;
- Err : constant C_Int := Getyx (Win, Y'Access, X'Access);
+ Y : C_Short := W_Get_Short (Win, Offset_cury);
+ X : C_Short := W_Get_Short (Win, Offset_curx);
begin
- if Err = Curses_Err then
- raise Curses_Exception;
- else
- Line := Line_Position (Y);
- Column := Column_Position (X);
- end if;
+ Line := Line_Position (Y);
+ Column := Column_Position (X);
end Get_Cursor_Position;
procedure Get_Origin_Relative_To_Parent
Top_Left_Column : out Column_Position;
Is_Not_A_Subwindow : out Boolean)
is
- type Int_Access is access all C_Int;
- function Getparyx (W : Window; Y, X : Int_Access) return C_Int;
- pragma Import (C, Getparyx, "_nc_ada_getparyx");
-
- Y, X : aliased C_Int;
- Err : constant C_Int := Getparyx (Win, Y'Access, X'Access);
+ Y : C_Int := W_Get_Int (Win, Offset_pary);
+ X : C_Int := W_Get_Int (Win, Offset_parx);
begin
- if Err = Curses_Err then
- raise Curses_Exception;
+ if Y = -1 then
+ Top_Left_Line := Line_Position'Last;
+ Top_Left_Column := Column_Position'Last;
+ Is_Not_A_Subwindow := True;
else
- if Y = -1 then
- Top_Left_Line := Line_Position'Last;
- Top_Left_Column := Column_Position'Last;
- Is_Not_A_Subwindow := True;
- else
- Top_Left_Line := Line_Position (Y);
- Top_Left_Column := Column_Position (X);
- Is_Not_A_Subwindow := False;
- end if;
+ Top_Left_Line := Line_Position (Y);
+ Top_Left_Column := Column_Position (X);
+ Is_Not_A_Subwindow := False;
end if;
end Get_Origin_Relative_To_Parent;
------------------------------------------------------------------------------
(Pad : in Window;
Ch : in Attributed_Character)
is
- function Pechochar (Pad : Window; Ch : C_Int)
+ function Pechochar (Pad : Window; Ch : C_Chtype)
return C_Int;
pragma Import (C, Pechochar, "pechochar");
begin
- if Pechochar (Pad, Chtype_To_CInt (Ch)) = Curses_Err then
+ if Pechochar (Pad, AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Add_Character_To_Pad_And_Echo_It;
function Peek (Win : Window := Standard_Window)
return Attributed_Character
is
- function Winch (Win : Window) return C_Int;
+ function Winch (Win : Window) return C_Chtype;
pragma Import (C, Winch, "winch");
begin
- return CInt_To_Chtype (Winch (Win));
+ return Chtype_To_AttrChar (Winch (Win));
end Peek;
function Peek
is
function Mvwinch (Win : Window;
Lin : C_Int;
- Col : C_Int) return C_Int;
+ Col : C_Int) return C_Chtype;
pragma Import (C, Mvwinch, "mvwinch");
begin
- return CInt_To_Chtype (Mvwinch (Win, C_Int (Line), C_Int (Column)));
+ return Chtype_To_AttrChar (Mvwinch (Win, C_Int (Line), C_Int (Column)));
end Peek;
------------------------------------------------------------------------------
procedure Insert (Win : in Window := Standard_Window;
Ch : in Attributed_Character)
is
- function Winsch (Win : Window; Ch : C_Int) return C_Int;
+ function Winsch (Win : Window; Ch : C_Chtype) return C_Int;
pragma Import (C, Winsch, "winsch");
begin
- if Winsch (Win, Chtype_To_CInt (Ch)) = Curses_Err then
+ if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Insert;
function Mvwinsch (Win : Window;
Lin : C_Int;
Col : C_Int;
- Ch : C_Int) return C_Int;
+ Ch : C_Chtype) return C_Int;
pragma Import (C, Mvwinsch, "mvwinsch");
begin
if Mvwinsch (Win,
C_Int (Line),
C_Int (Column),
- Chtype_To_CInt (Ch)) = Curses_Err then
+ AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Insert;
Str : in String;
Len : in Integer := -1)
is
- type Char_Ptr is access all Interfaces.C.Char;
+ type Char_Ptr is access all Interfaces.C.char;
function Winsnstr (Win : Window;
Str : Char_Ptr;
Len : Integer := -1) return C_Int;
Str : in String;
Len : in Integer := -1)
is
- type Char_Ptr is access all Interfaces.C.Char;
+ type Char_Ptr is access all Interfaces.C.char;
function Mvwinsnstr (Win : Window;
Line : C_Int;
Column : C_Int;
Text : in String;
Fmt : in Label_Justification := Left)
is
- type Char_Ptr is access all Interfaces.C.Char;
+ type Char_Ptr is access all Interfaces.C.char;
function Slk_Set (Label : C_Int;
Txt : Char_Ptr;
Fmt : C_Int) return C_Int;
(Attr : in Character_Attribute_Set;
On : in Boolean := True)
is
- function Slk_Attron (Ch : C_Int) return C_Int;
+ function Slk_Attron (Ch : C_Chtype) return C_Int;
pragma Import (C, Slk_Attron, "slk_attron");
- function Slk_Attroff (Ch : C_Int) return C_Int;
+ function Slk_Attroff (Ch : C_Chtype) return C_Int;
pragma Import (C, Slk_Attroff, "slk_attroff");
Err : C_Int;
Color => Color_Pair'First);
begin
if On then
- Err := Slk_Attron (Chtype_To_CInt (Ch));
+ Err := Slk_Attron (AttrChar_To_Chtype (Ch));
else
- Err := Slk_Attroff (Chtype_To_CInt (Ch));
+ Err := Slk_Attroff (AttrChar_To_Chtype (Ch));
end if;
if Err = Curses_Err then
raise Curses_Exception;
(Attr : in Character_Attribute_Set := Normal_Video;
Color : in Color_Pair := Color_Pair'First)
is
- function Slk_Attrset (Ch : C_Int) return C_Int;
+ function Slk_Attrset (Ch : C_Chtype) return C_Int;
pragma Import (C, Slk_Attrset, "slk_attrset");
Ch : constant Attributed_Character := (Ch => Character'First,
Attr => Attr,
Color => Color);
begin
- if Slk_Attrset (Chtype_To_CInt (Ch)) = Curses_Err then
+ if Slk_Attrset (AttrChar_To_Chtype (Ch)) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Soft_Label_Key_Attributes;
function Get_Soft_Label_Key_Attributes return Character_Attribute_Set
is
- function Slk_Attr return C_Int;
+ function Slk_Attr return C_Chtype;
pragma Import (C, Slk_Attr, "slk_attr");
- Attr : constant C_Int := Slk_Attr;
+ Attr : constant C_Chtype := Slk_Attr;
begin
- return CInt_To_Chtype (Attr).Attr;
+ return Chtype_To_AttrChar (Attr).Attr;
end Get_Soft_Label_Key_Attributes;
function Get_Soft_Label_Key_Attributes return Color_Pair
is
- function Slk_Attr return C_Int;
+ function Slk_Attr return C_Chtype;
pragma Import (C, Slk_Attr, "slk_attr");
- Attr : constant C_Int := Slk_Attr;
+ Attr : constant C_Chtype := Slk_Attr;
begin
- return CInt_To_Chtype (Attr).Color;
+ return Chtype_To_AttrChar (Attr).Color;
end Get_Soft_Label_Key_Attributes;
+
+ procedure Set_Soft_Label_Key_Color (Pair : in Color_Pair)
+ is
+ function Slk_Color (Color : in C_Short) return C_Int;
+ pragma Import (C, Slk_Color, "slk_color");
+ begin
+ if Slk_Color (C_Short (Pair)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Set_Soft_Label_Key_Color;
+
------------------------------------------------------------------------------
procedure Enable_Key (Key : in Special_Key_Code;
Enable : in Boolean := True)
is
function Keyok (Keycode : C_Int;
- On_Off : C_Int) return C_Int;
+ On_Off : Curses_Bool) return C_Int;
pragma Import (C, Keyok, "keyok");
begin
- if Keyok (C_Int (Key), Boolean'Pos (Enable)) = Curses_Err then
+ if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable)))
+ = Curses_Err then
raise Curses_Exception;
end if;
end Enable_Key;
procedure Define_Key (Definition : in String;
Key : in Special_Key_Code)
is
- type Char_Ptr is access all Interfaces.C.Char;
+ type Char_Ptr is access all Interfaces.C.char;
function Defkey (Def : Char_Ptr;
Key : C_Int) return C_Int;
pragma Import (C, Defkey, "define_key");
procedure Un_Control (Ch : in Attributed_Character;
Str : out String)
is
- function Unctrl (Ch : C_Int) return chars_ptr;
+ function Unctrl (Ch : C_Chtype) return chars_ptr;
pragma Import (C, Unctrl, "unctrl");
begin
- Fill_String (Unctrl (Chtype_To_CInt (Ch)), Str);
+ Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str);
end Un_Control;
function Un_Control (Ch : in Attributed_Character) return String
is
- function Unctrl (Ch : C_Int) return chars_ptr;
+ function Unctrl (Ch : C_Chtype) return chars_ptr;
pragma Import (C, Unctrl, "unctrl");
begin
- return Fill_String (Unctrl (Chtype_To_CInt (Ch)));
+ return Fill_String (Unctrl (AttrChar_To_Chtype (Ch)));
end Un_Control;
procedure Delay_Output (Msecs : in Natural)
function Has_Insert_Character return Boolean
is
- function Has_Ic return C_Int;
+ function Has_Ic return Curses_Bool;
pragma Import (C, Has_Ic, "has_ic");
begin
- if Has_Ic = Curses_False then
+ if Has_Ic = Curses_Bool_False then
return False;
else
return True;
function Has_Insert_Line return Boolean
is
- function Has_Il return C_Int;
+ function Has_Il return Curses_Bool;
pragma Import (C, Has_Il, "has_il");
begin
- if Has_Il = Curses_False then
+ if Has_Il = Curses_Bool_False then
return False;
else
return True;
function Supported_Attributes return Character_Attribute_Set
is
- function Termattrs return C_Int;
+ function Termattrs return C_Chtype;
pragma Import (C, Termattrs, "termattrs");
- Ch : constant Attributed_Character := CInt_To_Chtype (Termattrs);
+ Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs);
begin
return Ch.Attr;
end Supported_Attributes;
function Has_Colors return Boolean
is
- function Hascolors return C_Int;
+ function Hascolors return Curses_Bool;
pragma Import (C, Hascolors, "has_colors");
begin
- if Hascolors = Curses_False then
+ if Hascolors = Curses_Bool_False then
return False;
else
return True;
function Can_Change_Color return Boolean
is
- function Canchangecolor return C_Int;
+ function Canchangecolor return Curses_Bool;
pragma Import (C, Canchangecolor, "can_change_color");
begin
- if Canchangecolor = Curses_False then
+ if Canchangecolor = Curses_Bool_False then
return False;
else
return True;
type Int_Access is access all C_Int;
function Transform (W : Window;
Y, X : Int_Access;
- Dir : C_Int) return C_Int;
- pragma Import (C, Transform, "_nc_ada_coord_transform");
+ Dir : Curses_Bool) return C_Int;
+ pragma Import (C, Transform, "wmouse_trafo");
X : aliased C_Int := C_Int (Column);
Y : aliased C_Int := C_Int (Line);
- D : C_Int := 0;
+ D : Curses_Bool := Curses_Bool_False;
R : C_Int;
begin
if Dir = To_Screen then
projects / ncurses.git / blobdiff