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
;