1------------------------------------------------------------------------------
2--               GtkAda - Ada95 binding for the Gimp Toolkit                --
3--                                                                          --
4--                     Copyright (C) 2006-2015, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24with Gdk.Color;              use Gdk.Color;
25with Gdk.Pixbuf;             use Gdk.Pixbuf;
26with Glib;                   use Glib;
27with Glib.Object;            use Glib.Object;
28with Gtk.Box;                use Gtk.Box;
29with Gtk.Frame;              use Gtk.Frame;
30with Gtk.Cell_Renderer_Pixbuf; use Gtk.Cell_Renderer_Pixbuf;
31with Gtk.Cell_Renderer_Text;   use Gtk.Cell_Renderer_Text;
32with Gtk.Combo_Box_Text;     use Gtk.Combo_Box_Text;
33with Gtk.Combo_Box;          use Gtk.Combo_Box;
34with Gtk.Cell_Layout;        use Gtk.Cell_Layout;
35with Gtk.List_Store;         use Gtk.List_Store;
36with Gtk.Tooltip;            use Gtk.Tooltip;
37with Gtk.Tree_Model;         use Gtk.Tree_Model;
38with Gtk.Widget;             use Gtk.Widget;
39
40package body Create_Combo_Box is
41
42   Column_0 : constant := 0;
43   Column_1 : constant := 1;
44   Column_2 : constant := 2;
45   --  The columns in the model
46
47   procedure Append_Color_Pixbuf
48     (Model : Gtk_List_Store;
49      Color : String);
50   --  Append a new pixbuf with Color as its background
51
52   procedure Fill_Pixbuf (Pix : Gdk_Pixbuf; Color : String);
53   --  Fill the background of Pix. This is probably not some code you should
54   --  copy in your own application, since not very clean.
55
56   procedure Set_Color_Pixbuf
57     (Model : Gtk_List_Store; Iter : Gtk_Tree_Iter; Color : String);
58   --  Add a pixbuf to the second column of Model
59
60   function On_Query_Tooltip
61      (Widget        : access Gtk_Widget_Record'Class;
62       X, Y          : Gint;
63       Keyboard_Mode : Boolean;
64       Tooltip       : not null access Glib.Object.GObject_Record'Class)
65      return Boolean;
66   --  Compute an item specific tooltip for the first combo box
67
68   ----------
69   -- Help --
70   ----------
71
72   function Help return String is
73   begin
74      return "A @bGtk_Combo_Box@B is a widget that allows the user to choose"
75        & " from a list of valid choices.";
76   end Help;
77
78   -----------------
79   -- Fill_Pixbuf --
80   -----------------
81
82   procedure Fill_Pixbuf (Pix : Gdk_Pixbuf; Color : String) is
83      GColor : Gdk_Color;
84      Num     : Guint;
85      Pixels  : Rgb_Buffer_Access;
86   begin
87      GColor := Parse (Color);
88
89      --  This code is not clean. It would be better to use cairo, but GtkAda
90      --  has no binding for it at the time of this writing. You could also
91      --  load the images from XPM data instead.
92      Num    := Guint (Get_Width (Pix) * Get_Height (Pix));
93      Pixels := Get_Pixels (Pix);
94
95      for N in 0 .. Num - 1 loop
96         --  By default, each color occupies 8bits, thus is it easier to
97         --  manipulate colors
98         Pixels (N).Red   := Guchar (Red   (GColor) / 65535 * 255);
99         Pixels (N).Green := Guchar (Green (GColor) / 65535 * 255);
100         Pixels (N).Blue  := Guchar (Blue  (GColor) / 65535 * 255);
101      end loop;
102   end Fill_Pixbuf;
103
104   -------------------------
105   -- Append_Color_Pixbuf --
106   -------------------------
107
108   procedure Append_Color_Pixbuf
109     (Model : Gtk_List_Store;
110      Color : String)
111   is
112      Pix  : Gdk_Pixbuf;
113      Iter : Gtk_Tree_Iter;
114   begin
115      Pix := Gdk_New (Bits_Per_Sample => 8, Width => 16, Height => 16);
116      Fill_Pixbuf (Pix, Color);
117      Append (Model, Iter);
118      Set (Model, Iter, Column_0, Pix);
119      Unref (Pix);
120   end Append_Color_Pixbuf;
121
122   ----------------------
123   -- Set_Color_Pixbuf --
124   ----------------------
125
126   procedure Set_Color_Pixbuf
127     (Model : Gtk_List_Store; Iter : Gtk_Tree_Iter; Color : String)
128   is
129      Pix : Gdk_Pixbuf;
130   begin
131      Pix := Gdk_New (Bits_Per_Sample => 8, Width => 16, Height => 16);
132      Fill_Pixbuf (Pix, Color);
133      Set (Model, Iter, Column_1, Pix);
134      Unref (Pix);
135   end Set_Color_Pixbuf;
136
137   ----------------------
138   -- On_Query_Tooltip --
139   ----------------------
140
141   function On_Query_Tooltip
142      (Widget        : access Gtk_Widget_Record'Class;
143       X, Y          : Gint;
144       Keyboard_Mode : Boolean;
145       Tooltip       : not null access Glib.Object.GObject_Record'Class)
146      return Boolean
147   is
148      pragma Unreferenced (X, Y, Keyboard_Mode);
149      Combo : constant Gtk_Combo_Box := Gtk_Combo_Box (Widget);
150      Tip   : constant Gtk_Tooltip := Gtk_Tooltip (Tooltip);
151   begin
152      Tip.Set_Text ("This is the tooltip for the active item "
153                    & Gint'Image (Combo.Get_Active));
154      return True;  --  display the tooltip
155   end On_Query_Tooltip;
156
157   ---------
158   -- Run --
159   ---------
160
161   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
162      Box        : Gtk_Box;
163      Model      : Gtk_List_Store;
164      Iter       : Gtk_Tree_Iter;
165      Combo      : Gtk_Combo_Box;
166      TCombo      : Gtk_Combo_Box_Text;
167      Render     : Gtk_Cell_Renderer_Text;
168      Pix        : Gtk_Cell_Renderer_Pixbuf;
169   begin
170      Set_Label (Frame, "Combo box");
171
172      Gtk_New_Vbox (Box, Homogeneous => False);
173      Add (Frame, Box);
174
175      --  A simple text combo
176
177      Gtk_New (TCombo);
178      Pack_Start (Box, TCombo, Expand => False);
179      Append_Text (TCombo, "Simple Text Combo 1");
180      Append_Text (TCombo, "Simple Text Combo 2");
181      Append_Text (TCombo, "Simple Text Combo 3");
182      Set_Active (TCombo, 0);
183
184      --  Let's make the text of the combo box tooltip depend on which item
185      --  is selected. Unfortunately, there doesn't seem to be a way to set
186      --  a tooltip on the popup window itself, since we do not have access
187      --  to that window.
188
189      TCombo.Set_Tooltip_Text ("A general tooltip");
190      TCombo.On_Query_Tooltip (On_Query_Tooltip'Access);
191
192      --  A combo box with an entry, and some additional columns in the
193      --  popup
194
195      Gtk_New (Model, (Column_0 => GType_String,   --  text for the entry
196                       Column_1 => GType_String)); --  text for the popup
197
198      for Choice in 1 .. 10 loop
199         Model.Append (Iter);
200         Set (Model, Iter, Column_0, "Choice" & Integer'Image (Choice));
201         Set (Model, Iter, Column_1,
202              "Some explanation on choice" & Integer'Image (Choice));
203      end loop;
204
205      Gtk_New_With_Model_And_Entry (Combo, +Model);
206      Box.Pack_Start (Combo, Expand => False);
207
208      Gtk_New (Render);
209      Pack_Start    (+Combo, Render, Expand => True);
210      Add_Attribute (+Combo, Render, "markup", Column_1);
211
212      Combo.Set_Entry_Text_Column (Column_0);  --  before Set_Active
213      Combo.Set_Active (0);
214
215      --  A slightly different combo box, where the items are on multiple
216      --  lines. This doesn't quite replace a tooltip, but might be useful
217      --  anyway
218
219      Gtk_New (Model, (Column_0 => GType_String,   --  text for the entry
220                       Column_1 => GType_String)); --  text for the popup
221
222      for Choice in 1 .. 10 loop
223         Model.Append (Iter);
224         Set (Model, Iter, Column_0, "Choice" & Integer'Image (Choice));
225         Set (Model, Iter, Column_1,
226              "Choice" & Integer'Image (Choice) & ASCII.LF &
227              "<small>Some explanation on choice" & Integer'Image (Choice)
228              & "</small>");
229      end loop;
230
231      Gtk_New_With_Model (Combo, +Model);
232      Box.Pack_Start (Combo, Expand => False);
233
234      Gtk_New (Render);
235      Pack_Start    (+Combo, Render, Expand => True);
236      Add_Attribute (+Combo, Render, "markup", Column_1);
237
238      Combo.Set_Active (0);
239
240      --  Create a model. This is a set of rows, each with two columns in this
241      --  specific case.
242      Gtk_New (Model, (Column_0 => GType_String,
243                       Column_1 => Gdk.Pixbuf.Get_Type,
244                       Column_2 => GType_Boolean));
245
246      Append (Model, Iter);
247      Set (Model, Iter, Column_0, "Combo From Model 1");
248      Set_Color_Pixbuf (Model, Iter, "red");
249      Set (Model, Iter, Column_2, True);
250
251      Append (Model, Iter);
252      Set (Model, Iter, Column_0, "Combo From Model 2");
253      Set_Color_Pixbuf (Model, Iter, "green");
254      Set (Model, Iter, Column_2, False);  --  Row 2 will be insensitive
255
256      Append (Model, Iter);
257      Set (Model, Iter, Column_0, "Combo From Model 3");
258      Set_Color_Pixbuf (Model, Iter, "blue");
259      Set (Model, Iter, Column_2, True);
260
261      --  Create the combo. We use both columns of the model to display in the
262      --  model, but we could display only one, or even have a display that
263      --  doesn't come directly from a column (see create_cell_view for
264      --  instance)
265
266      Gtk_New_With_Model (Combo, +Model);
267      Pack_Start (Box, Combo, Expand => False);
268
269      Gtk_New (Pix);
270      Pack_Start    (+Combo, Pix, Expand => True);
271      Add_Attribute (+Combo, Pix, "pixbuf", Column_1);
272      Add_Attribute (+Combo, Pix, "sensitive", Column_2);
273
274      Gtk_New (Render);
275      Pack_Start    (+Combo, Render, Expand => True);
276      Add_Attribute (+Combo, Render, "text", Column_0);
277      Add_Attribute (+Combo, Render, "sensitive", Column_2);
278
279      Set_Active (Combo, 0);
280
281      --  A matrix combo now
282      Gtk_New (Model, (Column_0 => Gdk.Pixbuf.Get_Type));
283      Append_Color_Pixbuf (Model, "red");
284      Append_Color_Pixbuf (Model, "green");
285      Append_Color_Pixbuf (Model, "blue");
286      Append_Color_Pixbuf (Model, "yellow");
287      Append_Color_Pixbuf (Model, "black");
288      Append_Color_Pixbuf (Model, "white");
289      Append_Color_Pixbuf (Model, "cyan");
290      Append_Color_Pixbuf (Model, "pink");
291      Append_Color_Pixbuf (Model, "magenta");
292
293      Gtk_New_With_Model (Combo, +Model);
294      Pack_Start (Box, Combo, Expand => False);
295      Set_Wrap_Width (Combo, 3);  --  Make it a matrix
296
297      Gtk_New (Pix);
298      Pack_Start    (+Combo, Pix, Expand => True);
299      Add_Attribute (+Combo, Pix, "pixbuf", Column_0);
300
301      Set_Active (Combo, 0);
302
303      Show_All (Frame);
304   end Run;
305
306end Create_Combo_Box;
307