ecbf2903b507c517632f4b6588901531cc1ef4bc
[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 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.1 $
39 --  Binding Version 01.00
40 ------------------------------------------------------------------------------
41 with ncurses2.util; use ncurses2.util;
42
43 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
44 with Ada.Strings.Fixed;
45
46 procedure ncurses2.color_test is
47    use Int_IO;
48
49    procedure show_color_name (y, x : Integer; color : Integer);
50
51    color_names : constant array (0 .. 15) of String (1 .. 7) :=
52      (
53       "black",
54       "red",
55       "green",
56       "yellow",
57       "blue",
58       "magenta",
59       "cyan",
60       "white",
61       "BLACK",
62       "RED",
63       "GREEN",
64       "YELLOW",
65       "BLUE",
66       "MAGENTA",
67       "CYAN",
68       "WHITE"
69       );
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
87    top, width : Integer;
88    hello : String (1 .. 5);
89    --  tmp3 : String (1 .. 3);
90    --  tmp2 : String (1 .. 2);
91
92 begin
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;
164 end ncurses2.color_test;