• Home
  • Line#
  • Scopes#
  • Navigate#
  • Raw
  • Download
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------------------------------------------------------------------------------
43with ncurses2.util; use ncurses2.util;
44with ncurses2.genericPuts;
45with Terminal_Interface.Curses; use Terminal_Interface.Curses;
46
47procedure 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;
102begin
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;
260end ncurses2.color_edit;
261