Gitiles
Code Review Sign In
gerrit.omnirom.org / android_external_libncurses / refs/heads/android-16 / . / Ada95 / samples / ncurses2-acs_display.adb
blob: 2916e15c71cd37e2231d1a2f82eb050f1346099f [file] [log] [blame]
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]1------------------------------------------------------------------------------
2-- --
3-- GNAT ncurses Binding Samples --
4-- --
5-- ncurses --
6-- --
7-- B O D Y --
8-- --
9------------------------------------------------------------------------------
micky3879b9f5e72025-07-08 18:04:53 -0400[diff] [blame]10-- Copyright 2020 Thomas E. Dickey --
11-- Copyright 2000-2006,2008 Free Software Foundation, Inc. --
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]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
micky3879b9f5e72025-07-08 18:04:53 -0400[diff] [blame]39-- $Revision: 1.7 $
40-- $Date: 2020/02/02 23:34:34 $
Amit Daniel Kachhape6a01f52011-07-20 11:45:59 +0530[diff] [blame]41-- Binding Version 01.00
42------------------------------------------------------------------------------
43with ncurses2.util; use ncurses2.util;
44with ncurses2.genericPuts;
45with Terminal_Interface.Curses; use Terminal_Interface.Curses;
46
47with Ada.Strings.Unbounded;
48with Ada.Strings.Fixed;
49
50procedure ncurses2.acs_display is
51 use Int_IO;
52
53 procedure show_upper_chars (first : Integer);
54 function show_1_acs (N : Integer;
55 name : String;
56 code : Attributed_Character)
57 return Integer;
58 procedure show_acs_chars;
59
60 procedure show_upper_chars (first : Integer) is
61 C1 : constant Boolean := (first = 128);
62 last : constant Integer := first + 31;
63 package p is new ncurses2.genericPuts (200);
64 use p;
65 use p.BS;
66 use Ada.Strings.Unbounded;
67
68 tmpa : Unbounded_String;
69 tmpb : BS.Bounded_String;
70 begin
71 Erase;
72 Switch_Character_Attribute
73 (Attr => (Bold_Character => True, others => False));
74 Move_Cursor (Line => 0, Column => 20);
75 tmpa := To_Unbounded_String ("Display of ");
76 if C1 then
77 tmpa := tmpa & "C1";
78 else
79 tmpa := tmpa & "GR";
80 end if;
81 tmpa := tmpa & " Character Codes ";
82 myPut (tmpb, first);
83 Append (tmpa, To_String (tmpb));
84 Append (tmpa, " to ");
85 myPut (tmpb, last);
86 Append (tmpa, To_String (tmpb));
87 Add (Str => To_String (tmpa));
88 Switch_Character_Attribute
89 (On => False,
90 Attr => (Bold_Character => True, others => False));
91 Refresh;
92
93 for code in first .. last loop
94 declare
95 row : constant Line_Position
96 := Line_Position (4 + ((code - first) mod 16));
97 col : constant Column_Position
98 := Column_Position (((code - first) / 16) *
99 Integer (Columns) / 2);
100 tmp3 : String (1 .. 3);
101 tmpx : String (1 .. Integer (Columns / 4));
102 reply : Key_Code;
103 begin
104 Put (tmp3, code);
105 myPut (tmpb, code, 16);
106 tmpa := To_Unbounded_String (tmp3 & " (" & To_String (tmpb) & ')');
107
108 Ada.Strings.Fixed.Move (To_String (tmpa), tmpx,
109 Justify => Ada.Strings.Right);
110 Add (Line => row, Column => col,
111 Str => tmpx & ' ' & ':' & ' ');
112 if C1 then
113 Set_NoDelay_Mode (Mode => True);
114 end if;
115 Add_With_Immediate_Echo (Ch => Code_To_Char (Key_Code (code)));
116 -- TODO check this
117 if C1 then
118 reply := Getchar;
119 while reply /= Key_None loop
120 Add (Ch => Code_To_Char (reply));
121 Nap_Milli_Seconds (10);
122 reply := Getchar;
123 end loop;
124 Set_NoDelay_Mode (Mode => False);
125 end if;
126 end;
127 end loop;
128 end show_upper_chars;
129
130 function show_1_acs (N : Integer;
131 name : String;
132 code : Attributed_Character)
133 return Integer is
134 height : constant Integer := 16;
135 row : constant Line_Position := Line_Position (4 + (N mod height));
136 col : constant Column_Position := Column_Position ((N / height) *
137 Integer (Columns) / 2);
138 tmpx : String (1 .. Integer (Columns) / 3);
139 begin
140 Ada.Strings.Fixed.Move (name, tmpx,
141 Justify => Ada.Strings.Right,
142 Drop => Ada.Strings.Left);
143 Add (Line => row, Column => col, Str => tmpx & ' ' & ':' & ' ');
144 -- we need more room than C because our identifiers are longer
145 -- 22 chars actually
146 Add (Ch => code);
147 return N + 1;
148 end show_1_acs;
149
150 procedure show_acs_chars is
151 n : Integer;
152 begin
153 Erase;
154 Switch_Character_Attribute
155 (Attr => (Bold_Character => True, others => False));
156 Add (Line => 0, Column => 20,
157 Str => "Display of the ACS Character Set");
158 Switch_Character_Attribute (On => False,
159 Attr => (Bold_Character => True,
160 others => False));
161 Refresh;
162
163 -- the following is useful to generate the below
164 -- grep '^[ ]*ACS_' ../src/terminal_interface-curses.ads |
165 -- awk '{print "n := show_1_acs(n, \""$1"\", ACS_Map("$1"));"}'
166
167 n := show_1_acs (0, "ACS_Upper_Left_Corner",
168 ACS_Map (ACS_Upper_Left_Corner));
169 n := show_1_acs (n, "ACS_Lower_Left_Corner",
170 ACS_Map (ACS_Lower_Left_Corner));
171 n := show_1_acs (n, "ACS_Upper_Right_Corner",
172 ACS_Map (ACS_Upper_Right_Corner));
173 n := show_1_acs (n, "ACS_Lower_Right_Corner",
174 ACS_Map (ACS_Lower_Right_Corner));
175 n := show_1_acs (n, "ACS_Left_Tee", ACS_Map (ACS_Left_Tee));
176 n := show_1_acs (n, "ACS_Right_Tee", ACS_Map (ACS_Right_Tee));
177 n := show_1_acs (n, "ACS_Bottom_Tee", ACS_Map (ACS_Bottom_Tee));
178 n := show_1_acs (n, "ACS_Top_Tee", ACS_Map (ACS_Top_Tee));
179 n := show_1_acs (n, "ACS_Horizontal_Line",
180 ACS_Map (ACS_Horizontal_Line));
181 n := show_1_acs (n, "ACS_Vertical_Line", ACS_Map (ACS_Vertical_Line));
182 n := show_1_acs (n, "ACS_Plus_Symbol", ACS_Map (ACS_Plus_Symbol));
183 n := show_1_acs (n, "ACS_Scan_Line_1", ACS_Map (ACS_Scan_Line_1));
184 n := show_1_acs (n, "ACS_Scan_Line_9", ACS_Map (ACS_Scan_Line_9));
185 n := show_1_acs (n, "ACS_Diamond", ACS_Map (ACS_Diamond));
186 n := show_1_acs (n, "ACS_Checker_Board", ACS_Map (ACS_Checker_Board));
187 n := show_1_acs (n, "ACS_Degree", ACS_Map (ACS_Degree));
188 n := show_1_acs (n, "ACS_Plus_Minus", ACS_Map (ACS_Plus_Minus));
189 n := show_1_acs (n, "ACS_Bullet", ACS_Map (ACS_Bullet));
190 n := show_1_acs (n, "ACS_Left_Arrow", ACS_Map (ACS_Left_Arrow));
191 n := show_1_acs (n, "ACS_Right_Arrow", ACS_Map (ACS_Right_Arrow));
192 n := show_1_acs (n, "ACS_Down_Arrow", ACS_Map (ACS_Down_Arrow));
193 n := show_1_acs (n, "ACS_Up_Arrow", ACS_Map (ACS_Up_Arrow));
194 n := show_1_acs (n, "ACS_Board_Of_Squares",
195 ACS_Map (ACS_Board_Of_Squares));
196 n := show_1_acs (n, "ACS_Lantern", ACS_Map (ACS_Lantern));
197 n := show_1_acs (n, "ACS_Solid_Block", ACS_Map (ACS_Solid_Block));
198 n := show_1_acs (n, "ACS_Scan_Line_3", ACS_Map (ACS_Scan_Line_3));
199 n := show_1_acs (n, "ACS_Scan_Line_7", ACS_Map (ACS_Scan_Line_7));
200 n := show_1_acs (n, "ACS_Less_Or_Equal", ACS_Map (ACS_Less_Or_Equal));
201 n := show_1_acs (n, "ACS_Greater_Or_Equal",
202 ACS_Map (ACS_Greater_Or_Equal));
203 n := show_1_acs (n, "ACS_PI", ACS_Map (ACS_PI));
204 n := show_1_acs (n, "ACS_Not_Equal", ACS_Map (ACS_Not_Equal));
205 n := show_1_acs (n, "ACS_Sterling", ACS_Map (ACS_Sterling));
206
207 if n = 0 then
208 raise Constraint_Error;
209 end if;
210 end show_acs_chars;
211
212 c1 : Key_Code;
213 c : Character := 'a';
214begin
215 loop
216 case c is
217 when 'a' =>
218 show_acs_chars;
219 when '0' | '1' | '2' | '3' =>
220 show_upper_chars (ctoi (c) * 32 + 128);
221 when others =>
222 null;
223 end case;
224 Add (Line => Lines - 3, Column => 0,
225 Str => "Note: ANSI terminals may not display C1 characters.");
226 Add (Line => Lines - 2, Column => 0,
227 Str => "Select: a=ACS, 0=C1, 1,2,3=GR characters, q=quit");
228 Refresh;
229 c1 := Getchar;
230 c := Code_To_Char (c1);
231 exit when c = 'q' or c = 'x';
232 end loop;
233 Pause;
234 Erase;
235 End_Windows;
236end ncurses2.acs_display;