1 ------------------------------------------------------------------------------
3 -- GNAT ncurses Binding Samples --
9 ------------------------------------------------------------------------------
10 -- Copyright 2020 Thomas E. Dickey --
11 -- Copyright 2000-2006,2009 Free Software Foundation, Inc. --
13 -- Permission is hereby granted, free of charge, to any person obtaining a --
14 -- copy of this software and associated documentation files (the --
15 -- "Software"), to deal in the Software without restriction, including --
16 -- without limitation the rights to use, copy, modify, merge, publish, --
17 -- distribute, distribute with modifications, sublicense, and/or sell --
18 -- copies of the Software, and to permit persons to whom the Software is --
19 -- furnished to do so, subject to the following conditions: --
21 -- The above copyright notice and this permission notice shall be included --
22 -- in all copies or substantial portions of the Software. --
24 -- THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND, EXPRESS --
25 -- OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF --
26 -- MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT. --
27 -- IN NO EVENT SHALL THE ABOVE COPYRIGHT HOLDERS BE LIABLE FOR ANY CLAIM, --
28 -- DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT, TORT OR --
29 -- OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE SOFTWARE OR --
30 -- THE USE OR OTHER DEALINGS IN THE SOFTWARE. --
32 -- Except as contained in this notice, the name(s) of the above copyright --
33 -- holders shall not be used in advertising or otherwise to promote the --
34 -- sale, use or other dealings in this Software without prior written --
36 ------------------------------------------------------------------------------
37 -- Author: Eugene V. Melaragno <aldomel@ix.netcom.com> 2000
40 -- $Date: 2020/02/02 23:34:34 $
41 -- Binding Version 01.00
42 ------------------------------------------------------------------------------
43 with ncurses2.util; use ncurses2.util;
44 with ncurses2.genericPuts;
45 with Terminal_Interface.Curses; use Terminal_Interface.Curses;
47 procedure ncurses2.color_edit is
50 type RGB_Enum is (Redx, Greenx, Bluex);
52 procedure change_color (current : Color_Number;
57 procedure change_color (current : Color_Number;
61 red, green, blue : RGB_Value;
64 Color_Content (current, red, green, blue);
72 when Redx => red := red + value;
73 when Greenx => green := green + value;
74 when Bluex => blue := blue + value;
79 Init_Color (current, red, green, blue);
81 when Curses_Exception => Beep;
86 package x is new ncurses2.genericPuts (100); use x;
88 tmpb : x.BS.Bounded_String;
90 tmp4 : String (1 .. 4);
91 tmp6 : String (1 .. 6);
92 tmp8 : String (1 .. 8);
93 -- This would be easier if Ada had a Bounded_String
94 -- defined as a class instead of the inferior generic package,
95 -- then I could define Put, Add, and Get for them. Blech.
96 value : RGB_Value := 0;
97 red, green, blue : RGB_Value;
98 max_colors : constant Natural := Number_Of_Colors;
99 current : Color_Number := 0;
100 field : RGB_Enum := Redx;
101 this_c : Key_Code := 0;
105 for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
106 Init_Pair (Color_Pair (i), White, i);
109 Move_Cursor (Line => Lines - 2, Column => 0);
110 Add (Str => "Number: ");
111 myPut (tmpb, Integer (value));
116 Switch_Character_Attribute (On => False,
117 Attr => (Bold_Character => True,
119 Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
121 Switch_Character_Attribute (On => False,
122 Attr => (Bold_Character => True,
125 for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
126 Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
132 -- TODO if i <= color_names'Max then
133 Put (tmp8, Integer (i));
134 Set_Character_Attributes (Color => Color_Pair (i));
136 Set_Character_Attributes;
140 Color_Content (i, red, green, blue);
141 Add (Str => " R = ");
142 if current = i and field = Redx then
143 Switch_Character_Attribute (On => True,
144 Attr => (Stand_Out => True,
147 Put (tmp4, Integer (red));
149 if current = i and field = Redx then
150 Set_Character_Attributes;
152 Add (Str => " G = ");
153 if current = i and field = Greenx then
154 Switch_Character_Attribute (On => True,
155 Attr => (Stand_Out => True,
158 Put (tmp4, Integer (green));
160 if current = i and field = Greenx then
161 Set_Character_Attributes;
163 Add (Str => " B = ");
164 if current = i and field = Bluex then
165 Switch_Character_Attribute (On => True,
166 Attr => (Stand_Out => True,
169 Put (tmp4, Integer (blue));
171 if current = i and field = Bluex then
172 Set_Character_Attributes;
174 Set_Character_Attributes;
177 Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
178 Str => "Use up/down to select a color, left/right to change " &
180 Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
181 Str => "Modify field by typing nnn=, nnn-, or nnn+. ? for help.");
183 Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
186 if Is_Digit (this_c) then
192 current := (current - 1) mod Color_Number (max_colors);
194 current := (current + 1) mod Color_Number (max_colors);
196 field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
198 field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
200 Character'Pos ('0') |
201 Character'Pos ('1') |
202 Character'Pos ('2') |
203 Character'Pos ('3') |
204 Character'Pos ('4') |
205 Character'Pos ('5') |
206 Character'Pos ('6') |
207 Character'Pos ('7') |
208 Character'Pos ('8') |
209 Character'Pos ('9') =>
210 value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c)));
212 when Character'Pos ('+') =>
213 change_color (current, field, value, True);
215 when Character'Pos ('-') =>
216 change_color (current, field, -value, True);
218 when Character'Pos ('=') =>
219 change_color (current, field, value, False);
221 when Character'Pos ('?') =>
223 P (" RGB Value Editing Help");
225 P ("You are in the RGB value editor. Use the arrow keys to " &
227 P ("the fields in one of the RGB triples of the current colors;" &
229 P ("currently selected will be reverse-video highlighted.");
231 P ("To change a field, enter the digits of the new value; they" &
233 P ("as entered. Finish by typing `='. The change will take" &
234 " effect instantly.");
235 P ("To increment or decrement a value, use the same procedure," &
237 P ("with a `+' or `-'.");
239 P ("To quit, do `x' or 'q'");
243 when Character'Pos ('q') |
244 Character'Pos ('x') =>
249 Move_Cursor (Line => Lines - 2, Column => 0);
250 Put (tmp6, Integer (value));
251 Add (Str => "Number: " & tmp6);
253 Clear_To_End_Of_Line;
254 exit when this_c = Character'Pos ('x') or
255 this_c = Character'Pos ('q');
260 end ncurses2.color_edit;