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