1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
12 -- Permission is hereby granted, free of charge, to any person obtaining a --
13 -- copy of this software and associated documentation files (the --
14 -- "Software"), to deal in the Software without restriction, including --
15 -- without limitation the rights to use, copy, modify, merge, publish, --
16 -- distribute, distribute with modifications, sublicense, and/or sell --
17 -- copies of the Software, and to permit persons to whom the Software is --
18 -- furnished to do so, subject to the following conditions: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
23 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
24 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
25 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
26 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
27 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
28 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
29 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
31 -- Except as contained in this notice, the name(s) of the above copyright --
32 -- holders shall not be used in advertising or otherwise to promote the --
33 -- sale, use or other dealings in this Software without prior written --
35 ------------------------------------------------------------------------------
36 -- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
39 -- $Date: 2008/07/26 18:47:34 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with ncurses2.util; use ncurses2.util;
43 with ncurses2.genericPuts;
44 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
46 with Ada.Strings.Unbounded;
47 with Ada.Strings.Fixed;
49 procedure ncurses2.acs_display is
52 procedure show_upper_chars (first : Integer);
53 function show_1_acs (N : Integer;
55 code : Attributed_Character)
57 procedure show_acs_chars;
59 procedure show_upper_chars (first : Integer) is
60 C1 : constant Boolean := (first = 128);
61 last : constant Integer := first + 31;
62 package p is new ncurses2.genericPuts (200);
65 use Ada.Strings.Unbounded;
67 tmpa : Unbounded_String;
68 tmpb : BS.Bounded_String;
71 Switch_Character_Attribute
72 (Attr => (Bold_Character => True, others => False));
73 Move_Cursor (Line => 0, Column => 20);
74 tmpa := To_Unbounded_String ("Display of ");
80 tmpa := tmpa & " Character Codes ";
82 Append (tmpa, To_String (tmpb));
83 Append (tmpa, " to ");
85 Append (tmpa, To_String (tmpb));
86 Add (Str => To_String (tmpa));
87 Switch_Character_Attribute
89 Attr => (Bold_Character => True, others => False));
92 for code in first .. last loop
94 row : constant Line_Position
95 := Line_Position (4 + ((code - first) mod 16));
96 col : constant Column_Position
97 := Column_Position (((code - first) / 16) *
98 Integer (Columns) / 2);
99 tmp3 : String (1 .. 3);
100 tmpx : String (1 .. Integer (Columns / 4));
104 myPut (tmpb, code, 16);
105 tmpa := To_Unbounded_String (tmp3 & " (" & To_String (tmpb) & ')');
107 Ada.Strings.Fixed.Move (To_String (tmpa), tmpx,
108 Justify => Ada.Strings.Right);
109 Add (Line => row, Column => col,
110 Str => tmpx & ' ' & ':' & ' ');
112 Set_NoDelay_Mode (Mode => True);
114 Add_With_Immediate_Echo (Ch => Code_To_Char (Key_Code (code)));
118 while reply /= Key_None loop
119 Add (Ch => Code_To_Char (reply));
120 Nap_Milli_Seconds (10);
123 Set_NoDelay_Mode (Mode => False);
127 end show_upper_chars;
129 function show_1_acs (N : Integer;
131 code : Attributed_Character)
133 height : constant Integer := 16;
134 row : constant Line_Position := Line_Position (4 + (N mod height));
135 col : constant Column_Position := Column_Position ((N / height) *
136 Integer (Columns) / 2);
137 tmpx : String (1 .. Integer (Columns) / 3);
139 Ada.Strings.Fixed.Move (name, tmpx,
140 Justify => Ada.Strings.Right,
141 Drop => Ada.Strings.Left);
142 Add (Line => row, Column => col, Str => tmpx & ' ' & ':' & ' ');
143 -- we need more room than C because our identifiers are longer
149 procedure show_acs_chars is
153 Switch_Character_Attribute
154 (Attr => (Bold_Character => True, others => False));
155 Add (Line => 0, Column => 20,
156 Str => "Display of the ACS Character Set");
157 Switch_Character_Attribute (On => False,
158 Attr => (Bold_Character => True,
162 -- the following is useful to generate the below
163 -- grep '^[ ]*ACS_' ../src/terminal_interface-curses.ads |
164 -- awk '{print "n := show_1_acs(n, \""$1"\", ACS_Map("$1"));"}'
166 n := show_1_acs (0, "ACS_Upper_Left_Corner",
167 ACS_Map (ACS_Upper_Left_Corner));
168 n := show_1_acs (n, "ACS_Lower_Left_Corner",
169 ACS_Map (ACS_Lower_Left_Corner));
170 n := show_1_acs (n, "ACS_Upper_Right_Corner",
171 ACS_Map (ACS_Upper_Right_Corner));
172 n := show_1_acs (n, "ACS_Lower_Right_Corner",
173 ACS_Map (ACS_Lower_Right_Corner));
174 n := show_1_acs (n, "ACS_Left_Tee", ACS_Map (ACS_Left_Tee));
175 n := show_1_acs (n, "ACS_Right_Tee", ACS_Map (ACS_Right_Tee));
176 n := show_1_acs (n, "ACS_Bottom_Tee", ACS_Map (ACS_Bottom_Tee));
177 n := show_1_acs (n, "ACS_Top_Tee", ACS_Map (ACS_Top_Tee));
178 n := show_1_acs (n, "ACS_Horizontal_Line",
179 ACS_Map (ACS_Horizontal_Line));
180 n := show_1_acs (n, "ACS_Vertical_Line", ACS_Map (ACS_Vertical_Line));
181 n := show_1_acs (n, "ACS_Plus_Symbol", ACS_Map (ACS_Plus_Symbol));
182 n := show_1_acs (n, "ACS_Scan_Line_1", ACS_Map (ACS_Scan_Line_1));
183 n := show_1_acs (n, "ACS_Scan_Line_9", ACS_Map (ACS_Scan_Line_9));
184 n := show_1_acs (n, "ACS_Diamond", ACS_Map (ACS_Diamond));
185 n := show_1_acs (n, "ACS_Checker_Board", ACS_Map (ACS_Checker_Board));
186 n := show_1_acs (n, "ACS_Degree", ACS_Map (ACS_Degree));
187 n := show_1_acs (n, "ACS_Plus_Minus", ACS_Map (ACS_Plus_Minus));
188 n := show_1_acs (n, "ACS_Bullet", ACS_Map (ACS_Bullet));
189 n := show_1_acs (n, "ACS_Left_Arrow", ACS_Map (ACS_Left_Arrow));
190 n := show_1_acs (n, "ACS_Right_Arrow", ACS_Map (ACS_Right_Arrow));
191 n := show_1_acs (n, "ACS_Down_Arrow", ACS_Map (ACS_Down_Arrow));
192 n := show_1_acs (n, "ACS_Up_Arrow", ACS_Map (ACS_Up_Arrow));
193 n := show_1_acs (n, "ACS_Board_Of_Squares",
194 ACS_Map (ACS_Board_Of_Squares));
195 n := show_1_acs (n, "ACS_Lantern", ACS_Map (ACS_Lantern));
196 n := show_1_acs (n, "ACS_Solid_Block", ACS_Map (ACS_Solid_Block));
197 n := show_1_acs (n, "ACS_Scan_Line_3", ACS_Map (ACS_Scan_Line_3));
198 n := show_1_acs (n, "ACS_Scan_Line_7", ACS_Map (ACS_Scan_Line_7));
199 n := show_1_acs (n, "ACS_Less_Or_Equal", ACS_Map (ACS_Less_Or_Equal));
200 n := show_1_acs (n, "ACS_Greater_Or_Equal",
201 ACS_Map (ACS_Greater_Or_Equal));
202 n := show_1_acs (n, "ACS_PI", ACS_Map (ACS_PI));
203 n := show_1_acs (n, "ACS_Not_Equal", ACS_Map (ACS_Not_Equal));
204 n := show_1_acs (n, "ACS_Sterling", ACS_Map (ACS_Sterling));
207 raise Constraint_Error;
212 c : Character := 'a';
218 when '0' | '1' | '2' | '3' =>
219 show_upper_chars (ctoi (c) * 32 + 128);
223 Add (Line => Lines - 3, Column => 0,
224 Str => "Note: ANSI terminals may not display C1 characters.");
225 Add (Line => Lines - 2, Column => 0,
226 Str => "Select: a=ACS, 0=C1, 1,2,3=GR characters, q=quit");
229 c := Code_To_Char (c1);
230 exit when c = 'q' or c = 'x';
235 end ncurses2.acs_display;