1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000 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 -- Binding Version 01.00
40 ------------------------------------------------------------------------------
41 with ncurses2.util; use ncurses2.util;
42 with ncurses2.genericPuts;
43 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;
58 procedure change_color (current : Color_Number;
62 red, green, blue : RGB_Value;
65 Color_Content (current, red, green, blue);
73 when Redx => red := red + value;
74 when Greenx => green := green + value;
75 when Bluex => blue := blue + value;
80 Init_Color (current, red, green, blue);
82 when Curses_Exception => Beep;
88 package x is new ncurses2.genericPuts (100); use x;
90 tmpb : x.BS.Bounded_String;
92 tmp4 : String (1 .. 4);
93 tmp6 : String (1 .. 6);
94 tmp8 : String (1 .. 8);
95 -- This would be easier if Ada had a Bounded_String
96 -- defined as a class instead of the inferior generic package,
97 -- then I could define Put, Add, and Get for them. Blech.
98 value : RGB_Value := 0;
99 red, green, blue : RGB_Value;
100 max_colors : constant Natural := Number_Of_Colors;
101 current : Color_Number := 0;
102 field : RGB_Enum := Redx;
103 this_c : Key_Code := 0;
108 for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
109 Init_Pair (Color_Pair (i), White, i);
112 Move_Cursor (Line => Lines - 2, Column => 0);
113 Add (Str => "Number: ");
114 myPut (tmpb, Integer (value));
119 Switch_Character_Attribute (On => False,
120 Attr => (Bold_Character => True,
122 Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
124 Switch_Character_Attribute (On => False,
125 Attr => (Bold_Character => True,
128 for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
129 Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
135 -- TODO if i <= color_names'Max then
136 Put (tmp8, Integer (i));
137 Set_Character_Attributes (Color => Color_Pair (i));
139 Set_Character_Attributes;
143 Color_Content (i, red, green, blue);
144 Add (Str => " R = ");
145 if current = i and field = Redx then
146 Switch_Character_Attribute (On => True,
147 Attr => (Stand_Out => True,
150 Put (tmp4, Integer (red));
152 if current = i and field = Redx then
153 Set_Character_Attributes;
155 Add (Str => " G = ");
156 if current = i and field = Greenx then
157 Switch_Character_Attribute (On => True,
158 Attr => (Stand_Out => True,
161 Put (tmp4, Integer (green));
163 if current = i and field = Greenx then
164 Set_Character_Attributes;
166 Add (Str => " B = ");
167 if current = i and field = Bluex then
168 Switch_Character_Attribute (On => True,
169 Attr => (Stand_Out => True,
172 Put (tmp4, Integer (blue));
174 if current = i and field = Bluex then
175 Set_Character_Attributes;
177 Set_Character_Attributes;
180 Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
181 Str => "Use up/down to select a color, left/right to change " &
183 Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
184 Str => "Modify field by typing nnn=, nnn-, or nnn+. ? for help.");
186 Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
190 if Is_Digit (this_c) then
196 current := (current - 1) mod Color_Number (max_colors);
198 current := (current + 1) mod Color_Number (max_colors);
200 field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
202 field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
204 Character'Pos ('0') |
205 Character'Pos ('1') |
206 Character'Pos ('2') |
207 Character'Pos ('3') |
208 Character'Pos ('4') |
209 Character'Pos ('5') |
210 Character'Pos ('6') |
211 Character'Pos ('7') |
212 Character'Pos ('8') |
213 Character'Pos ('9') =>
214 value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c)));
216 when Character'Pos ('+') =>
217 change_color (current, field, value, True);
219 when Character'Pos ('-') =>
220 change_color (current, field, -value, True);
222 when Character'Pos ('=') =>
223 change_color (current, field, value, False);
225 when Character'Pos ('?') =>
227 P (" RGB Value Editing Help");
229 P ("You are in the RGB value editor. Use the arrow keys to " &
231 P ("the fields in one of the RGB triples of the current colors;" &
233 P ("currently selected will be reverse-video highlighted.");
235 P ("To change a field, enter the digits of the new value; they" &
237 P ("as entered. Finish by typing `='. The change will take" &
238 " effect instantly.");
239 P ("To increment or decrement a value, use the same procedure," &
241 P ("with a `+' or `-'.");
243 P ("To quit, do `x' or 'q'");
247 when Character'Pos ('q') |
248 Character'Pos ('x') =>
253 Move_Cursor (Line => Lines - 2, Column => 0);
254 Put (tmp6, Integer (value));
255 Add (Str => "Number: " & tmp6);
257 Clear_To_End_Of_Line;
258 exit when this_c = Character'Pos ('x') or
259 this_c = Character'Pos ('q');
264 end ncurses2.color_edit;