X-Git-Url: http://ncurses.scripts.mit.edu/?p=ncurses.git;a=blobdiff_plain;f=doc%2Fhtml%2Fada%2Fterminal_interface-curses__adb.htm;h=272b0036e85ed5060efc218f6af8fed447042714;hp=448eea42dee78178434490f9de09b151e4663e66;hb=2b635f090ec43c82958cef9369464aee4dd8975f;hpb=9776951416d7fb862b9dca1f4c9f8031a5c9059b diff --git a/doc/html/ada/terminal_interface-curses__adb.htm b/doc/html/ada/terminal_interface-curses__adb.htm index 448eea42..272b0036 100644 --- a/doc/html/ada/terminal_interface-curses__adb.htm +++ b/doc/html/ada/terminal_interface-curses__adb.htm @@ -40,8 +40,8 @@ ------------------------------------------------------------------------------ -- Author: Juergen Pfeifer, 1996 -- Version Control: --- @Revision: 1.7 @ --- @Date: 2011/03/19 16:17:19 @ +-- @Revision: 1.8 @ +-- @Date: 2011/03/22 23:02:14 @ -- Binding Version 01.00 ------------------------------------------------------------------------------ with System; @@ -1211,76 +1211,78 @@ X : Column_Position; begin Get_Size (Win, Y, X); + pragma Unreferenced (X); Change_Lines_Status (Win, 0, Positive (Y), True); end Touch; - procedure Untouch (Win : Window := Standard_Window) + procedure Untouch (Win : Window := Standard_Window) is - Y : Line_Position; - X : Column_Position; + Y : Line_Position; + X : Column_Position; begin - Get_Size (Win, Y, X); - Change_Lines_Status (Win, 0, Positive (Y), False); + Get_Size (Win, Y, X); + pragma Unreferenced (X); + Change_Lines_Status (Win, 0, Positive (Y), False); end Untouch; - procedure Touch (Win : Window := Standard_Window; - Start : Line_Position; - Count : Positive) + procedure Touch (Win : Window := Standard_Window; + Start : Line_Position; + Count : Positive) is begin Change_Lines_Status (Win, Start, Count, True); end Touch; - function Is_Touched - (Win : Window := Standard_Window; - Line : Line_Position) return Boolean + function Is_Touched + (Win : Window := Standard_Window; + Line : Line_Position) return Boolean is - function WLineTouched (W : Window; L : C_Int) return Curses_Bool; + function WLineTouched (W : Window; L : C_Int) return Curses_Bool; pragma Import (C, WLineTouched, "is_linetouched"); begin - if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then + if WLineTouched (Win, C_Int (Line)) = Curses_Bool_False then return False; else return True; end if; end Is_Touched; - function Is_Touched - (Win : Window := Standard_Window) return Boolean + function Is_Touched + (Win : Window := Standard_Window) return Boolean is - function WWinTouched (W : Window) return Curses_Bool; + function WWinTouched (W : Window) return Curses_Bool; pragma Import (C, WWinTouched, "is_wintouched"); begin - if WWinTouched (Win) = Curses_Bool_False then + if WWinTouched (Win) = Curses_Bool_False then return False; else return True; end if; end Is_Touched; ------------------------------------------------------------------------------ - procedure Copy - (Source_Window : Window; - Destination_Window : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position; - Non_Destructive_Mode : Boolean := True) - is - function Copywin (Src : Window; - Dst : Window; - Str : C_Int; - Slc : C_Int; - Dtr : C_Int; - Dlc : C_Int; - Dbr : C_Int; - Drc : C_Int; - Ndm : C_Int) return C_Int; + procedure Copy + (Source_Window : Window; + Destination_Window : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position; + Non_Destructive_Mode : Boolean := True) + is + function Copywin (Src : Window; + Dst : Window; + Str : C_Int; + Slc : C_Int; + Dtr : C_Int; + Dlc : C_Int; + Dbr : C_Int; + Drc : C_Int; + Ndm : C_Int) return C_Int; pragma Import (C, Copywin, "copywin"); begin - if Copywin (Source_Window, + if Copywin (Source_Window, Destination_Window, C_Int (Source_Top_Row), C_Int (Source_Left_Column), @@ -1294,199 +1296,199 @@ end if; end Copy; - procedure Overwrite - (Source_Window : Window; - Destination_Window : Window) + procedure Overwrite + (Source_Window : Window; + Destination_Window : Window) is - function Overwrite (Src : Window; Dst : Window) return C_Int; + function Overwrite (Src : Window; Dst : Window) return C_Int; pragma Import (C, Overwrite, "overwrite"); begin - if Overwrite (Source_Window, Destination_Window) = Curses_Err then + if Overwrite (Source_Window, Destination_Window) = Curses_Err then raise Curses_Exception; end if; end Overwrite; - procedure Overlay - (Source_Window : Window; - Destination_Window : Window) + procedure Overlay + (Source_Window : Window; + Destination_Window : Window) is - function Overlay (Src : Window; Dst : Window) return C_Int; + function Overlay (Src : Window; Dst : Window) return C_Int; pragma Import (C, Overlay, "overlay"); begin - if Overlay (Source_Window, Destination_Window) = Curses_Err then + if Overlay (Source_Window, Destination_Window) = Curses_Err then raise Curses_Exception; end if; end Overlay; ------------------------------------------------------------------------------ - procedure Insert_Delete_Lines - (Win : Window := Standard_Window; - Lines : Integer := 1) -- default is to insert one line above + procedure Insert_Delete_Lines + (Win : Window := Standard_Window; + Lines : Integer := 1) -- default is to insert one line above is - function Winsdelln (W : Window; N : C_Int) return C_Int; + function Winsdelln (W : Window; N : C_Int) return C_Int; pragma Import (C, Winsdelln, "winsdelln"); begin - if Winsdelln (Win, C_Int (Lines)) = Curses_Err then + if Winsdelln (Win, C_Int (Lines)) = Curses_Err then raise Curses_Exception; end if; end Insert_Delete_Lines; - procedure Delete_Line (Win : Window := Standard_Window) + procedure Delete_Line (Win : Window := Standard_Window) is begin Insert_Delete_Lines (Win, -1); end Delete_Line; - procedure Insert_Line (Win : Window := Standard_Window) + procedure Insert_Line (Win : Window := Standard_Window) is begin Insert_Delete_Lines (Win, 1); end Insert_Line; ------------------------------------------------------------------------------ - procedure Get_Size - (Win : Window := Standard_Window; - Number_Of_Lines : out Line_Count; - Number_Of_Columns : out Column_Count) + procedure Get_Size + (Win : Window := Standard_Window; + Number_Of_Lines : out Line_Count; + Number_Of_Columns : out Column_Count) is - function GetMaxY (W : Window) return C_Int; + function GetMaxY (W : Window) return C_Int; pragma Import (C, GetMaxY, "getmaxy"); - function GetMaxX (W : Window) return C_Int; + function GetMaxX (W : Window) return C_Int; pragma Import (C, GetMaxX, "getmaxx"); - Y : constant C_Int := GetMaxY (Win); - X : constant C_Int := GetMaxX (Win); + Y : constant C_Int := GetMaxY (Win); + X : constant C_Int := GetMaxX (Win); begin - Number_Of_Lines := Line_Count (Y); - Number_Of_Columns := Column_Count (X); + Number_Of_Lines := Line_Count (Y); + Number_Of_Columns := Column_Count (X); end Get_Size; - procedure Get_Window_Position - (Win : Window := Standard_Window; - Top_Left_Line : out Line_Position; - Top_Left_Column : out Column_Position) + procedure Get_Window_Position + (Win : Window := Standard_Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position) is - function GetBegY (W : Window) return C_Int; + function GetBegY (W : Window) return C_Int; pragma Import (C, GetBegY, "getbegy"); - function GetBegX (W : Window) return C_Int; + 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)); + 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); + Top_Left_Line := Line_Position (Y); + Top_Left_Column := Column_Position (X); end Get_Window_Position; - procedure Get_Cursor_Position - (Win : Window := Standard_Window; - Line : out Line_Position; - Column : out Column_Position) + procedure Get_Cursor_Position + (Win : Window := Standard_Window; + Line : out Line_Position; + Column : out Column_Position) is - function GetCurY (W : Window) return C_Int; + function GetCurY (W : Window) return C_Int; pragma Import (C, GetCurY, "getcury"); - function GetCurX (W : Window) return C_Int; + 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)); + 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); + Line := Line_Position (Y); + Column := Column_Position (X); end Get_Cursor_Position; - procedure Get_Origin_Relative_To_Parent - (Win : Window; - Top_Left_Line : out Line_Position; - Top_Left_Column : out Column_Position; - Is_Not_A_Subwindow : out Boolean) + procedure Get_Origin_Relative_To_Parent + (Win : Window; + Top_Left_Line : out Line_Position; + Top_Left_Column : out Column_Position; + Is_Not_A_Subwindow : out Boolean) is - function GetParY (W : Window) return C_Int; + function GetParY (W : Window) return C_Int; pragma Import (C, GetParY, "getpary"); - function GetParX (W : Window) return C_Int; + function GetParX (W : Window) return C_Int; pragma Import (C, GetParX, "getparx"); - Y : constant C_Int := GetParY (Win); - X : constant C_Int := GetParX (Win); + Y : constant C_Int := GetParY (Win); + X : constant C_Int := GetParX (Win); begin - if Y = -1 then + 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); + 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; ------------------------------------------------------------------------------ - function New_Pad (Lines : Line_Count; - Columns : Column_Count) return Window + function New_Pad (Lines : Line_Count; + Columns : Column_Count) return Window is - function Newpad (Lines : C_Int; Columns : C_Int) return Window; + function Newpad (Lines : C_Int; Columns : C_Int) return Window; pragma Import (C, Newpad, "newpad"); - W : Window; + W : Window; begin - W := Newpad (C_Int (Lines), C_Int (Columns)); - if W = Null_Window then + W := Newpad (C_Int (Lines), C_Int (Columns)); + if W = Null_Window then raise Curses_Exception; end if; - return W; + return W; end New_Pad; - function Sub_Pad - (Pad : 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 Subpad - (Pad : Window; - Number_Of_Lines : C_Int; - Number_Of_Columns : C_Int; - First_Line_Position : C_Int; - First_Column_Position : C_Int) return Window; + function Sub_Pad + (Pad : 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 Subpad + (Pad : 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, Subpad, "subpad"); - W : Window; + W : Window; begin - W := Subpad (Pad, + W := Subpad (Pad, 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 + if W = Null_Window then raise Curses_Exception; end if; - return W; + return W; end Sub_Pad; - procedure Refresh - (Pad : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position) - is - function Prefresh - (Pad : Window; - Source_Top_Row : C_Int; - Source_Left_Column : C_Int; - Destination_Top_Row : C_Int; - Destination_Left_Column : C_Int; - Destination_Bottom_Row : C_Int; - Destination_Right_Column : C_Int) return C_Int; + procedure Refresh + (Pad : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position) + is + function Prefresh + (Pad : Window; + Source_Top_Row : C_Int; + Source_Left_Column : C_Int; + Destination_Top_Row : C_Int; + Destination_Left_Column : C_Int; + Destination_Bottom_Row : C_Int; + Destination_Right_Column : C_Int) return C_Int; pragma Import (C, Prefresh, "prefresh"); begin - if Prefresh (Pad, + if Prefresh (Pad, C_Int (Source_Top_Row), C_Int (Source_Left_Column), C_Int (Destination_Top_Row), @@ -1497,26 +1499,26 @@ end if; end Refresh; - procedure Refresh_Without_Update - (Pad : Window; - Source_Top_Row : Line_Position; - Source_Left_Column : Column_Position; - Destination_Top_Row : Line_Position; - Destination_Left_Column : Column_Position; - Destination_Bottom_Row : Line_Position; - Destination_Right_Column : Column_Position) - is - function Pnoutrefresh - (Pad : Window; - Source_Top_Row : C_Int; - Source_Left_Column : C_Int; - Destination_Top_Row : C_Int; - Destination_Left_Column : C_Int; - Destination_Bottom_Row : C_Int; - Destination_Right_Column : C_Int) return C_Int; + procedure Refresh_Without_Update + (Pad : Window; + Source_Top_Row : Line_Position; + Source_Left_Column : Column_Position; + Destination_Top_Row : Line_Position; + Destination_Left_Column : Column_Position; + Destination_Bottom_Row : Line_Position; + Destination_Right_Column : Column_Position) + is + function Pnoutrefresh + (Pad : Window; + Source_Top_Row : C_Int; + Source_Left_Column : C_Int; + Destination_Top_Row : C_Int; + Destination_Left_Column : C_Int; + Destination_Bottom_Row : C_Int; + Destination_Right_Column : C_Int) return C_Int; pragma Import (C, Pnoutrefresh, "pnoutrefresh"); begin - if Pnoutrefresh (Pad, + if Pnoutrefresh (Pad, C_Int (Source_Top_Row), C_Int (Source_Left_Column), C_Int (Destination_Top_Row), @@ -1527,22 +1529,22 @@ end if; end Refresh_Without_Update; - procedure Add_Character_To_Pad_And_Echo_It - (Pad : Window; - Ch : Attributed_Character) + procedure Add_Character_To_Pad_And_Echo_It + (Pad : Window; + Ch : Attributed_Character) is - function Pechochar (Pad : Window; Ch : C_Chtype) + function Pechochar (Pad : Window; Ch : C_Chtype) return C_Int; pragma Import (C, Pechochar, "pechochar"); begin - if Pechochar (Pad, AttrChar_To_Chtype (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; - procedure Add_Character_To_Pad_And_Echo_It - (Pad : Window; - Ch : Character) + procedure Add_Character_To_Pad_And_Echo_It + (Pad : Window; + Ch : Character) is begin Add_Character_To_Pad_And_Echo_It @@ -1552,90 +1554,90 @@ Attr => Normal_Video)); end Add_Character_To_Pad_And_Echo_It; ------------------------------------------------------------------------------ - procedure Scroll (Win : Window := Standard_Window; - Amount : Integer := 1) + procedure Scroll (Win : Window := Standard_Window; + Amount : Integer := 1) is - function Wscrl (Win : Window; N : C_Int) return C_Int; + function Wscrl (Win : Window; N : C_Int) return C_Int; pragma Import (C, Wscrl, "wscrl"); begin - if Wscrl (Win, C_Int (Amount)) = Curses_Err then + if Wscrl (Win, C_Int (Amount)) = Curses_Err then raise Curses_Exception; end if; end Scroll; ------------------------------------------------------------------------------ - procedure Delete_Character (Win : Window := Standard_Window) + procedure Delete_Character (Win : Window := Standard_Window) is - function Wdelch (Win : Window) return C_Int; + function Wdelch (Win : Window) return C_Int; pragma Import (C, Wdelch, "wdelch"); begin - if Wdelch (Win) = Curses_Err then + if Wdelch (Win) = Curses_Err then raise Curses_Exception; end if; end Delete_Character; - procedure Delete_Character - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position) + procedure Delete_Character + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position) is - function Mvwdelch (Win : Window; - Lin : C_Int; - Col : C_Int) return C_Int; + function Mvwdelch (Win : Window; + Lin : C_Int; + Col : C_Int) return C_Int; pragma Import (C, Mvwdelch, "mvwdelch"); begin - if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then + if Mvwdelch (Win, C_Int (Line), C_Int (Column)) = Curses_Err then raise Curses_Exception; end if; end Delete_Character; ------------------------------------------------------------------------------ - function Peek (Win : Window := Standard_Window) + function Peek (Win : Window := Standard_Window) return Attributed_Character is - function Winch (Win : Window) return C_Chtype; + function Winch (Win : Window) return C_Chtype; pragma Import (C, Winch, "winch"); begin - return Chtype_To_AttrChar (Winch (Win)); + return Chtype_To_AttrChar (Winch (Win)); end Peek; - function Peek - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position) return Attributed_Character + function Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position) return Attributed_Character is - function Mvwinch (Win : Window; - Lin : C_Int; - Col : C_Int) return C_Chtype; + function Mvwinch (Win : Window; + Lin : C_Int; + Col : C_Int) return C_Chtype; pragma Import (C, Mvwinch, "mvwinch"); begin - return Chtype_To_AttrChar (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 : Window := Standard_Window; - Ch : Attributed_Character) + procedure Insert (Win : Window := Standard_Window; + Ch : Attributed_Character) is - function Winsch (Win : Window; Ch : C_Chtype) return C_Int; + function Winsch (Win : Window; Ch : C_Chtype) return C_Int; pragma Import (C, Winsch, "winsch"); begin - if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then + if Winsch (Win, AttrChar_To_Chtype (Ch)) = Curses_Err then raise Curses_Exception; end if; end Insert; - procedure Insert - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Ch : Attributed_Character) + procedure Insert + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Ch : Attributed_Character) is - function Mvwinsch (Win : Window; - Lin : C_Int; - Col : C_Int; - Ch : C_Chtype) return C_Int; + function Mvwinsch (Win : Window; + Lin : C_Int; + Col : C_Int; + Ch : C_Chtype) return C_Int; pragma Import (C, Mvwinsch, "mvwinsch"); begin - if Mvwinsch (Win, + if Mvwinsch (Win, C_Int (Line), C_Int (Column), AttrChar_To_Chtype (Ch)) = Curses_Err then @@ -1643,510 +1645,510 @@ end if; end Insert; ------------------------------------------------------------------------------ - procedure Insert (Win : Window := Standard_Window; - Str : String; - Len : Integer := -1) + procedure Insert (Win : Window := Standard_Window; + Str : String; + Len : Integer := -1) is - function Winsnstr (Win : Window; - Str : char_array; - Len : Integer := -1) return C_Int; + function Winsnstr (Win : Window; + Str : char_array; + Len : Integer := -1) return C_Int; pragma Import (C, Winsnstr, "winsnstr"); - Txt : char_array (0 .. Str'Length); - Length : size_t; + Txt : char_array (0 .. Str'Length); + Length : size_t; begin - To_C (Str, Txt, Length); - if Winsnstr (Win, Txt, Len) = Curses_Err then + To_C (Str, Txt, Length); + if Winsnstr (Win, Txt, Len) = Curses_Err then raise Curses_Exception; end if; end Insert; - procedure Insert - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : String; - Len : Integer := -1) - is - function Mvwinsnstr (Win : Window; - Line : C_Int; - Column : C_Int; - Str : char_array; - Len : C_Int) return C_Int; + procedure Insert + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : String; + Len : Integer := -1) + is + function Mvwinsnstr (Win : Window; + Line : C_Int; + Column : C_Int; + Str : char_array; + Len : C_Int) return C_Int; pragma Import (C, Mvwinsnstr, "mvwinsnstr"); - Txt : char_array (0 .. Str'Length); - Length : size_t; + Txt : char_array (0 .. Str'Length); + Length : size_t; begin - To_C (Str, Txt, Length); - if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len)) + To_C (Str, Txt, Length); + if Mvwinsnstr (Win, C_Int (Line), C_Int (Column), Txt, C_Int (Len)) = Curses_Err then raise Curses_Exception; end if; end Insert; ------------------------------------------------------------------------------ - procedure Peek (Win : Window := Standard_Window; - Str : out String; - Len : Integer := -1) + procedure Peek (Win : Window := Standard_Window; + Str : out String; + Len : Integer := -1) is - function Winnstr (Win : Window; - Str : char_array; - Len : C_Int) return C_Int; + function Winnstr (Win : Window; + Str : char_array; + Len : C_Int) return C_Int; pragma Import (C, Winnstr, "winnstr"); - N : Integer := Len; - Txt : char_array (0 .. Str'Length); - Cnt : Natural; + N : Integer := Len; + Txt : char_array (0 .. Str'Length); + Cnt : Natural; begin - if N < 0 then - N := Str'Length; + if N < 0 then + N := Str'Length; end if; - if N > Str'Length then + if N > Str'Length then raise Constraint_Error; end if; - Txt (0) := Interfaces.C.char'First; - if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then + Txt (0) := Interfaces.C.char'First; + if Winnstr (Win, Txt, C_Int (N)) = Curses_Err then raise Curses_Exception; end if; - To_Ada (Txt, Str, Cnt, True); - if Cnt < Str'Length then - Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); + To_Ada (Txt, Str, Cnt, True); + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); end if; end Peek; - procedure Peek - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out String; - Len : Integer := -1) + procedure Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out String; + Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Peek (Win, Str, Len); end Peek; ------------------------------------------------------------------------------ - procedure Peek - (Win : Window := Standard_Window; - Str : out Attributed_String; - Len : Integer := -1) - is - function Winchnstr (Win : Window; - Str : chtype_array; -- out - Len : C_Int) return C_Int; + procedure Peek + (Win : Window := Standard_Window; + Str : out Attributed_String; + Len : Integer := -1) + is + function Winchnstr (Win : Window; + Str : chtype_array; -- out + Len : C_Int) return C_Int; pragma Import (C, Winchnstr, "winchnstr"); - N : Integer := Len; - Txt : constant chtype_array (0 .. Str'Length) + N : Integer := Len; + Txt : constant chtype_array (0 .. Str'Length) := (0 => Default_Character); - Cnt : Natural := 0; + Cnt : Natural := 0; begin - if N < 0 then - N := Str'Length; + if N < 0 then + N := Str'Length; end if; - if N > Str'Length then + if N > Str'Length then raise Constraint_Error; end if; - if Winchnstr (Win, Txt, 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 - exit when Txt (size_t (Cnt)) = Default_Character; - Str (To) := Txt (size_t (Cnt)); - Cnt := Cnt + 1; + for To in Str'Range loop + exit when Txt (size_t (Cnt)) = Default_Character; + Str (To) := Txt (size_t (Cnt)); + Cnt := Cnt + 1; end loop; - if Cnt < Str'Length then - Str ((Str'First + Cnt) .. Str'Last) := + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := (others => (Ch => ' ', Color => Color_Pair'First, Attr => Normal_Video)); end if; end Peek; - procedure Peek - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out Attributed_String; - Len : Integer := -1) + procedure Peek + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out Attributed_String; + Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Peek (Win, Str, Len); end Peek; ------------------------------------------------------------------------------ - procedure Get (Win : Window := Standard_Window; - Str : out String; - Len : Integer := -1) + procedure Get (Win : Window := Standard_Window; + Str : out String; + Len : Integer := -1) is - function Wgetnstr (Win : Window; - Str : char_array; - Len : C_Int) return C_Int; + function Wgetnstr (Win : Window; + Str : char_array; + Len : C_Int) return C_Int; pragma Import (C, Wgetnstr, "wgetnstr"); - N : Integer := Len; - Txt : char_array (0 .. Str'Length); - Cnt : Natural; + N : Integer := Len; + Txt : char_array (0 .. Str'Length); + Cnt : Natural; begin - if N < 0 then - N := Str'Length; + if N < 0 then + N := Str'Length; end if; - if N > Str'Length then + if N > Str'Length then raise Constraint_Error; end if; - Txt (0) := Interfaces.C.char'First; - if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then + Txt (0) := Interfaces.C.char'First; + if Wgetnstr (Win, Txt, C_Int (N)) = Curses_Err then raise Curses_Exception; end if; - To_Ada (Txt, Str, Cnt, True); - if Cnt < Str'Length then - Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); + To_Ada (Txt, Str, Cnt, True); + if Cnt < Str'Length then + Str ((Str'First + Cnt) .. Str'Last) := (others => ' '); end if; end Get; - procedure Get - (Win : Window := Standard_Window; - Line : Line_Position; - Column : Column_Position; - Str : out String; - Len : Integer := -1) + procedure Get + (Win : Window := Standard_Window; + Line : Line_Position; + Column : Column_Position; + Str : out String; + Len : Integer := -1) is begin Move_Cursor (Win, Line, Column); Get (Win, Str, Len); end Get; ------------------------------------------------------------------------------ - procedure Init_Soft_Label_Keys - (Format : Soft_Label_Key_Format := Three_Two_Three) + procedure Init_Soft_Label_Keys + (Format : Soft_Label_Key_Format := Three_Two_Three) is - function Slk_Init (Fmt : C_Int) return C_Int; + function Slk_Init (Fmt : C_Int) return C_Int; pragma Import (C, Slk_Init, "slk_init"); begin - if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then + if Slk_Init (Soft_Label_Key_Format'Pos (Format)) = Curses_Err then raise Curses_Exception; end if; end Init_Soft_Label_Keys; - procedure Set_Soft_Label_Key (Label : Label_Number; - Text : String; - Fmt : Label_Justification := Left) + procedure Set_Soft_Label_Key (Label : Label_Number; + Text : String; + Fmt : Label_Justification := Left) is - function Slk_Set (Label : C_Int; - Txt : char_array; - Fmt : C_Int) return C_Int; + function Slk_Set (Label : C_Int; + Txt : char_array; + Fmt : C_Int) return C_Int; pragma Import (C, Slk_Set, "slk_set"); - Txt : char_array (0 .. Text'Length); - Len : size_t; + Txt : char_array (0 .. Text'Length); + Len : size_t; begin - To_C (Text, Txt, Len); - if Slk_Set (C_Int (Label), Txt, + To_C (Text, Txt, Len); + 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 Refresh_Soft_Label_Keys + procedure Refresh_Soft_Label_Keys is - function Slk_Refresh return C_Int; + function Slk_Refresh return C_Int; pragma Import (C, Slk_Refresh, "slk_refresh"); begin - if Slk_Refresh = Curses_Err then + if Slk_Refresh = Curses_Err then raise Curses_Exception; end if; end Refresh_Soft_Label_Keys; - procedure Refresh_Soft_Label_Keys_Without_Update + procedure Refresh_Soft_Label_Keys_Without_Update is - function Slk_Noutrefresh return C_Int; + function Slk_Noutrefresh return C_Int; pragma Import (C, Slk_Noutrefresh, "slk_noutrefresh"); begin - if Slk_Noutrefresh = Curses_Err then + if Slk_Noutrefresh = Curses_Err then raise Curses_Exception; end if; end Refresh_Soft_Label_Keys_Without_Update; - procedure Get_Soft_Label_Key (Label : Label_Number; - Text : out String) + procedure Get_Soft_Label_Key (Label : Label_Number; + Text : out String) is - function Slk_Label (Label : C_Int) return chars_ptr; + function Slk_Label (Label : C_Int) return chars_ptr; pragma Import (C, Slk_Label, "slk_label"); begin - Fill_String (Slk_Label (C_Int (Label)), Text); + Fill_String (Slk_Label (C_Int (Label)), Text); end Get_Soft_Label_Key; - function Get_Soft_Label_Key (Label : Label_Number) return String + function Get_Soft_Label_Key (Label : Label_Number) return String is - function Slk_Label (Label : C_Int) return chars_ptr; + function Slk_Label (Label : C_Int) return chars_ptr; pragma Import (C, Slk_Label, "slk_label"); begin - return Fill_String (Slk_Label (C_Int (Label))); + return Fill_String (Slk_Label (C_Int (Label))); end Get_Soft_Label_Key; - procedure Clear_Soft_Label_Keys + procedure Clear_Soft_Label_Keys is - function Slk_Clear return C_Int; + function Slk_Clear return C_Int; pragma Import (C, Slk_Clear, "slk_clear"); begin - if Slk_Clear = Curses_Err then + if Slk_Clear = Curses_Err then raise Curses_Exception; end if; end Clear_Soft_Label_Keys; - procedure Restore_Soft_Label_Keys + procedure Restore_Soft_Label_Keys is - function Slk_Restore return C_Int; + function Slk_Restore return C_Int; pragma Import (C, Slk_Restore, "slk_restore"); begin - if Slk_Restore = Curses_Err then + if Slk_Restore = Curses_Err then raise Curses_Exception; end if; end Restore_Soft_Label_Keys; - procedure Touch_Soft_Label_Keys + procedure Touch_Soft_Label_Keys is - function Slk_Touch return C_Int; + function Slk_Touch return C_Int; pragma Import (C, Slk_Touch, "slk_touch"); begin - if Slk_Touch = Curses_Err then + if Slk_Touch = Curses_Err then raise Curses_Exception; end if; end Touch_Soft_Label_Keys; - procedure Switch_Soft_Label_Key_Attributes - (Attr : Character_Attribute_Set; - On : Boolean := True) + procedure Switch_Soft_Label_Key_Attributes + (Attr : Character_Attribute_Set; + On : Boolean := True) is - function Slk_Attron (Ch : C_Chtype) return C_Int; + function Slk_Attron (Ch : C_Chtype) return C_Int; pragma Import (C, Slk_Attron, "slk_attron"); - function Slk_Attroff (Ch : C_Chtype) return C_Int; + function Slk_Attroff (Ch : C_Chtype) return C_Int; pragma Import (C, Slk_Attroff, "slk_attroff"); - Err : C_Int; - Ch : constant Attributed_Character := (Ch => Character'First, + Err : C_Int; + Ch : constant Attributed_Character := (Ch => Character'First, Attr => Attr, Color => Color_Pair'First); begin if On then - Err := Slk_Attron (AttrChar_To_Chtype (Ch)); + Err := Slk_Attron (AttrChar_To_Chtype (Ch)); else - Err := Slk_Attroff (AttrChar_To_Chtype (Ch)); + Err := Slk_Attroff (AttrChar_To_Chtype (Ch)); end if; - if Err = Curses_Err then + if Err = Curses_Err then raise Curses_Exception; end if; end Switch_Soft_Label_Key_Attributes; - procedure Set_Soft_Label_Key_Attributes - (Attr : Character_Attribute_Set := Normal_Video; - Color : Color_Pair := Color_Pair'First) + procedure Set_Soft_Label_Key_Attributes + (Attr : Character_Attribute_Set := Normal_Video; + Color : Color_Pair := Color_Pair'First) is - function Slk_Attrset (Ch : C_Chtype) 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, + Ch : constant Attributed_Character := (Ch => Character'First, Attr => Attr, Color => Color); begin - if Slk_Attrset (AttrChar_To_Chtype (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 + function Get_Soft_Label_Key_Attributes return Character_Attribute_Set is - function Slk_Attr return C_Chtype; + function Slk_Attr return C_Chtype; pragma Import (C, Slk_Attr, "slk_attr"); - Attr : constant C_Chtype := Slk_Attr; + Attr : constant C_Chtype := Slk_Attr; begin - return Chtype_To_AttrChar (Attr).Attr; + return Chtype_To_AttrChar (Attr).Attr; end Get_Soft_Label_Key_Attributes; - function Get_Soft_Label_Key_Attributes return Color_Pair + function Get_Soft_Label_Key_Attributes return Color_Pair is - function Slk_Attr return C_Chtype; + function Slk_Attr return C_Chtype; pragma Import (C, Slk_Attr, "slk_attr"); - Attr : constant C_Chtype := Slk_Attr; + Attr : constant C_Chtype := Slk_Attr; begin - return Chtype_To_AttrChar (Attr).Color; + return Chtype_To_AttrChar (Attr).Color; end Get_Soft_Label_Key_Attributes; - procedure Set_Soft_Label_Key_Color (Pair : Color_Pair) + procedure Set_Soft_Label_Key_Color (Pair : Color_Pair) is - function Slk_Color (Color : C_Short) return C_Int; + function Slk_Color (Color : C_Short) return C_Int; pragma Import (C, Slk_Color, "slk_color"); begin - if Slk_Color (C_Short (Pair)) = Curses_Err then + if Slk_Color (C_Short (Pair)) = Curses_Err then raise Curses_Exception; end if; end Set_Soft_Label_Key_Color; ------------------------------------------------------------------------------ - procedure Enable_Key (Key : Special_Key_Code; - Enable : Boolean := True) + procedure Enable_Key (Key : Special_Key_Code; + Enable : Boolean := True) is - function Keyok (Keycode : C_Int; - On_Off : Curses_Bool) return C_Int; + function Keyok (Keycode : C_Int; + On_Off : Curses_Bool) return C_Int; pragma Import (C, Keyok, "keyok"); begin - if Keyok (C_Int (Key), Curses_Bool (Boolean'Pos (Enable))) + 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 : String; - Key : Special_Key_Code) + procedure Define_Key (Definition : String; + Key : Special_Key_Code) is - function Defkey (Def : char_array; - Key : C_Int) return C_Int; + function Defkey (Def : char_array; + Key : C_Int) return C_Int; pragma Import (C, Defkey, "define_key"); - Txt : char_array (0 .. Definition'Length); - Length : size_t; + Txt : char_array (0 .. Definition'Length); + Length : size_t; begin - To_C (Definition, Txt, Length); - if Defkey (Txt, C_Int (Key)) = Curses_Err then + To_C (Definition, Txt, Length); + if Defkey (Txt, C_Int (Key)) = Curses_Err then raise Curses_Exception; end if; end Define_Key; ------------------------------------------------------------------------------ - procedure Un_Control (Ch : Attributed_Character; - Str : out String) + procedure Un_Control (Ch : Attributed_Character; + Str : out String) is - function Unctrl (Ch : C_Chtype) return chars_ptr; + function Unctrl (Ch : C_Chtype) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin - Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str); + Fill_String (Unctrl (AttrChar_To_Chtype (Ch)), Str); end Un_Control; - function Un_Control (Ch : Attributed_Character) return String + function Un_Control (Ch : Attributed_Character) return String is - function Unctrl (Ch : C_Chtype) return chars_ptr; + function Unctrl (Ch : C_Chtype) return chars_ptr; pragma Import (C, Unctrl, "unctrl"); begin - return Fill_String (Unctrl (AttrChar_To_Chtype (Ch))); + return Fill_String (Unctrl (AttrChar_To_Chtype (Ch))); end Un_Control; - procedure Delay_Output (Msecs : Natural) + procedure Delay_Output (Msecs : Natural) is - function Delayoutput (Msecs : C_Int) return C_Int; + function Delayoutput (Msecs : C_Int) return C_Int; pragma Import (C, Delayoutput, "delay_output"); begin - if Delayoutput (C_Int (Msecs)) = Curses_Err then + if Delayoutput (C_Int (Msecs)) = Curses_Err then raise Curses_Exception; end if; end Delay_Output; - procedure Flush_Input + procedure Flush_Input is - function Flushinp return C_Int; + function Flushinp return C_Int; pragma Import (C, Flushinp, "flushinp"); begin - if Flushinp = Curses_Err then -- docu says that never happens, but... + if Flushinp = Curses_Err then -- docu says that never happens, but... raise Curses_Exception; end if; end Flush_Input; ------------------------------------------------------------------------------ - function Baudrate return Natural + function Baudrate return Natural is - function Baud return C_Int; + function Baud return C_Int; pragma Import (C, Baud, "baudrate"); begin - return Natural (Baud); + return Natural (Baud); end Baudrate; - function Erase_Character return Character + function Erase_Character return Character is - function Erasechar return C_Int; + function Erasechar return C_Int; pragma Import (C, Erasechar, "erasechar"); begin - return Character'Val (Erasechar); + return Character'Val (Erasechar); end Erase_Character; - function Kill_Character return Character + function Kill_Character return Character is - function Killchar return C_Int; + function Killchar return C_Int; pragma Import (C, Killchar, "killchar"); begin - return Character'Val (Killchar); + return Character'Val (Killchar); end Kill_Character; - function Has_Insert_Character return Boolean + function Has_Insert_Character return Boolean is - function Has_Ic return Curses_Bool; + function Has_Ic return Curses_Bool; pragma Import (C, Has_Ic, "has_ic"); begin - if Has_Ic = Curses_Bool_False then + if Has_Ic = Curses_Bool_False then return False; else return True; end if; end Has_Insert_Character; - function Has_Insert_Line return Boolean + function Has_Insert_Line return Boolean is - function Has_Il return Curses_Bool; + function Has_Il return Curses_Bool; pragma Import (C, Has_Il, "has_il"); begin - if Has_Il = Curses_Bool_False then + if Has_Il = Curses_Bool_False then return False; else return True; end if; end Has_Insert_Line; - function Supported_Attributes return Character_Attribute_Set + function Supported_Attributes return Character_Attribute_Set is - function Termattrs return C_Chtype; + function Termattrs return C_Chtype; pragma Import (C, Termattrs, "termattrs"); - Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs); + Ch : constant Attributed_Character := Chtype_To_AttrChar (Termattrs); begin - return Ch.Attr; + return Ch.Attr; end Supported_Attributes; - procedure Long_Name (Name : out String) + procedure Long_Name (Name : out String) is - function Longname return chars_ptr; + function Longname return chars_ptr; pragma Import (C, Longname, "longname"); begin - Fill_String (Longname, Name); + Fill_String (Longname, Name); end Long_Name; - function Long_Name return String + function Long_Name return String is - function Longname return chars_ptr; + function Longname return chars_ptr; pragma Import (C, Longname, "longname"); begin - return Fill_String (Longname); + return Fill_String (Longname); end Long_Name; - procedure Terminal_Name (Name : out String) + procedure Terminal_Name (Name : out String) is - function Termname return chars_ptr; + function Termname return chars_ptr; pragma Import (C, Termname, "termname"); begin - Fill_String (Termname, Name); + Fill_String (Termname, Name); end Terminal_Name; - function Terminal_Name return String + function Terminal_Name return String is - function Termname return chars_ptr; + function Termname return chars_ptr; pragma Import (C, Termname, "termname"); begin - return Fill_String (Termname); + return Fill_String (Termname); end Terminal_Name; ------------------------------------------------------------------------------ - procedure Init_Pair (Pair : Redefinable_Color_Pair; - Fore : Color_Number; - Back : Color_Number) + procedure Init_Pair (Pair : Redefinable_Color_Pair; + Fore : Color_Number; + Back : Color_Number) is - function Initpair (Pair : C_Short; - Fore : C_Short; - Back : C_Short) return C_Int; + function Initpair (Pair : C_Short; + Fore : C_Short; + Back : C_Short) return C_Int; pragma Import (C, Initpair, "init_pair"); begin if Integer (Pair) >= Number_Of_Color_Pairs then @@ -2156,311 +2158,311 @@ Integer (Back) >= Number_Of_Colors then raise Constraint_Error; end if; - if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back)) + if Initpair (C_Short (Pair), C_Short (Fore), C_Short (Back)) = Curses_Err then raise Curses_Exception; end if; end Init_Pair; - procedure Pair_Content (Pair : Color_Pair; - Fore : out Color_Number; - Back : out Color_Number) + procedure Pair_Content (Pair : Color_Pair; + Fore : out Color_Number; + Back : out Color_Number) is - type C_Short_Access is access all C_Short; - function Paircontent (Pair : C_Short; - Fp : C_Short_Access; - Bp : C_Short_Access) return C_Int; + type C_Short_Access is access all C_Short; + function Paircontent (Pair : C_Short; + Fp : C_Short_Access; + Bp : C_Short_Access) return C_Int; pragma Import (C, Paircontent, "pair_content"); - F, B : aliased C_Short; + F, B : aliased C_Short; begin - if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then + if Paircontent (C_Short (Pair), F'Access, B'Access) = Curses_Err then raise Curses_Exception; else - Fore := Color_Number (F); - Back := Color_Number (B); + Fore := Color_Number (F); + Back := Color_Number (B); end if; end Pair_Content; - function Has_Colors return Boolean + function Has_Colors return Boolean is - function Hascolors return Curses_Bool; + function Hascolors return Curses_Bool; pragma Import (C, Hascolors, "has_colors"); begin - if Hascolors = Curses_Bool_False then + if Hascolors = Curses_Bool_False then return False; else return True; end if; end Has_Colors; - procedure Init_Color (Color : Color_Number; - Red : RGB_Value; - Green : RGB_Value; - Blue : RGB_Value) + procedure Init_Color (Color : Color_Number; + Red : RGB_Value; + Green : RGB_Value; + Blue : RGB_Value) is - function Initcolor (Col : C_Short; - Red : C_Short; - Green : C_Short; - Blue : C_Short) return C_Int; + function Initcolor (Col : C_Short; + Red : C_Short; + Green : C_Short; + Blue : C_Short) return C_Int; pragma Import (C, Initcolor, "init_color"); begin - if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green), + if Initcolor (C_Short (Color), C_Short (Red), C_Short (Green), C_Short (Blue)) = Curses_Err then raise Curses_Exception; end if; end Init_Color; - function Can_Change_Color return Boolean + function Can_Change_Color return Boolean is - function Canchangecolor return Curses_Bool; + function Canchangecolor return Curses_Bool; pragma Import (C, Canchangecolor, "can_change_color"); begin - if Canchangecolor = Curses_Bool_False then + if Canchangecolor = Curses_Bool_False then return False; else return True; end if; end Can_Change_Color; - procedure Color_Content (Color : Color_Number; - Red : out RGB_Value; - Green : out RGB_Value; - Blue : out RGB_Value) + procedure Color_Content (Color : Color_Number; + Red : out RGB_Value; + Green : out RGB_Value; + Blue : out RGB_Value) is - type C_Short_Access is access all C_Short; + type C_Short_Access is access all C_Short; - function Colorcontent (Color : C_Short; R, G, B : C_Short_Access) + function Colorcontent (Color : C_Short; R, G, B : C_Short_Access) return C_Int; pragma Import (C, Colorcontent, "color_content"); - R, G, B : aliased C_Short; + R, G, B : aliased C_Short; begin - if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) = + if Colorcontent (C_Short (Color), R'Access, G'Access, B'Access) = Curses_Err then raise Curses_Exception; else - Red := RGB_Value (R); - Green := RGB_Value (G); - Blue := RGB_Value (B); + Red := RGB_Value (R); + Green := RGB_Value (G); + Blue := RGB_Value (B); end if; end Color_Content; ------------------------------------------------------------------------------ - procedure Save_Curses_Mode (Mode : Curses_Mode) + procedure Save_Curses_Mode (Mode : Curses_Mode) is - function Def_Prog_Mode return C_Int; + function Def_Prog_Mode return C_Int; pragma Import (C, Def_Prog_Mode, "def_prog_mode"); - function Def_Shell_Mode return C_Int; + function Def_Shell_Mode return C_Int; pragma Import (C, Def_Shell_Mode, "def_shell_mode"); - Err : C_Int; + Err : C_Int; begin case Mode is - when Curses => Err := Def_Prog_Mode; - when Shell => Err := Def_Shell_Mode; + when Curses => Err := Def_Prog_Mode; + when Shell => Err := Def_Shell_Mode; end case; - if Err = Curses_Err then + if Err = Curses_Err then raise Curses_Exception; end if; end Save_Curses_Mode; - procedure Reset_Curses_Mode (Mode : Curses_Mode) + procedure Reset_Curses_Mode (Mode : Curses_Mode) is - function Reset_Prog_Mode return C_Int; + function Reset_Prog_Mode return C_Int; pragma Import (C, Reset_Prog_Mode, "reset_prog_mode"); - function Reset_Shell_Mode return C_Int; + function Reset_Shell_Mode return C_Int; pragma Import (C, Reset_Shell_Mode, "reset_shell_mode"); - Err : C_Int; + Err : C_Int; begin case Mode is - when Curses => Err := Reset_Prog_Mode; - when Shell => Err := Reset_Shell_Mode; + when Curses => Err := Reset_Prog_Mode; + when Shell => Err := Reset_Shell_Mode; end case; - if Err = Curses_Err then + if Err = Curses_Err then raise Curses_Exception; end if; end Reset_Curses_Mode; - procedure Save_Terminal_State + procedure Save_Terminal_State is - function Savetty return C_Int; + function Savetty return C_Int; pragma Import (C, Savetty, "savetty"); begin - if Savetty = Curses_Err then + if Savetty = Curses_Err then raise Curses_Exception; end if; end Save_Terminal_State; - procedure Reset_Terminal_State + procedure Reset_Terminal_State is - function Resetty return C_Int; + function Resetty return C_Int; pragma Import (C, Resetty, "resetty"); begin - if Resetty = Curses_Err then + if Resetty = Curses_Err then raise Curses_Exception; end if; end Reset_Terminal_State; - procedure Rip_Off_Lines (Lines : Integer; - Proc : Stdscr_Init_Proc) + procedure Rip_Off_Lines (Lines : Integer; + Proc : Stdscr_Init_Proc) is - function Ripoffline (Lines : C_Int; - Proc : Stdscr_Init_Proc) return C_Int; + function Ripoffline (Lines : C_Int; + Proc : Stdscr_Init_Proc) return C_Int; pragma Import (C, Ripoffline, "_nc_ripoffline"); begin - if Ripoffline (C_Int (Lines), Proc) = Curses_Err then + if Ripoffline (C_Int (Lines), Proc) = Curses_Err then raise Curses_Exception; end if; end Rip_Off_Lines; - procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility) + procedure Set_Cursor_Visibility (Visibility : in out Cursor_Visibility) is - function Curs_Set (Curs : C_Int) return C_Int; + function Curs_Set (Curs : C_Int) return C_Int; pragma Import (C, Curs_Set, "curs_set"); - Res : C_Int; + Res : C_Int; begin - Res := Curs_Set (Cursor_Visibility'Pos (Visibility)); - if Res /= Curses_Err then - Visibility := Cursor_Visibility'Val (Res); + Res := Curs_Set (Cursor_Visibility'Pos (Visibility)); + if Res /= Curses_Err then + Visibility := Cursor_Visibility'Val (Res); end if; end Set_Cursor_Visibility; - procedure Nap_Milli_Seconds (Ms : Natural) + procedure Nap_Milli_Seconds (Ms : Natural) is - function Napms (Ms : C_Int) return C_Int; + function Napms (Ms : C_Int) return C_Int; pragma Import (C, Napms, "napms"); begin - if Napms (C_Int (Ms)) = Curses_Err then + if Napms (C_Int (Ms)) = Curses_Err then raise Curses_Exception; end if; end Nap_Milli_Seconds; ------------------------------------------------------------------------------ - function Standard_Window return Window + function Standard_Window return Window is - Result : Window; - pragma Import (C, Result, "stdscr"); + Result : Window; + pragma Import (C, Result, "stdscr"); begin - return Result; + return Result; end Standard_Window; - function Current_Window return Window + function Current_Window return Window is - Result : Window; - pragma Import (C, Result, "curscr"); + Result : Window; + pragma Import (C, Result, "curscr"); begin - return Result; + return Result; end Current_Window; - function Lines return Line_Count + function Lines return Line_Count is - Result : C_Int; - pragma Import (C, Result, "LINES"); + Result : C_Int; + pragma Import (C, Result, "LINES"); begin - return Line_Count (Result); + return Line_Count (Result); end Lines; - function Columns return Column_Count + function Columns return Column_Count is - Result : C_Int; - pragma Import (C, Result, "COLS"); + Result : C_Int; + pragma Import (C, Result, "COLS"); begin - return Column_Count (Result); + return Column_Count (Result); end Columns; - function Tab_Size return Natural + function Tab_Size return Natural is - Result : C_Int; - pragma Import (C, Result, "TABSIZE"); + Result : C_Int; + pragma Import (C, Result, "TABSIZE"); begin - return Natural (Result); + return Natural (Result); end Tab_Size; - function Number_Of_Colors return Natural + function Number_Of_Colors return Natural is - Result : C_Int; - pragma Import (C, Result, "COLORS"); + Result : C_Int; + pragma Import (C, Result, "COLORS"); begin - return Natural (Result); + return Natural (Result); end Number_Of_Colors; - function Number_Of_Color_Pairs return Natural + function Number_Of_Color_Pairs return Natural is - Result : C_Int; - pragma Import (C, Result, "COLOR_PAIRS"); + Result : C_Int; + pragma Import (C, Result, "COLOR_PAIRS"); begin - return Natural (Result); + return Natural (Result); end Number_Of_Color_Pairs; ------------------------------------------------------------------------------ - procedure Transform_Coordinates - (W : Window := Standard_Window; - Line : in out Line_Position; - Column : in out Column_Position; - Dir : Transform_Direction := From_Screen) - is - type Int_Access is access all C_Int; - function Transform (W : Window; - Y, X : Int_Access; - Dir : Curses_Bool) return C_Int; + procedure Transform_Coordinates + (W : Window := Standard_Window; + Line : in out Line_Position; + Column : in out Column_Position; + Dir : Transform_Direction := From_Screen) + is + type Int_Access is access all C_Int; + function Transform (W : Window; + Y, X : Int_Access; + 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 : Curses_Bool := Curses_Bool_False; - R : C_Int; + X : aliased C_Int := C_Int (Column); + Y : aliased C_Int := C_Int (Line); + D : Curses_Bool := Curses_Bool_False; + R : C_Int; begin if Dir = To_Screen then - D := 1; + D := 1; end if; - R := Transform (W, Y'Access, X'Access, D); - if R = Curses_False then + R := Transform (W, Y'Access, X'Access, D); + if R = Curses_False then raise Curses_Exception; else - Line := Line_Position (Y); - Column := Column_Position (X); + Line := Line_Position (Y); + Column := Column_Position (X); end if; end Transform_Coordinates; ------------------------------------------------------------------------------ - procedure Use_Default_Colors is - function C_Use_Default_Colors return C_Int; + 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; + Err : constant C_Int := C_Use_Default_Colors; begin - if Err = Curses_Err then + 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) + 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; + 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), + Err : constant C_Int := C_Assume_Default_Colors (C_Int (Fore), C_Int (Back)); begin - if Err = Curses_Err then + if Err = Curses_Err then raise Curses_Exception; end if; end Assume_Default_Colors; ------------------------------------------------------------------------------ - function Curses_Version return String + function Curses_Version return String is - function curses_versionC return chars_ptr; + function curses_versionC return chars_ptr; pragma Import (C, curses_versionC, "curses_version"); - Result : constant chars_ptr := curses_versionC; + Result : constant chars_ptr := curses_versionC; begin - return Fill_String (Result); + return Fill_String (Result); end Curses_Version; ------------------------------------------------------------------------------ - procedure Curses_Free_All is - procedure curses_freeall; + procedure Curses_Free_All is + procedure curses_freeall; pragma Import (C, curses_freeall, "_nc_freeall"); begin -- Use this only for testing: you cannot use curses after calling it, @@ -2470,85 +2472,85 @@ -- _nc_free_and_exit() procedure can do that, but it can be invoked -- safely only from C - and again, that only as the "last" thing done -- before exiting the program. - curses_freeall; + curses_freeall; end Curses_Free_All; ------------------------------------------------------------------------------ - function Use_Extended_Names (Enable : Boolean) return Boolean + function Use_Extended_Names (Enable : Boolean) return Boolean is - function use_extended_namesC (e : Curses_Bool) return C_Int; + 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))); + Res : constant C_Int := + use_extended_namesC (Curses_Bool (Boolean'Pos (Enable))); begin - if Res = C_Int (Curses_Bool_False) then + 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 : String) + procedure Screen_Dump_To_File (Filename : String) is - function scr_dump (f : char_array) return C_Int; + 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; + Txt : char_array (0 .. Filename'Length); + Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_dump (Txt) then + 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 : String) + procedure Screen_Restore_From_File (Filename : String) is - function scr_restore (f : char_array) return C_Int; + 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; + Txt : char_array (0 .. Filename'Length); + Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_restore (Txt) then + 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 : String) + procedure Screen_Init_From_File (Filename : String) is - function scr_init (f : char_array) return C_Int; + 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; + Txt : char_array (0 .. Filename'Length); + Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_init (Txt) then + 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 : String) + procedure Screen_Set_File (Filename : String) is - function scr_set (f : char_array) return C_Int; + 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; + Txt : char_array (0 .. Filename'Length); + Length : size_t; begin - To_C (Filename, Txt, Length); - if Curses_Err = scr_set (Txt) then + 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; + 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, + if wresize (Win, C_Int (Number_Of_Lines), C_Int (Number_Of_Columns)) = Curses_Err then raise Curses_Exception;