diff options
Diffstat (limited to 'ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb')
| -rw-r--r-- | ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb | 251 |
1 files changed, 0 insertions, 251 deletions
diff --git a/ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb deleted file mode 100644 index 5ed79a9..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-getch_test.adb +++ /dev/null @@ -1,251 +0,0 @@ ------------------------------------------------------------------------------- --- -- --- GNAT ncurses Binding Samples -- --- -- --- ncurses -- --- -- --- B O D Y -- --- -- ------------------------------------------------------------------------------- --- Copyright (c) 2000 Free Software Foundation, Inc. -- --- -- --- Permission is hereby granted, free of charge, to any person obtaining a -- --- copy of this software and associated documentation files (the -- --- "Software"), to deal in the Software without restriction, including -- --- without limitation the rights to use, copy, modify, merge, publish, -- --- distribute, distribute with modifications, sublicense, and/or sell -- --- copies of the Software, and to permit persons to whom the Software is -- --- furnished to do so, subject to the following conditions: -- --- -- --- The above copyright notice and this permission notice shall be included -- --- in all copies or substantial portions of the Software. -- --- -- --- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- --- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- --- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- --- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- --- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- --- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- --- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- --- -- --- Except as contained in this notice, the name(s) of the above copyright -- --- holders shall not be used in advertising or otherwise to promote the -- --- sale, use or other dealings in this Software without prior written -- --- authorization. -- ------------------------------------------------------------------------------- --- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 --- Version Control --- $Revision$ --- Binding Version 01.00 ------------------------------------------------------------------------------- --- Character input test --- test the keypad feature - -with ncurses2.util; use ncurses2.util; - -with Terminal_Interface.Curses; use Terminal_Interface.Curses; -with Terminal_Interface.Curses.Mouse; use Terminal_Interface.Curses.Mouse; -with Ada.Characters.Handling; -with Ada.Strings.Bounded; - -with ncurses2.genericPuts; - -procedure ncurses2.getch_test is - use Int_IO; - - function mouse_decode (ep : Mouse_Event) return String; - - function mouse_decode (ep : Mouse_Event) return String is - Y : Line_Position; - X : Column_Position; - Button : Mouse_Button; - State : Button_State; - package BS is new Ada.Strings.Bounded.Generic_Bounded_Length (200); - use BS; - buf : Bounded_String := To_Bounded_String (""); - begin - -- Note that these bindings do not allow - -- two button states, - -- The C version can print {click-1, click-3} for example. - -- They also don't have the 'id' or z coordinate. - Get_Event (ep, Y, X, Button, State); - - -- TODO Append (buf, "id "); from C version - Append (buf, "at ("); - Append (buf, Column_Position'Image (X)); - Append (buf, ", "); - Append (buf, Line_Position'Image (Y)); - Append (buf, ") state"); - Append (buf, Mouse_Button'Image (Button)); - - Append (buf, " = "); - Append (buf, Button_State'Image (State)); - return To_String (buf); - end mouse_decode; - - - buf : String (1 .. 1024); -- TODO was BUFSIZE - n : Integer; - c : Key_Code; - blockflag : Timeout_Mode := Blocking; - firsttime : Boolean := True; - tmp2 : Event_Mask; - tmp6 : String (1 .. 6); - tmp20 : String (1 .. 20); - x : Column_Position; - y : Line_Position; - tmpx : Integer; - incount : Integer := 0; -begin - Refresh; - tmp2 := Start_Mouse (All_Events); - Add (Str => "Delay in 10ths of a second (<CR> for blocking input)? "); - Set_Echo_Mode (SwitchOn => True); - Get (Str => buf); - - Set_Echo_Mode (SwitchOn => False); - Set_NL_Mode (SwitchOn => False); - - if Ada.Characters.Handling.Is_Digit (buf (1)) then - Get (Item => n, From => buf, Last => tmpx); - Set_Timeout_Mode (Mode => Delayed, Amount => n * 100); - blockflag := Delayed; - end if; - - c := Character'Pos ('?'); - Set_Raw_Mode (SwitchOn => True); - loop - if not firsttime then - Add (Str => "Key pressed: "); - Put (tmp6, Integer (c), 8); - Add (Str => tmp6); - Add (Ch => ' '); - if c = Key_Mouse then declare - event : Mouse_Event; - begin - event := Get_Mouse; - Add (Str => "KEY_MOUSE, "); - Add (Str => mouse_decode (event)); - Add (Ch => newl); - end; - elsif c >= Key_Min then - Key_Name (c, tmp20); - Add (Str => tmp20); - -- I used tmp and got bitten by the length problem:-> - Add (Ch => newl); - elsif c > 16#80# then -- TODO fix, use constant if possible - declare - c2 : Character := Character'Val (c mod 16#80#); - begin - if Ada.Characters.Handling.Is_Graphic (c2) then - Add (Str => "M-"); - Add (Ch => c2); - else - Add (Str => "M-"); - Add (Str => Un_Control ((Ch => c2, - Color => Color_Pair'First, - Attr => Normal_Video))); - end if; - Add (Str => " (high-half character)"); - Add (Ch => newl); - end; - else declare - c2 : Character := Character'Val (c mod 16#80#); - begin - if Ada.Characters.Handling.Is_Graphic (c2) then - Add (Ch => c2); - Add (Str => " (ASCII printable character)"); - Add (Ch => newl); - else - Add (Str => Un_Control ((Ch => c2, - Color => Color_Pair'First, - Attr => Normal_Video))); - Add (Str => " (ASCII control character)"); - Add (Ch => newl); - end if; - end; - end if; - -- TODO I am not sure why this was in the C version - -- the delay statement scroll anyway. - Get_Cursor_Position (Line => y, Column => x); - if y >= Lines - 1 then - Move_Cursor (Line => 0, Column => 0); - end if; - Clear_To_End_Of_Line; - end if; - - firsttime := False; - if c = Character'Pos ('g') then - declare - package p is new ncurses2.genericPuts (1024); - use p; - use p.BS; - timedout : Boolean := False; - boundedbuf : Bounded_String; - begin - Add (Str => "getstr test: "); - Set_Echo_Mode (SwitchOn => True); - -- Note that if delay mode is set - -- Get can raise an exception. - -- The C version would print the string it had so far - -- also TODO get longer length string, like the C version - declare begin - myGet (Str => boundedbuf); - exception when Curses_Exception => - Add (Str => "Timed out."); - Add (Ch => newl); - timedout := True; - end; - -- note that the Ada Get will stop reading at 1024. - if not timedout then - Set_Echo_Mode (SwitchOn => False); - Add (Str => " I saw '"); - myAdd (Str => boundedbuf); - Add (Str => "'."); - Add (ch => newl); - end if; - end; - elsif c = Character'Pos ('s') then - ShellOut (True); - elsif c = Character'Pos ('x') or c = Character'Pos ('q') or - (c = Key_None and blockflag = Blocking) then - exit; - elsif c = Character'Pos ('?') then - Add (Str => "Type any key to see its keypad value. Also:"); - Add (Ch => newl); - Add (Str => "g -- triggers a getstr test"); - Add (Ch => newl); - Add (Str => "s -- shell out"); - Add (Ch => newl); - Add (Str => "q -- quit"); - Add (Ch => newl); - Add (Str => "? -- repeats this help message"); - Add (Ch => newl); - end if; - - loop - c := Getchar; - exit when c /= Key_None; - if blockflag /= Blocking then - Put (tmp6, incount); -- argh string length! - Add (Str => tmp6); - Add (Str => ": input timed out"); - Add (Ch => newl); - else - Put (tmp6, incount); - Add (Str => tmp6); - Add (Str => ": input error"); - Add (Ch => newl); - exit; - end if; - incount := incount + 1; - end loop; - end loop; - - tmp2 := Start_Mouse (No_Events); - Set_Timeout_Mode (Mode => Blocking, Amount => 0); -- amount is ignored - Set_Raw_Mode (SwitchOn => False); - Set_NL_Mode (SwitchOn => True); - Erase; - End_Windows; -end ncurses2.getch_test; |