ncurses 5.6 - patch 20080112
[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,2006 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.5 $
39 --  $Date: 2006/06/25 14:24:40 $
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 procedure ncurses2.color_edit is
47    use Int_IO;
48
49    type RGB_Enum is (Redx, Greenx, Bluex);
50
51    procedure change_color (current : Color_Number;
52                            field   : RGB_Enum;
53                            value   : RGB_Value;
54                            usebase : Boolean);
55
56    procedure change_color (current : Color_Number;
57                            field   : RGB_Enum;
58                            value   : RGB_Value;
59                            usebase : Boolean)  is
60       red, green, blue : RGB_Value;
61    begin
62       if usebase then
63          Color_Content (current, red, green, blue);
64       else
65          red := 0;
66          green := 0;
67          blue := 0;
68       end if;
69
70       case field is
71          when Redx => red :=  red + value;
72          when Greenx => green := green + value;
73          when Bluex => blue := blue + value;
74       end case;
75
76       declare
77       begin
78          Init_Color (current, red, green, blue);
79       exception
80          when Curses_Exception => Beep;
81       end;
82
83    end change_color;
84
85    package x is new ncurses2.genericPuts (100); use x;
86
87    tmpb : x.BS.Bounded_String;
88
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;
101 begin
102    Refresh;
103
104    for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
105       Init_Pair (Color_Pair (i), White, i);
106    end loop;
107
108    Move_Cursor (Line => Lines - 2, Column => 0);
109    Add (Str => "Number: ");
110    myPut (tmpb, Integer (value));
111    myAdd (Str => tmpb);
112
113    loop
114
115       Switch_Character_Attribute (On => False,
116                                   Attr => (Bold_Character => True,
117                                            others => False));
118       Add (Line => 0, Column => 20, Str => "Color RGB Value Editing");
119
120       Switch_Character_Attribute (On => False,
121                                   Attr => (Bold_Character => True,
122                                            others => False));
123
124       for i in Color_Number'(0) .. Color_Number (Number_Of_Colors) loop
125          Move_Cursor (Line => 2 + Line_Position (i), Column => 0);
126          if current = i then
127             Add (Ch => '>');
128          else
129             Add (Ch => ' ');
130          end if;
131          --  TODO if i <= color_names'Max  then
132          Put (tmp8, Integer (i));
133          Set_Character_Attributes (Color => Color_Pair (i));
134          Add (Str => "        ");
135          Set_Character_Attributes;
136
137          Refresh;
138
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,
144                                                  others => False));
145          end if;
146          Put (tmp4, Integer (red));
147          Add (Str => tmp4);
148          if current = i and field = Redx then
149             Set_Character_Attributes;
150          end if;
151          Add (Str => "   G = ");
152          if current = i and field =  Greenx then
153             Switch_Character_Attribute (On => True,
154                                         Attr => (Stand_Out => True,
155                                                  others => False));
156          end if;
157          Put (tmp4, Integer (green));
158          Add (Str => tmp4);
159          if current = i and field = Greenx then
160             Set_Character_Attributes;
161          end if;
162          Add (Str => "   B = ");
163          if current = i and field = Bluex then
164             Switch_Character_Attribute (On => True,
165                                         Attr => (Stand_Out => True,
166                                                  others => False));
167          end if;
168          Put (tmp4, Integer (blue));
169          Add (Str => tmp4);
170          if current = i and field = Bluex then
171             Set_Character_Attributes;
172          end if;
173          Set_Character_Attributes;
174          Add (ch => ')');
175       end loop;
176       Add (Line => Line_Position (Number_Of_Colors + 3), Column => 0,
177            Str => "Use up/down to select a color, left/right to change " &
178            "fields.");
179       Add (Line => Line_Position (Number_Of_Colors + 4), Column => 0,
180            Str => "Modify field by typing nnn=, nnn-, or nnn+.  ? for help.");
181
182       Move_Cursor (Line => 2 + Line_Position (current), Column => 0);
183
184       this_c := Getchar;
185       if Is_Digit (this_c) then
186          value := 0;
187       end if;
188
189       case this_c is
190          when KEY_UP =>
191             current := (current - 1) mod Color_Number (max_colors);
192          when KEY_DOWN =>
193             current := (current + 1) mod Color_Number (max_colors);
194          when KEY_RIGHT =>
195             field := RGB_Enum'Val ((RGB_Enum'Pos (field) + 1) mod 3);
196          when KEY_LEFT =>
197             field := RGB_Enum'Val ((RGB_Enum'Pos (field) - 1) mod 3);
198          when
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)));
210
211          when Character'Pos ('+') =>
212             change_color (current, field,  value, True);
213
214          when Character'Pos ('-') =>
215             change_color (current, field, -value, True);
216
217          when Character'Pos ('=') =>
218             change_color (current, field,  value, False);
219
220          when Character'Pos ('?') =>
221             Erase;
222             P ("                      RGB Value Editing Help");
223             P ("");
224             P ("You are in the RGB value editor.  Use the arrow keys to " &
225                "select one of");
226             P ("the fields in one of the RGB triples of the current colors;" &
227                " the one");
228             P ("currently selected will be reverse-video highlighted.");
229             P ("");
230             P ("To change a field, enter the digits of the new value; they" &
231                " are echoed");
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," &
235                " but finish");
236             P ("with a `+' or `-'.");
237             P ("");
238             P ("To quit, do `x' or 'q'");
239
240             Pause;
241             Erase;
242          when Character'Pos ('q') |
243            Character'Pos ('x') =>
244             null;
245          when others =>
246             Beep;
247       end case;
248       Move_Cursor (Line => Lines - 2, Column => 0);
249       Put (tmp6, Integer (value));
250       Add (Str => "Number: " & tmp6);
251
252       Clear_To_End_Of_Line;
253       exit when this_c = Character'Pos ('x') or
254         this_c = Character'Pos ('q');
255    end loop;
256
257    Erase;
258    End_Windows;
259 end ncurses2.color_edit;