1------------------------------------------------------------------------------ 2-- -- 3-- GNAT ncurses Binding Samples -- 4-- -- 5-- ncurses -- 6-- -- 7-- B O D Y -- 8-- -- 9------------------------------------------------------------------------------ 10-- Copyright 2018,2020 Thomas E. Dickey -- 11-- Copyright 2000-2009,2011 Free Software Foundation, Inc. -- 12-- -- 13-- Permission is hereby granted, free of charge, to any person obtaining a -- 14-- copy of this software and associated documentation files (the -- 15-- "Software"), to deal in the Software without restriction, including -- 16-- without limitation the rights to use, copy, modify, merge, publish, -- 17-- distribute, distribute with modifications, sublicense, and/or sell -- 18-- copies of the Software, and to permit persons to whom the Software is -- 19-- furnished to do so, subject to the following conditions: -- 20-- -- 21-- The above copyright notice and this permission notice shall be included -- 22-- in all copies or substantial portions of the Software. -- 23-- -- 24-- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS -- 25-- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF -- 26-- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. -- 27-- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, -- 28-- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR -- 29-- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR -- 30-- THE USE OR OTHER DEALINGS IN THE SOFTWARE. -- 31-- -- 32-- Except as contained in this notice, the name(s) of the above copyright -- 33-- holders shall not be used in advertising or otherwise to promote the -- 34-- sale, use or other dealings in this Software without prior written -- 35-- authorization. -- 36------------------------------------------------------------------------------ 37-- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000 38-- Version Control 39-- $Revision: 1.11 $ 40-- $Date: 2020/02/02 23:34:34 $ 41-- Binding Version 01.00 42------------------------------------------------------------------------------ 43with ncurses2.util; use ncurses2.util; 44with Terminal_Interface.Curses; use Terminal_Interface.Curses; 45 46with Ada.Strings.Unbounded; 47with Interfaces.C; 48with Terminal_Interface.Curses.Aux; 49 50procedure ncurses2.slk_test is 51 procedure myGet (Win : Window := Standard_Window; 52 Str : out Ada.Strings.Unbounded.Unbounded_String; 53 Len : Integer := -1); 54 55 procedure myGet (Win : Window := Standard_Window; 56 Str : out Ada.Strings.Unbounded.Unbounded_String; 57 Len : Integer := -1) 58 is 59 use Ada.Strings.Unbounded; 60 use Interfaces.C; 61 use Terminal_Interface.Curses.Aux; 62 63 function Wgetnstr (Win : Window; 64 Str : char_array; 65 Len : int) return int; 66 pragma Import (C, Wgetnstr, "wgetnstr"); 67 68 -- FIXME: how to construct "(Len > 0) ? Len : 80"? 69 Ask : constant Interfaces.C.size_t := Interfaces.C.size_t'Val (Len + 80); 70 Txt : char_array (0 .. Ask); 71 72 begin 73 Txt (0) := Interfaces.C.char'First; 74 if Wgetnstr (Win, Txt, Txt'Length) = Curses_Err then 75 raise Curses_Exception; 76 end if; 77 Str := To_Unbounded_String (To_Ada (Txt, True)); 78 end myGet; 79 80 use Ada.Strings.Unbounded; 81 82 c : Key_Code; 83 buf : Unbounded_String; 84 c2 : Character; 85 fmt : Label_Justification := Centered; 86 tmp : Integer; 87 88begin 89 c := CTRL ('l'); 90 loop 91 Move_Cursor (Line => 0, Column => 0); 92 c2 := Code_To_Char (c); 93 case c2 is 94 when Character'Val (Character'Pos ('l') mod 16#20#) => -- CTRL('l') 95 Erase; 96 Switch_Character_Attribute (Attr => (Bold_Character => True, 97 others => False)); 98 Add (Line => 0, Column => 20, 99 Str => "Soft Key Exerciser"); 100 Switch_Character_Attribute (On => False, 101 Attr => (Bold_Character => True, 102 others => False)); 103 104 Move_Cursor (Line => 2, Column => 0); 105 P ("Available commands are:"); 106 P (""); 107 P ("^L -- refresh screen"); 108 P ("a -- activate or restore soft keys"); 109 P ("d -- disable soft keys"); 110 P ("c -- set centered format for labels"); 111 P ("l -- set left-justified format for labels"); 112 P ("r -- set right-justified format for labels"); 113 P ("[12345678] -- set label; labels are numbered 1 through 8"); 114 P ("e -- erase stdscr (should not erase labels)"); 115 P ("s -- test scrolling of shortened screen"); 116 P ("x, q -- return to main menu"); 117 P (""); 118 P ("Note: if activating the soft keys causes your terminal to"); 119 P ("scroll up one line, your terminal auto-scrolls when anything"); 120 P ("is written to the last screen position. The ncurses code"); 121 P ("does not yet handle this gracefully."); 122 Refresh; 123 Restore_Soft_Label_Keys; 124 125 when 'a' => 126 Restore_Soft_Label_Keys; 127 when 'e' => 128 Clear; 129 when 's' => 130 Add (Line => 20, Column => 0, 131 Str => "Press Q to stop the scrolling-test: "); 132 loop 133 c := Getchar; 134 c2 := Code_To_Char (c); 135 exit when c2 = 'Q'; 136 -- c = ERR? 137 -- TODO when c is not a character (arrow key) 138 -- the behavior is different from the C version. 139 Add (Ch => c2); 140 end loop; 141 when 'd' => 142 Clear_Soft_Label_Keys; 143 when 'l' => 144 fmt := Left; 145 when 'c' => 146 fmt := Centered; 147 when 'r' => 148 fmt := Right; 149 when '1' | '2' | '3' | '4' | '5' | '6' | '7' | '8' => 150 Add (Line => 20, Column => 0, 151 Str => "Please enter the label value: "); 152 Set_Echo_Mode (SwitchOn => True); 153 myGet (Str => buf); 154 Set_Echo_Mode (SwitchOn => False); 155 tmp := ctoi (c2); 156 Set_Soft_Label_Key (Label_Number (tmp), To_String (buf), fmt); 157 Refresh_Soft_Label_Keys; 158 Move_Cursor (Line => 20, Column => 0); 159 Clear_To_End_Of_Line; 160 when 'x' | 'q' => 161 exit; 162 -- the C version needed a goto, ha ha 163 -- breaks exit the case not the loop because fall-through 164 -- happens in C! 165 when others => 166 Beep; 167 end case; 168 c := Getchar; 169 -- TODO exit when c = EOF 170 end loop; 171 Erase; 172 End_Windows; 173end ncurses2.slk_test; 174