1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000-2006,2009 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: 2009/12/26 17:38:58 $
40 -- Binding Version 01.00
41 ------------------------------------------------------------------------------
42 with ncurses2
.util
; use ncurses2
.util
;
43 with ncurses2
.genericPuts
;
44 with Terminal_Interface
.Curses
; use Terminal_Interface
.Curses
;
46 procedure ncurses2
.color_edit
is
49 type RGB_Enum
is (Redx
, Greenx
, Bluex
);
51 procedure change_color
(current
: Color_Number
;
56 procedure change_color
(current
: Color_Number
;
60 red
, green
, blue
: RGB_Value
;
63 Color_Content
(current
, red
, green
, blue
);
71 when Redx
=> red
:= red
+ value
;
72 when Greenx
=> green
:= green
+ value
;
73 when Bluex
=> blue
:= blue
+ value
;
78 Init_Color
(current
, red
, green
, blue
);
80 when Curses_Exception
=> Beep
;
85 package x
is new ncurses2
.genericPuts
(100); use x
;
87 tmpb
: x
.BS
.Bounded_String
;
89 tmp4
: String (1 .. 4);
90 tmp6
: String (1 .. 6);
91 tmp8
: String (1 .. 8);
92 -- This would be easier if Ada had a Bounded_String
93 -- defined as a class instead of the inferior generic package,
94 -- then I could define Put, Add, and Get for them. Blech.
95 value
: RGB_Value
:= 0;
96 red
, green
, blue
: RGB_Value
;
97 max_colors
: constant Natural := Number_Of_Colors
;
98 current
: Color_Number
:= 0;
99 field
: RGB_Enum
:= Redx
;
100 this_c
: Key_Code
:= 0;
104 for i
in Color_Number
'(0) .. Color_Number (Number_Of_Colors) loop
105 Init_Pair (Color_Pair (i), White, i);
108 Move_Cursor (Line => Lines - 2, Column => 0);
109 Add (Str => "Number: ");
110 myPut (tmpb, Integer (value));
115 Switch_Character_Attribute (On => False,
116 Attr => (Bold_Character => True,
118 Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
120 Switch_Character_Attribute (On => False,
121 Attr => (Bold_Character => True,
124 for i in Color_Number'(0) .. Color_Number
(Number_Of_Colors
) loop
125 Move_Cursor
(Line
=> 2 + Line_Position
(i
), Column
=> 0);
131 -- TODO if i <= color_names'Max then
132 Put
(tmp8
, Integer (i
));
133 Set_Character_Attributes
(Color
=> Color_Pair
(i
));
135 Set_Character_Attributes
;
139 Color_Content
(i
, red
, green
, blue
);
140 Add
(Str
=> " R = ");
141 if current
= i
and field
= Redx
then
142 Switch_Character_Attribute
(On
=> True,
143 Attr
=> (Stand_Out
=> True,
146 Put
(tmp4
, Integer (red
));
148 if current
= i
and field
= Redx
then
149 Set_Character_Attributes
;
151 Add
(Str
=> " G = ");
152 if current
= i
and field
= Greenx
then
153 Switch_Character_Attribute
(On
=> True,
154 Attr
=> (Stand_Out
=> True,
157 Put
(tmp4
, Integer (green
));
159 if current
= i
and field
= Greenx
then
160 Set_Character_Attributes
;
162 Add
(Str
=> " B = ");
163 if current
= i
and field
= Bluex
then
164 Switch_Character_Attribute
(On
=> True,
165 Attr
=> (Stand_Out
=> True,
168 Put
(tmp4
, Integer (blue
));
170 if current
= i
and field
= Bluex
then
171 Set_Character_Attributes
;
173 Set_Character_Attributes
;
176 Add
(Line
=> Line_Position
(Number_Of_Colors
+ 3), Column
=> 0,
177 Str
=> "Use up/down to select a color, left/right to change " &
179 Add
(Line
=> Line_Position
(Number_Of_Colors
+ 4), Column
=> 0,
180 Str
=> "Modify field by typing nnn=, nnn-, or nnn+. ? for help.");
182 Move_Cursor
(Line
=> 2 + Line_Position
(current
), Column
=> 0);
185 if Is_Digit
(this_c
) then
191 current
:= (current
- 1) mod Color_Number
(max_colors
);
193 current
:= (current
+ 1) mod Color_Number
(max_colors
);
195 field
:= RGB_Enum
'Val ((RGB_Enum
'Pos (field
) + 1) mod 3);
197 field
:= RGB_Enum
'Val ((RGB_Enum
'Pos (field
) - 1) mod 3);
199 Character'Pos ('0') |
200 Character'Pos ('1') |
201 Character'Pos ('2') |
202 Character'Pos ('3') |
203 Character'Pos ('4') |
204 Character'Pos ('5') |
205 Character'Pos ('6') |
206 Character'Pos ('7') |
207 Character'Pos ('8') |
208 Character'Pos ('9') =>
209 value
:= value
* 10 + RGB_Value
(ctoi
(Code_To_Char
(this_c
)));
211 when Character'Pos ('+') =>
212 change_color
(current
, field
, value
, True);
214 when Character'Pos ('-') =>
215 change_color
(current
, field
, -value
, True);
217 when Character'Pos ('=') =>
218 change_color
(current
, field
, value
, False);
220 when Character'Pos ('?') =>
222 P
(" RGB Value Editing Help");
224 P
("You are in the RGB value editor. Use the arrow keys to " &
226 P
("the fields in one of the RGB triples of the current colors;" &
228 P
("currently selected will be reverse-video highlighted.");
230 P
("To change a field, enter the digits of the new value; they" &
232 P
("as entered. Finish by typing `='. The change will take" &
233 " effect instantly.");
234 P
("To increment or decrement a value, use the same procedure," &
236 P
("with a `+' or `-'.");
238 P
("To quit, do `x' or 'q'");
242 when Character'Pos ('q') |
243 Character'Pos ('x') =>
248 Move_Cursor
(Line
=> Lines
- 2, Column
=> 0);
249 Put
(tmp6
, Integer (value
));
250 Add
(Str
=> "Number: " & tmp6
);
252 Clear_To_End_Of_Line
;
253 exit when this_c
= Character'Pos ('x') or
254 this_c
= Character'Pos ('q');
259 end ncurses2
.color_edit
;