ncurses 5.6 - patch 20080112
[ncurses.git] / Ada95 / samples / ncurses2-color_test.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                                 ncurses                                  --
6 --                                                                          --
7 --                                 B O D Y                                  --
8 --                                                                          --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000,2006 Free Software Foundation, Inc.                   --
11 --                                                                          --
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:                 --
19 --                                                                          --
20 -- The above copyright notice and this permission notice shall be included  --
21 -- in all copies or substantial portions of the Software.                   --
22 --                                                                          --
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.                               --
30 --                                                                          --
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       --
34 -- authorization.                                                           --
35 ------------------------------------------------------------------------------
36 --  Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
37 --  Version Control
38 --  $Revision: 1.2 $
39 --  $Date: 2006/06/25 14:24:40 $
40 --  Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with ncurses2.util; use ncurses2.util;
43
44 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
45 with Ada.Strings.Fixed;
46
47 procedure ncurses2.color_test is
48    use Int_IO;
49
50    procedure show_color_name (y, x : Integer; color : Integer);
51
52    color_names : constant array (0 .. 15) of String (1 .. 7) :=
53      (
54       "black",
55       "red",
56       "green",
57       "yellow",
58       "blue",
59       "magenta",
60       "cyan",
61       "white",
62       "BLACK",
63       "RED",
64       "GREEN",
65       "YELLOW",
66       "BLUE",
67       "MAGENTA",
68       "CYAN",
69       "WHITE"
70       );
71
72    procedure show_color_name (y, x : Integer; color : Integer) is
73       tmp5 : String (1 .. 5);
74    begin
75       if Number_Of_Colors > 8 then
76
77          Put (tmp5, color);
78          Add (Line => Line_Position (y), Column => Column_Position (x),
79               Str => tmp5);
80       else
81          Add (Line => Line_Position (y), Column => Column_Position (x),
82               Str => color_names (color));
83       end if;
84    end show_color_name;
85
86    top, width : Integer;
87    hello : String (1 .. 5);
88    --  tmp3 : String (1 .. 3);
89    --  tmp2 : String (1 .. 2);
90
91 begin
92    Refresh;
93    Add (Str => "There are ");
94    --  Put(tmp3, Number_Of_Colors*Number_Of_Colors);
95    Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors *
96                                                       Number_Of_Colors),
97                                        Ada.Strings.Left));
98    Add (Str => " color pairs");
99    Add (Ch => newl);
100
101    if Number_Of_Colors > 8 then
102       width := 4;
103    else
104       width := 8;
105    end if;
106
107    if Number_Of_Colors > 8 then
108       hello := "Test";
109    else
110       hello := "Hello";
111    end if;
112
113    for Bright in Boolean loop
114       if Number_Of_Colors > 8 then
115          top := 0;
116       else
117          top := Boolean'Pos (Bright) * (Number_Of_Colors + 3);
118       end if;
119       Clear_To_End_Of_Screen;
120       Move_Cursor (Line => Line_Position (top) + 1, Column => 0);
121       --  Put(tmp2, Number_Of_Colors);
122       Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
123                                           Ada.Strings.Left));
124       Add (Ch => 'x');
125       Add (Str => Ada.Strings.Fixed.Trim (Integer'Image (Number_Of_Colors),
126                                           Ada.Strings.Left));
127       Add (Str => "  matrix of foreground/background colors, bright *");
128       if Bright then
129          Add (Str => "on");
130       else
131          Add (Str => "off");
132       end if;
133       Add (Ch => '*');
134
135       for i in 0 .. Number_Of_Colors - 1 loop
136          show_color_name (top + 2, (i + 1) * width, i);
137       end loop;
138       for i in 0 .. Number_Of_Colors - 1 loop
139          show_color_name (top + 3 + i, 0, i);
140       end loop;
141       for i in 1 .. Number_Of_Color_Pairs - 1 loop
142          Init_Pair (Color_Pair (i), Color_Number (i mod Number_Of_Colors),
143                     Color_Number (i / Number_Of_Colors));
144          --  attron((attr_t) COLOR_PAIR(i)) -- Huh?
145          Set_Color (Pair => Color_Pair (i));
146          if Bright then
147             Switch_Character_Attribute (Attr => (Bold_Character => True,
148                                                  others => False));
149          end if;
150          Add (Line => Line_Position (top + 3 + (i / Number_Of_Colors)),
151               Column => Column_Position ((i mod Number_Of_Colors + 1) *
152                                          width),
153               Str => hello);
154          Set_Character_Attributes;
155       end loop;
156       if Number_Of_Colors > 8 or Bright then
157          Pause;
158       end if;
159    end loop;
160
161    Erase;
162    End_Windows;
163 end ncurses2.color_test;