• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
1------------------------------------------------------------------------------
2--                                                                          --
3--                       GNAT ncurses Binding Samples                       --
4--                                                                          --
5--                                 ncurses                                  --
6--                                                                          --
7--                                 B O D Y                                  --
8--                                                                          --
9------------------------------------------------------------------------------
10-- Copyright 2020 Thomas E. Dickey                                          --
11-- Copyright 2000-2006,2008 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.7 $
40--  $Date: 2020/02/02 23:34:34 $
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;
237