• 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.4 $
40--  $Date: 2020/02/02 23:34:34 $
41--  Binding Version 01.00
42------------------------------------------------------------------------------
43with ncurses2.util; use ncurses2.util;
44
45with Terminal_Interface.Curses; use Terminal_Interface.Curses;
46with Ada.Strings.Fixed;
47
48procedure ncurses2.color_test is
49   use Int_IO;
50
51   procedure show_color_name (y, x : Integer; color : Integer);
52
53   color_names : constant array (0 .. 15) of String (1 .. 7) :=
54     (
55      "black  ",
56      "red    ",
57      "green  ",
58      "yellow ",
59      "blue   ",
60      "magenta",
61      "cyan   ",
62      "white  ",
63      "BLACK  ",
64      "RED    ",
65      "GREEN  ",
66      "YELLOW ",
67      "BLUE   ",
68      "MAGENTA",
69      "CYAN   ",
70      "WHITE  "
71      );
72
73   procedure show_color_name (y, x : Integer; color : Integer) is
74      tmp5 : String (1 .. 5);
75   begin
76      if Number_Of_Colors > 8 then
77
78         Put (tmp5, color);
79         Add (Line => Line_Position (y), Column => Column_Position (x),
80              Str => tmp5);
81      else
82         Add (Line => Line_Position (y), Column => Column_Position (x),
83              Str => color_names (color));
84      end if;
85   end show_color_name;
86
87   top, width : Integer;
88   hello : String (1 .. 5);
89   --  tmp3 : String (1 .. 3);
90   --  tmp2 : String (1 .. 2);
91
92begin
93   Refresh;
94   Add (Str => "There are ");
95   --  Put(tmp3, Number_Of_Colors*Number_Of_Colors);
96   Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors *
97                                                      Number_Of_Colors),
98                                       Ada.Strings.Left));
99   Add (Str => " color pairs");
100   Add (Ch => newl);
101
102   if Number_Of_Colors > 8 then
103      width := 4;
104   else
105      width := 8;
106   end if;
107
108   if Number_Of_Colors > 8 then
109      hello := "Test ";
110   else
111      hello := "Hello";
112   end if;
113
114   for Bright in Boolean loop
115      if Number_Of_Colors > 8 then
116         top := 0;
117      else
118         top := Boolean'Pos (Bright) * (Number_Of_Colors + 3);
119      end if;
120      Clear_To_End_Of_Screen;
121      Move_Cursor (Line => Line_Position (top) + 1, Column => 0);
122      --  Put(tmp2, Number_Of_Colors);
123      Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
124                                          Ada.Strings.Left));
125      Add (Ch => 'x');
126      Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
127                                          Ada.Strings.Left));
128      Add (Str => "  matrix of foreground/background colors, bright *");
129      if Bright then
130         Add (Str => "on");
131      else
132         Add (Str => "off");
133      end if;
134      Add (Ch => '*');
135
136      for i in 0 .. Number_Of_Colors - 1 loop
137         show_color_name (top + 2, (i + 1) * width, i);
138      end loop;
139      for i in 0 .. Number_Of_Colors - 1 loop
140         show_color_name (top + 3 + i, 0, i);
141      end loop;
142      for i in 1 .. Number_Of_Color_Pairs - 1 loop
143         Init_Pair (Color_Pair (i), Color_Number (i mod Number_Of_Colors),
144                    Color_Number (i / Number_Of_Colors));
145         --  attron((attr_t) COLOR_PAIR(i)) -- Huh?
146         Set_Color (Pair => Color_Pair (i));
147         if Bright then
148            Switch_Character_Attribute (Attr => (Bold_Character => True,
149                                                 others => False));
150         end if;
151         Add (Line => Line_Position (top + 3 + (i / Number_Of_Colors)),
152              Column => Column_Position ((i mod Number_Of_Colors + 1) *
153                                         width),
154              Str => hello);
155         Set_Character_Attributes;
156      end loop;
157      if Number_Of_Colors > 8 or Bright then
158         Pause;
159      end if;
160   end loop;
161
162   Erase;
163   End_Windows;
164end ncurses2.color_test;
165