-- B O D Y --
-- --
------------------------------------------------------------------------------
--- Copyright (c) 1998 Free Software Foundation, Inc. --
+-- Copyright (c) 1998-2006,2007 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 --
-- sale, use or other dealings in this Software without prior written --
-- authorization. --
------------------------------------------------------------------------------
--- Author: Juergen Pfeifer <juergen.pfeifer@gmx.net> 1996
+-- Author: Juergen Pfeifer, 1996
-- Version Control:
--- $Revision: 1.26 $
+-- $Revision: 1.35 $
+-- $Date: 2007/03/24 23:03:56 $
-- Binding Version 01.00
------------------------------------------------------------------------------
with System;
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 Dupwin (Win : Window) return Window;
pragma Import (C, Dupwin, "dupwin");
- W : Window := Dupwin (Win);
+ W : constant Window := Dupwin (Win);
begin
if W = Null_Window then
raise Curses_Exception;
Str : in String;
Len : in Integer := -1)
is
- type Char_Ptr is access all Interfaces.C.char;
function Waddnstr (Win : Window;
- Str : Char_Ptr;
+ Str : char_array;
Len : C_Int := -1) return C_Int;
pragma Import (C, Waddnstr, "waddnstr");
Length : size_t;
begin
To_C (Str, Txt, Length);
- if Waddnstr (Win, Txt (Txt'First)'Access, C_Int (Len)) = Curses_Err then
+ if Waddnstr (Win, Txt, C_Int (Len)) = Curses_Err then
raise Curses_Exception;
end if;
end Add;
Str : in Attributed_String;
Len : in Integer := -1)
is
- type Chtype_Ptr is access all Attributed_Character;
function Waddchnstr (Win : Window;
- Str : Chtype_Ptr;
+ Str : chtype_array;
Len : C_Int := -1) return C_Int;
pragma Import (C, Waddchnstr, "waddchnstr");
end loop;
Txt (Str'Length) := Default_Character;
if Waddchnstr (Win,
- Txt (Txt'First)'Access,
+ Txt,
C_Int (Len)) = Curses_Err then
raise Curses_Exception;
end if;
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;
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;
procedure No_Qiflush;
pragma Import (C, No_Qiflush, "noqiflush");
begin
+ if Win = Null_Window then
+ raise Curses_Exception;
+ end if;
if Flush then
Qiflush;
else
end if;
end Allow_Scrolling;
- function Scrolling_Allowed (Win : Window := Standard_Window) return Boolean
+ function Scrolling_Allowed (Win : Window := Standard_Window)
+ return Boolean
is
- 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 0 => return False;
- when others => return True;
- end case;
+ return Get_Flag (Win, Offset_scroll);
end Scrolling_Allowed;
procedure Set_Scroll_Region
end Insert_Line;
------------------------------------------------------------------------------
-
procedure Get_Size
(Win : in Window := Standard_Window;
Number_Of_Lines : out Line_Count;
Number_Of_Columns : out Column_Count)
is
- -- 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);
+ function GetMaxY (W : Window) return C_Int;
+ pragma Import (C, GetMaxY, "getmaxy");
+
+ function GetMaxX (W : Window) return C_Int;
+ pragma Import (C, GetMaxX, "getmaxx");
+
+ Y : constant C_Int := GetMaxY (Win)
+ + C_Int (Offset_XY);
+ X : constant C_Int := GetMaxX (Win)
+ + C_Int (Offset_XY);
begin
Number_Of_Lines := Line_Count (Y);
Number_Of_Columns := Column_Count (X);
Top_Left_Line : out Line_Position;
Top_Left_Column : out Column_Position)
is
- Y : C_Short := W_Get_Short (Win, Offset_begy);
- X : C_Short := W_Get_Short (Win, Offset_begx);
+ function GetBegY (W : Window) return C_Int;
+ pragma Import (C, GetBegY, "getbegy");
+
+ function GetBegX (W : Window) return C_Int;
+ pragma Import (C, GetBegX, "getbegx");
+
+ Y : constant C_Short := C_Short (GetBegY (Win));
+ X : constant C_Short := C_Short (GetBegX (Win));
begin
Top_Left_Line := Line_Position (Y);
Top_Left_Column := Column_Position (X);
Line : out Line_Position;
Column : out Column_Position)
is
- Y : C_Short := W_Get_Short (Win, Offset_cury);
- X : C_Short := W_Get_Short (Win, Offset_curx);
+ function GetCurY (W : Window) return C_Int;
+ pragma Import (C, GetCurY, "getcury");
+
+ function GetCurX (W : Window) return C_Int;
+ pragma Import (C, GetCurX, "getcurx");
+
+ Y : constant C_Short := C_Short (GetCurY (Win));
+ X : constant C_Short := C_Short (GetCurX (Win));
begin
Line := Line_Position (Y);
Column := Column_Position (X);
Top_Left_Column : out Column_Position;
Is_Not_A_Subwindow : out Boolean)
is
- Y : C_Int := W_Get_Int (Win, Offset_pary);
- X : C_Int := W_Get_Int (Win, Offset_parx);
+ function GetParY (W : Window) return C_Int;
+ pragma Import (C, GetParY, "getpary");
+
+ function GetParX (W : Window) return C_Int;
+ pragma Import (C, GetParX, "getparx");
+
+ Y : constant C_Int := GetParY (Win);
+ X : constant C_Int := GetParX (Win);
begin
if Y = -1 then
Top_Left_Line := Line_Position'Last;
Str : in String;
Len : in Integer := -1)
is
- type Char_Ptr is access all Interfaces.C.char;
function Winsnstr (Win : Window;
- Str : Char_Ptr;
+ Str : char_array;
Len : Integer := -1) return C_Int;
pragma Import (C, Winsnstr, "winsnstr");
Length : size_t;
begin
To_C (Str, Txt, Length);
- if Winsnstr (Win, Txt (Txt'First)'Access, Len) = Curses_Err then
+ if Winsnstr (Win, Txt, Len) = 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;
function Mvwinsnstr (Win : Window;
Line : C_Int;
Column : C_Int;
- Str : Char_Ptr;
+ Str : char_array;
Len : C_Int) return C_Int;
pragma Import (C, Mvwinsnstr, "mvwinsnstr");
Length : size_t;
begin
To_C (Str, Txt, Length);
- if Mvwinsnstr (Win, C_Int (Line), C_Int (Column),
- Txt (Txt'First)'Access, C_Int (Len))
+ if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len))
= Curses_Err then
raise Curses_Exception;
end if;
Str : out Attributed_String;
Len : in Integer := -1)
is
- type Chtype_Ptr is access all Attributed_Character;
function Winchnstr (Win : Window;
- Str : Chtype_Ptr;
+ Str : chtype_array; -- out
Len : C_Int) return C_Int;
pragma Import (C, Winchnstr, "winchnstr");
N : Integer := Len;
- Txt : chtype_array (0 .. Str'Length);
+ Txt : constant chtype_array (0 .. Str'Length)
+ := (0 => Default_Character);
Cnt : Natural := 0;
begin
if N < 0 then
if N > Str'Length then
raise Constraint_Error;
end if;
- if Winchnstr (Win, Txt (Txt'First)'Access, C_Int (N)) = Curses_Err then
+ if Winchnstr (Win, Txt, C_Int (N)) = Curses_Err then
raise Curses_Exception;
end if;
for To in Str'Range loop
Text : in String;
Fmt : in Label_Justification := Left)
is
- type Char_Ptr is access all Interfaces.C.char;
function Slk_Set (Label : C_Int;
- Txt : Char_Ptr;
+ Txt : char_array;
Fmt : C_Int) return C_Int;
pragma Import (C, Slk_Set, "slk_set");
Len : size_t;
begin
To_C (Text, Txt, Len);
- if Slk_Set (C_Int (Label),
- Txt (Txt'First)'Access,
- C_Int (Label_Justification'Pos (Fmt)))
- = Curses_Err then
+ if Slk_Set (C_Int (Label), Txt,
+ C_Int (Label_Justification'Pos (Fmt))) = Curses_Err then
raise Curses_Exception;
end if;
end Set_Soft_Label_Key;
procedure Define_Key (Definition : in String;
Key : in Special_Key_Code)
is
- type Char_Ptr is access all Interfaces.C.char;
- function Defkey (Def : Char_Ptr;
+ function Defkey (Def : char_array;
Key : C_Int) return C_Int;
pragma Import (C, Defkey, "define_key");
Length : size_t;
begin
To_C (Definition, Txt, Length);
- if Defkey (Txt (Txt'First)'Access, C_Int (Key)) = Curses_Err then
+ if Defkey (Txt, C_Int (Key)) = Curses_Err then
raise Curses_Exception;
end if;
end Define_Key;
Column := Column_Position (X);
end if;
end Transform_Coordinates;
+------------------------------------------------------------------------------
+ procedure Use_Default_Colors is
+ function C_Use_Default_Colors return C_Int;
+ pragma Import (C, C_Use_Default_Colors, "use_default_colors");
+ Err : constant C_Int := C_Use_Default_Colors;
+ begin
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Use_Default_Colors;
+
+ procedure Assume_Default_Colors (Fore : Color_Number := Default_Color;
+ Back : Color_Number := Default_Color)
+ is
+ function C_Assume_Default_Colors (Fore : C_Int;
+ Back : C_Int) return C_Int;
+ pragma Import (C, C_Assume_Default_Colors, "assume_default_colors");
+
+ Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore),
+ C_Int (Back));
+ begin
+ if Err = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Assume_Default_Colors;
+------------------------------------------------------------------------------
+ function Curses_Version return String
+ is
+ function curses_versionC return chars_ptr;
+ pragma Import (C, curses_versionC, "curses_version");
+ Result : constant chars_ptr := curses_versionC;
+ begin
+ return Fill_String (Result);
+ end Curses_Version;
+------------------------------------------------------------------------------
+ function Use_Extended_Names (Enable : Boolean) return Boolean
+ is
+ function use_extended_namesC (e : Curses_Bool) return C_Int;
+ pragma Import (C, use_extended_namesC, "use_extended_names");
+
+ Res : constant C_Int :=
+ use_extended_namesC (Curses_Bool (Boolean'Pos (Enable)));
+ begin
+ if Res = C_Int (Curses_Bool_False) then
+ return False;
+ else
+ return True;
+ end if;
+ end Use_Extended_Names;
+------------------------------------------------------------------------------
+ procedure Screen_Dump_To_File (Filename : in String)
+ is
+ function scr_dump (f : char_array) return C_Int;
+ pragma Import (C, scr_dump, "scr_dump");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_dump (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Dump_To_File;
+
+ procedure Screen_Restore_From_File (Filename : in String)
+ is
+ function scr_restore (f : char_array) return C_Int;
+ pragma Import (C, scr_restore, "scr_restore");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_restore (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Restore_From_File;
+
+ procedure Screen_Init_From_File (Filename : in String)
+ is
+ function scr_init (f : char_array) return C_Int;
+ pragma Import (C, scr_init, "scr_init");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_init (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Init_From_File;
+
+ procedure Screen_Set_File (Filename : in String)
+ is
+ function scr_set (f : char_array) return C_Int;
+ pragma Import (C, scr_set, "scr_set");
+ Txt : char_array (0 .. Filename'Length);
+ Length : size_t;
+ begin
+ To_C (Filename, Txt, Length);
+ if Curses_Err = scr_set (Txt) then
+ raise Curses_Exception;
+ end if;
+ end Screen_Set_File;
+------------------------------------------------------------------------------
+ procedure Resize (Win : Window := Standard_Window;
+ Number_Of_Lines : Line_Count;
+ Number_Of_Columns : Column_Count) is
+ function wresize (win : Window;
+ lines : C_Int;
+ columns : C_Int) return C_Int;
+ pragma Import (C, wresize);
+ begin
+ if wresize (Win,
+ C_Int (Number_Of_Lines),
+ C_Int (Number_Of_Columns)) = Curses_Err then
+ raise Curses_Exception;
+ end if;
+ end Resize;
+------------------------------------------------------------------------------
end Terminal_Interface.Curses;
projects / ncurses.git / blobdiff