1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2006,2008 Free Software Foundation, Inc. --
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: --
20 -- The above copyright notice and this permission notice shall be included --
21 -- in all copies or substantial portions of the Software. --
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. --
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 --
35 ------------------------------------------------------------------------------
36 -- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
39 -- $Date: 2008/07/26 18:47:17 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with ncurses2
.util
; use ncurses2
.util
;
44 with Terminal_Interface
.Curses
; use Terminal_Interface
.Curses
;
45 with Ada
.Strings
.Fixed
;
47 procedure ncurses2
.color_test
is
50 procedure show_color_name
(y
, x
: Integer; color
: Integer);
52 color_names
: constant array (0 .. 15) of String (1 .. 7) :=
72 procedure show_color_name
(y
, x
: Integer; color
: Integer) is
73 tmp5
: String (1 .. 5);
75 if Number_Of_Colors
> 8 then
78 Add
(Line
=> Line_Position
(y
), Column
=> Column_Position
(x
),
81 Add
(Line
=> Line_Position
(y
), Column
=> Column_Position
(x
),
82 Str
=> color_names
(color
));
87 hello
: String (1 .. 5);
88 -- tmp3 : String (1 .. 3);
89 -- tmp2 : String (1 .. 2);
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
*
98 Add
(Str
=> " color pairs");
101 if Number_Of_Colors
> 8 then
107 if Number_Of_Colors
> 8 then
113 for Bright
in Boolean loop
114 if Number_Of_Colors
> 8 then
117 top
:= Boolean'Pos (Bright
) * (Number_Of_Colors
+ 3);
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
),
125 Add
(Str
=> Ada
.Strings
.Fixed
.Trim
(Integer'Image (Number_Of_Colors
),
127 Add
(Str
=> " matrix of foreground/background colors, bright *");
135 for i
in 0 .. Number_Of_Colors
- 1 loop
136 show_color_name
(top
+ 2, (i
+ 1) * width
, i
);
138 for i
in 0 .. Number_Of_Colors
- 1 loop
139 show_color_name
(top
+ 3 + i
, 0, i
);
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
));
147 Switch_Character_Attribute
(Attr
=> (Bold_Character
=> True,
150 Add
(Line
=> Line_Position
(top
+ 3 + (i
/ Number_Of_Colors
)),
151 Column
=> Column_Position
((i
mod Number_Of_Colors
+ 1) *
154 Set_Character_Attributes
;
156 if Number_Of_Colors
> 8 or Bright
then
163 end ncurses2
.color_test
;