ncurses 5.5
[ncurses.git] / Ada95 / samples / ncurses2-color_edit.adb
1 ------------------------------------------------------------------------------
2 --                                                                          --
3 --                       GNAT ncurses Binding Samples                       --
4 --                                                                          --
5 --                                 ncurses                                  --
6 --                                                                          --
7 --                                 B O D Y                                  --
8 --                                                                          --
9 ------------------------------------------------------------------------------
10 -- Copyright (c) 2000,2004 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.4 $
39 --  $Date: 2004/08/21 21:37:00 $
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;
45
46
47 procedure ncurses2.color_edit is
48    use Int_IO;
49
50    type RGB_Enum is (Redx, Greenx, Bluex);
51
52    procedure change_color (current : Color_Number;
53                            field   : RGB_Enum;
54                            value   : RGB_Value;
55                            usebase : Boolean);
56
57
58
59    procedure change_color (current : Color_Number;
60                            field   : RGB_Enum;
61                            value   : RGB_Value;
62                            usebase : Boolean)  is
63       red, green, blue : RGB_Value;
64    begin
65       if usebase then
66          Color_Content (current, red, green, blue);
67       else
68          red := 0;
69          green := 0;
70          blue := 0;
71       end if;
72
73       case field is
74          when Redx => red :=  red + value;
75          when Greenx => green := green + value;
76          when Bluex => blue := blue + value;
77       end case;
78
79       declare
80       begin
81          Init_Color (current, red, green, blue);
82       exception
83          when Curses_Exception => Beep;
84       end;
85
86    end change_color;
87
88
89    package x is new ncurses2.genericPuts (100); use x;
90
91    tmpb : x.BS.Bounded_String;
92
93    tmp4 : String (1 .. 4);
94    tmp6 : String (1 .. 6);
95    tmp8 : String (1 .. 8);
96    --  This would be easier if Ada had a Bounded_String
97    --  defined as a class instead of the inferior generic package,
98    --  then I could define Put, Add, and Get for them. Blech.
99    value : RGB_Value := 0;
100    red, green, blue : RGB_Value;
101    max_colors : constant Natural := Number_Of_Colors;
102    current : Color_Number := 0;
103    field : RGB_Enum := Redx;
104    this_c : Key_Code := 0;
105 begin
106    Refresh;
107
108    for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
109       Init_Pair (Color_Pair (i), White, i);
110    end loop;
111
112    Move_Cursor (Line => Lines - 2, Column => 0);
113    Add (Str => "Number: ");
114    myPut (tmpb, Integer (value));
115    myAdd (Str => tmpb);
116
117    loop
118
119       Switch_Character_Attribute (On => False,
120                                   Attr => (Bold_Character => True,
121                                            others => False));
122       Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
123
124       Switch_Character_Attribute (On => False,
125                                   Attr => (Bold_Character => True,
126                                            others => False));
127
128       for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
129          Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
130          if current = i then
131             Add (Ch => '>');
132          else
133             Add (Ch => ' ');
134          end if;
135          --  TODO if i <= color_names'Max  then
136          Put (tmp8, Integer (i));
137          Set_Character_Attributes (Color => Color_Pair (i));
138          Add (Str => "        ");
139          Set_Character_Attributes;
140
141          Refresh;
142
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,
148                                                  others => False));
149          end if;
150          Put (tmp4, Integer (red));
151          Add (Str => tmp4);
152          if current = i and field = Redx then
153             Set_Character_Attributes;
154          end if;
155          Add (Str => "   G = ");
156          if current = i and field =  Greenx then
157             Switch_Character_Attribute (On => True,
158                                         Attr => (Stand_Out => True,
159                                                  others => False));
160          end if;
161          Put (tmp4, Integer (green));
162          Add (Str => tmp4);
163          if current = i and field = Greenx then
164             Set_Character_Attributes;
165          end if;
166          Add (Str => "   B = ");
167          if current = i and field = Bluex then
168             Switch_Character_Attribute (On => True,
169                                         Attr => (Stand_Out => True,
170                                                  others => False));
171          end if;
172          Put (tmp4, Integer (blue));
173          Add (Str => tmp4);
174          if current = i and field = Bluex then
175             Set_Character_Attributes;
176          end if;
177          Set_Character_Attributes;
178          Add (ch => ')');
179       end loop;
180       Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
181            Str => "Use up/down to select a color, left/right to change " &
182            "fields.");
183       Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
184            Str => "Modify field by typing nnn=, nnn-, or nnn+.  ? for help.");
185
186       Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
187
188       this_c := Getchar;
189       if Is_Digit (this_c) then
190          value := 0;
191       end if;
192
193       case this_c is
194          when KEY_UP =>
195             current := (current - 1) mod Color_Number (max_colors);
196          when KEY_DOWN =>
197             current := (current + 1) mod Color_Number (max_colors);
198          when KEY_RIGHT =>
199             field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
200          when KEY_LEFT =>
201             field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
202          when
203            Character'Pos ('0') |
204            Character'Pos ('1') |
205            Character'Pos ('2') |
206            Character'Pos ('3') |
207            Character'Pos ('4') |
208            Character'Pos ('5') |
209            Character'Pos ('6') |
210            Character'Pos ('7') |
211            Character'Pos ('8') |
212            Character'Pos ('9')  =>
213             value := value * 10 + RGB_Value (ctoi (Code_To_Char (this_c)));
214
215          when Character'Pos ('+') =>
216             change_color (current, field,  value, True);
217
218          when Character'Pos ('-') =>
219             change_color (current, field, -value, True);
220
221          when Character'Pos ('=') =>
222             change_color (current, field,  value, False);
223
224          when Character'Pos ('?') =>
225             Erase;
226             P ("                      RGB Value Editing Help");
227             P ("");
228             P ("You are in the RGB value editor.  Use the arrow keys to " &
229                "select one of");
230             P ("the fields in one of the RGB triples of the current colors;" &
231                " the one");
232             P ("currently selected will be reverse-video highlighted.");
233             P ("");
234             P ("To change a field, enter the digits of the new value; they" &
235                " are echoed");
236             P ("as entered.  Finish by typing `='.  The change will take" &
237                " effect instantly.");
238             P ("To increment or decrement a value, use the same procedure," &
239                " but finish");
240             P ("with a `+' or `-'.");
241             P ("");
242             P ("To quit, do `x' or 'q'");
243
244             Pause;
245             Erase;
246          when Character'Pos ('q') |
247            Character'Pos ('x') =>
248             null;
249          when others =>
250             Beep;
251       end case;
252       Move_Cursor (Line => Lines - 2, Column => 0);
253       Put (tmp6, Integer (value));
254       Add (Str => "Number: " & tmp6);
255
256       Clear_To_End_Of_Line;
257       exit when this_c = Character'Pos ('x') or
258         this_c = Character'Pos ('q');
259    end loop;
260
261    Erase;
262    End_Windows;
263 end ncurses2.color_edit;