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