diff options
Diffstat (limited to 'ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb')
| -rw-r--r-- | ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb | 171 |
1 files changed, 0 insertions, 171 deletions
diff --git a/ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb b/ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb deleted file mode 100644 index 483ea5b..0000000 --- a/ncurses-5.3/Ada95/samples/ncurses2-slk_test.adb +++ /dev/null @@ -1,171 +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 ------------------------------------------------------------------------------- -with ncurses2.util; use ncurses2.util; -with Terminal_Interface.Curses; use Terminal_Interface.Curses; - -with Ada.Strings.Unbounded; -with Interfaces.C; -with Terminal_Interface.Curses.Aux; - -procedure ncurses2.slk_test is - procedure myGet (Win : in Window := Standard_Window; - Str : out Ada.Strings.Unbounded.Unbounded_String; - Len : in Integer := -1); - - procedure myGet (Win : in Window := Standard_Window; - Str : out Ada.Strings.Unbounded.Unbounded_String; - Len : in Integer := -1) - is - use Ada.Strings.Unbounded; - use Interfaces.C; - use Terminal_Interface.Curses.Aux; - - function Wgetnstr (Win : Window; - Str : char_array; - Len : int) return int; - pragma Import (C, Wgetnstr, "wgetnstr"); - - Txt : char_array (0 .. 10); - begin - Txt (0) := Interfaces.C.char'First; - if Wgetnstr (Win, Txt, 8) = Curses_Err then - raise Curses_Exception; - end if; - Str := To_Unbounded_String (To_Ada (Txt, True)); - end myGet; - - - use Int_IO; - - use Ada.Strings.Unbounded; - - c : Key_Code; - buf : Unbounded_String; - c2 : Character; - fmt : Label_Justification := Centered; - tmp : Integer; - -begin - c := CTRL ('l'); - loop - Move_Cursor (Line => 0, Column => 0); - c2 := Code_To_Char (c); - case c2 is - when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l') - Erase; - Switch_Character_Attribute (Attr => (Bold_Character => True, - others => False)); - Add (Line => 0, Column => 20, - Str => "Soft Key Exerciser"); - Switch_Character_Attribute (On => False, - Attr => (Bold_Character => True, - others => False)); - - Move_Cursor (Line => 2, Column => 0); - P ("Available commands are:"); - P (""); - P ("^L -- refresh screen"); - P ("a -- activate or restore soft keys"); - P ("d -- disable soft keys"); - P ("c -- set centered format for labels"); - P ("l -- set left-justified format for labels"); - P ("r -- set right-justified format for labels"); - P ("[12345678] -- set label; labels are numbered 1 through 8"); - P ("e -- erase stdscr (should not erase labels)"); - P ("s -- test scrolling of shortened screen"); - P ("x, q -- return to main menu"); - P (""); - P ("Note: if activating the soft keys causes your terminal to"); - P ("scroll up one line, your terminal auto-scrolls when anything"); - P ("is written to the last screen position. The ncurses code"); - P ("does not yet handle this gracefully."); - Refresh; - Restore_Soft_Label_Keys; - - when 'a' => - Restore_Soft_Label_Keys; - when 'e' => - Clear; - when 's' => - Add (Line => 20, Column => 0, - Str => "Press Q to stop the scrolling-test: "); - loop - c := Getchar; - c2 := Code_To_Char (c); - exit when c2 = 'Q'; - -- c = ERR? - -- TODO when c is not a character (arrow key) - -- the behavior is different from the C version. - Add (Ch => c2); - end loop; - when 'd' => - Clear_Soft_Label_Keys; - when 'l' => - fmt := Left; - when 'c' => - fmt := Centered; - when 'r' => - fmt := Right; - when '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' => - Add (Line => 20, Column => 0, - Str => "Please enter the label value: "); - Set_Echo_Mode (SwitchOn => True); - myGet (Str => buf); - Set_Echo_Mode (SwitchOn => False); - tmp := ctoi (c2); - Set_Soft_Label_Key (Label_Number (tmp), To_String (buf), fmt); - Refresh_Soft_Label_Keys; - Move_Cursor (Line => 20, Column => 0); - Clear_To_End_Of_Line; - when 'x' | 'q' => - exit; - -- the C version needed a goto, ha ha - -- breaks exit the case not the loop because fall-throuh - -- happens in C! - when others => - Beep; - end case; - c := Getchar; - -- TODO exit when c = EOF - end loop; - Erase; - End_Windows; -end ncurses2.slk_test; |