1-----------------------------------------------------------------------
2--          GtkAda - Ada95 binding for the Gimp Toolkit              --
3--                                                                   --
4--                     Copyright (C) 2003                            --
5--        Emmanuel Briot, Joel Brobecker and Arnaud Charlet          --
6--                     Copyright (C) 2004-2005                       --
7--                           AdaCore                                 --
8--                                                                   --
9-- This library is free software; you can redistribute it and/or     --
10-- modify it under the terms of the GNU General Public               --
11-- License as published by the Free Software Foundation; either      --
12-- version 2 of the License, or (at your option) any later version.  --
13--                                                                   --
14-- This library is distributed in the hope that it will be useful,   --
15-- but WITHOUT ANY WARRANTY; without even the implied warranty of    --
16-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU --
17-- General Public License for more details.                          --
18--                                                                   --
19-- You should have received a copy of the GNU General Public         --
20-- License along with this library; if not, write to the             --
21-- Free Software Foundation, Inc., 59 Temple Place - Suite 330,      --
22-- Boston, MA 02111-1307, USA.                                       --
23--                                                                   --
24-- As a special exception, if other files instantiate generics from  --
25-- this unit, or you link this unit with other files to produce an   --
26-- executable, this  unit  does not  by itself cause  the resulting  --
27-- executable to be covered by the GNU General Public License. This  --
28-- exception does not however invalidate any other reasons why the   --
29-- executable file  might be covered by the  GNU Public License.     --
30-----------------------------------------------------------------------
31
32with Gtk;                use Gtk;
33with Gtk.Box;            use Gtk.Box;
34with Gtk.Button;         use Gtk.Button;
35with Gtk.Frame;          use Gtk.Frame;
36with Gtk.Widget;         use Gtk.Widget;
37with Gtkada.Multi_Paned; use Gtkada.Multi_Paned;
38with Gtk.Toolbar;        use Gtk.Toolbar;
39with Gtkada.Handlers;    use Gtkada.Handlers;
40with Gtk.Vbutton_Box;    use Gtk.Vbutton_Box;
41with Gtk.Toggle_Button;  use Gtk.Toggle_Button;
42with Gtk.Enums;          use Gtk.Enums;
43
44package body Create_Splittable is
45
46   function Create_Child
47      (Bar : Gtk_Toolbar; Title : String) return Gtk_Widget;
48   procedure On_Destroy (Button : access Gtk_Widget_Record'Class);
49   procedure On_Toggle  (Button : access Gtk_Widget_Record'Class);
50   procedure On_Resize  (Button : access Gtk_Widget_Record'Class);
51   procedure On_Split_V (Button : access Gtk_Widget_Record'Class);
52   procedure On_Split_H (Button : access Gtk_Widget_Record'Class);
53   procedure On_Fixed   (Button : access Gtk_Widget_Record'Class);
54   procedure On_Opaque  (Button : access Gtk_Widget_Record'Class);
55
56   Pane   : Gtkada_Multi_Paned;
57   Item   : Natural := 6;
58   Opaque : Boolean := False;
59
60   ----------
61   -- Help --
62   ----------
63
64   function Help return String is
65   begin
66      return "A Gtkada-specific widget, where children can be resized"
67        & " interactively by the user, as well as splitted.";
68   end Help;
69
70   ---------------
71   -- On_Opaque --
72   ---------------
73
74   procedure On_Opaque  (Button : access Gtk_Widget_Record'Class) is
75      pragma Unreferenced (Button);
76   begin
77      Opaque := not Opaque;
78      Set_Opaque_Resizing (Pane, Opaque);
79   end On_Opaque;
80
81   ----------------
82   -- On_Destroy --
83   ----------------
84
85   procedure On_Destroy (Button : access Gtk_Widget_Record'Class) is
86   begin
87      Destroy (Button);
88   end On_Destroy;
89
90   ---------------
91   -- On_Toggle --
92   ---------------
93
94   procedure On_Toggle (Button : access Gtk_Widget_Record'Class) is
95   begin
96      if Visible_Is_Set (Button) then
97         Hide (Button);
98      else
99         Show (Button);
100      end if;
101   end On_Toggle;
102
103   ---------------
104   -- On_Resize --
105   ---------------
106
107   procedure On_Resize (Button : access Gtk_Widget_Record'Class) is
108   begin
109      Set_Size (Pane, Button, 100, 100);
110   end On_Resize;
111
112   ----------------
113   -- On_Split_V --
114   ----------------
115
116   procedure On_Split_V (Button : access Gtk_Widget_Record'Class) is
117      Child : constant Gtk_Widget := Create_Child (null, Integer'Image (Item));
118   begin
119      Item := Item + 1;
120      Split (Pane, Button, Child, Orientation_Vertical);
121   end On_Split_V;
122
123   ----------------
124   -- On_Split_H --
125   ----------------
126
127   procedure On_Split_H (Button : access Gtk_Widget_Record'Class) is
128      Child : constant Gtk_Widget := Create_Child (null, Integer'Image (Item));
129   begin
130      Item := Item + 1;
131      Split (Pane, Button, Child, Orientation_Horizontal);
132   end On_Split_H;
133
134   --------------
135   -- On_Fixed --
136   --------------
137
138   procedure On_Fixed (Button : access Gtk_Widget_Record'Class) is
139   begin
140      Set_Size (Pane, Button,
141                Get_Allocation_Width (Button),
142                Get_Allocation_Height (Button),
143                Fixed_Size => True);
144   end On_Fixed;
145
146   ------------------
147   -- Create_Child --
148   ------------------
149
150   function Create_Child
151      (Bar : Gtk_Toolbar; Title : String) return Gtk_Widget
152   is
153      Frame  : Gtk_Frame;
154      Box    : Gtk_Vbutton_Box;
155      Button : Gtk_Button;
156      Item   : Gtk_Button;
157   begin
158      Gtk_New (Frame);
159
160      Gtk_New (Box);
161      Add (Frame, Box);
162      Set_Layout (Box, Buttonbox_Start);
163
164      Gtk_New (Button, "Destroy_" & Title);
165      Pack_Start (Box, Button, Expand => False);
166      Widget_Callback.Object_Connect
167        (Button, "clicked",
168         Widget_Callback.To_Marshaller (On_Destroy'Unrestricted_Access),
169         Frame);
170
171      Gtk_New (Button, "Resize_" & Title);
172      Pack_Start (Box, Button, Expand => False);
173      Widget_Callback.Object_Connect
174        (Button, "clicked",
175         Widget_Callback.To_Marshaller (On_Resize'Unrestricted_Access),
176         Frame);
177
178      Gtk_New (Button, "Split_V " & Title);
179      Pack_Start (Box, Button, Expand => False);
180      Widget_Callback.Object_Connect
181        (Button, "clicked",
182         Widget_Callback.To_Marshaller (On_Split_V'Unrestricted_Access),
183         Frame);
184
185      Gtk_New (Button, "Split_H " & Title);
186      Pack_Start (Box, Button, Expand => False);
187      Widget_Callback.Object_Connect
188        (Button, "clicked",
189         Widget_Callback.To_Marshaller (On_Split_H'Unrestricted_Access),
190         Frame);
191
192      Gtk_New (Button, "Fixed_Size " & Title);
193      Pack_Start (Box, Button, Expand => False);
194      Widget_Callback.Object_Connect
195        (Button, "clicked",
196         Widget_Callback.To_Marshaller (On_Fixed'Unrestricted_Access),
197         Frame);
198
199      if Bar /= null then
200         Gtk_New (Item, "Toggle_" & Title);
201         Add (Bar, Item);
202         Widget_Callback.Object_Connect
203           (Item, "clicked",
204            Widget_Callback.To_Marshaller (On_Toggle'Unrestricted_Access),
205            Frame);
206      end if;
207
208      Show_All (Frame);
209      return Gtk_Widget (Frame);
210   end Create_Child;
211
212   ---------
213   -- Run --
214   ---------
215
216   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
217      Button, Button1, Button2, Button3, Button4 : Gtk_Widget;
218      Bar    : Gtk_Toolbar;
219      Box    : Gtk_Box;
220      Toggle : Gtk_Toggle_Button;
221   begin
222      Gtk_New_Vbox (Box, Homogeneous => False);
223      Add (Frame, Box);
224
225      Gtk_New (Bar);
226      Pack_Start (Box, Bar, Expand => False);
227
228      Gtk_New (Toggle, "Opaque Resizing");
229      Pack_Start (Box, Toggle, Expand => False);
230      Widget_Callback.Connect (Toggle, "toggled", On_Opaque'Access);
231
232      Gtk_New (Pane);
233      Pack_Start (Box, Pane, Expand => True, Fill => True);
234
235      Button1 := Create_Child (Bar, "1");
236      Add_Child (Pane, Button1);
237
238      Button2 := Create_Child (Bar, "2");
239      Add_Child (Pane, Button2);  --  Should split horizontally
240
241      Button3 := Create_Child (Bar, "3");
242      Add_Child (Pane, Button3);  --  Should split horizontally
243
244      Button4 := Create_Child (Bar, "4");
245      Split (Pane, Button2, Button4, Orientation_Vertical);
246
247      Button := Create_Child (Bar, "5");
248      Split (Pane, Button4, Button, Orientation_Horizontal);
249
250      Show_All (Frame);
251   end Run;
252
253end Create_Splittable;
254
255