1----------------------------------------------------------------------- 2-- GtkAda - Ada95 binding for Gtk+/Gnome -- 3-- -- 4-- Copyright (C) 2011-2013, AdaCore -- 5-- -- 6-- This library is free software; you can redistribute it and/or -- 7-- modify it under the terms of the GNU General Public -- 8-- License as published by the Free Software Foundation; either -- 9-- version 2 of the License, or (at your option) any later version. -- 10-- -- 11-- This library is distributed in the hope that it will be useful, -- 12-- but WITHOUT ANY WARRANTY; without even the implied warranty of -- 13-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU -- 14-- General Public License for more details. -- 15-- -- 16-- You should have received a copy of the GNU General Public -- 17-- License along with this library; if not, write to the -- 18-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, -- 19-- Boston, MA 02111-1307, USA. -- 20-- -- 21-- As a special exception, if other files instantiate generics from -- 22-- this unit, or you link this unit with other files to produce an -- 23-- executable, this unit does not by itself cause the resulting -- 24-- executable to be covered by the GNU General Public License. This -- 25-- exception does not however invalidate any other reasons why the -- 26-- executable file might be covered by the GNU Public License. -- 27----------------------------------------------------------------------- 28 29with Ada.Numerics; use Ada.Numerics; 30 31with Cairo.Pattern; use Cairo.Pattern; 32 33with Glib; use Glib; 34 35separate (Gtkada.MDI) 36package body Close_Button is 37 38 type Cairo_Color is record 39 R, G, B : Gdouble; 40 end record; 41 42 function Shade 43 (Color : Gdk_Color; 44 Value : Gdouble) return Cairo_Color; 45 46 function On_Draw 47 (Widget : access Gtk_Widget_Record'Class; Event : Gdk_Event) 48 return Boolean; 49 -- draws the close button upon expose event 50 51 procedure Rounded_Rectangle 52 (Cr : Cairo_Context; 53 X, Y, W, H : Gdouble; 54 Radius : Gdouble); 55 -- Draws a rounded rectangle at coordinate X, Y with W and H size. 56 57 procedure Cross 58 (Cr : Cairo_Context; 59 W, Size, Thin : Gdouble); 60 -- Draws a cross centered on W / 2.0 of current size and thin. 61 62 function On_Tab_Enter 63 (Widget : access Gtk_Widget_Record'Class; 64 Event : Gdk_Event_Crossing) 65 return Boolean; 66 67 function On_Tab_Leave 68 (Widget : access Gtk_Widget_Record'Class; 69 Event : Gdk_Event_Crossing) 70 return Boolean; 71 72 function On_Enter 73 (Widget : access Gtk_Widget_Record'Class; 74 Event : Gdk_Event_Crossing) 75 return Boolean; 76 77 function On_Leave 78 (Widget : access Gtk_Widget_Record'Class; 79 Event : Gdk_Event_Crossing) 80 return Boolean; 81 82 function On_Mouse_Pressed 83 (Widget : access Gtk_Widget_Record'Class; 84 Event : Gdk_Event_Button) 85 return Boolean; 86 87 function On_Mouse_Released 88 (Widget : access Gtk_Widget_Record'Class; 89 Event : Gdk_Event_Button) 90 return Boolean; 91 92 procedure Invalidate (Widget : access Gtk_Widget_Record'Class); 93 -- Invalidates the whole widget for queing a redraw 94 95 ------------- 96 -- Gtk_New -- 97 ------------- 98 99 procedure Gtk_New 100 (Button : out Gtkada_MDI_Close_Button; 101 Tab : access Gtk_Widget_Record'Class; 102 Child : access MDI_Child_Record'Class; 103 In_Titlebar : Boolean) 104 is 105 begin 106 Button := new Gtkada_MDI_Close_Button_Record; 107 Gtk.Event_Box.Initialize (Button); 108 Set_Visible_Window (Button, False); 109 110 Button.Child := MDI_Child (Child); 111 Button.Pressed := False; 112 Button.Over := False; 113 Button.Tab_Over := False; 114 Button.In_Titlebar := In_Titlebar; 115 116 -- In the titlebar, we can go up to 16px as this is the size of the 117 -- pixmaps, but we lower this size to 14px to be able to draw the extra 118 -- border for the hilight. 119 120 -- In the tab, we keep it small however so that this does not take too 121 -- much space. 122 if In_Titlebar then 123 Button.Default_Size := 14; 124 else 125 Button.Default_Size := 11; 126 end if; 127 128 Set_Size_Request (Button, Button.Default_Size, Button.Default_Size + 4); 129 Set_Events 130 (Button, 131 Get_Events (Button) or Pointer_Motion_Mask or 132 Button_Press_Mask or Button_Release_Mask or 133 Enter_Notify_Mask or Leave_Notify_Mask); 134 Return_Callback.Connect 135 (Button, Signal_Expose_Event, 136 Return_Callback.To_Marshaller (On_Draw'Access)); 137 Return_Callback.Connect 138 (Button, Signal_Enter_Notify_Event, 139 Return_Callback.To_Marshaller (On_Enter'Access)); 140 Return_Callback.Connect 141 (Button, Signal_Leave_Notify_Event, 142 Return_Callback.To_Marshaller (On_Leave'Access)); 143 Return_Callback.Object_Connect 144 (Tab, Signal_Enter_Notify_Event, 145 Return_Callback.To_Marshaller (On_Tab_Enter'Access), 146 Slot_Object => Button); 147 Return_Callback.Object_Connect 148 (Tab, Signal_Leave_Notify_Event, 149 Return_Callback.To_Marshaller (On_Tab_Leave'Access), 150 Slot_Object => Button); 151 Return_Callback.Connect 152 (Button, Signal_Button_Press_Event, 153 Return_Callback.To_Marshaller (On_Mouse_Pressed'Access)); 154 Return_Callback.Connect 155 (Button, Signal_Button_Release_Event, 156 Return_Callback.To_Marshaller (On_Mouse_Released'Access)); 157 end Gtk_New; 158 159 ------------- 160 -- On_Draw -- 161 ------------- 162 163 function On_Draw 164 (Widget : access Gtk_Widget_Record'Class; Event : Gdk_Event) 165 return Boolean 166 is 167 pragma Unreferenced (Event); 168 169 Button : constant Gtkada_MDI_Close_Button := 170 Gtkada_MDI_Close_Button (Widget); 171 Cr : Cairo_Context; 172 Alpha : Gdouble; 173 X, Y : Gint; 174 Width : Gint; 175 Height : Gint; 176 dW : Gdouble; 177 Cross_W : Gdouble; 178 Bg : Gdk_Color; 179 Base : Cairo_Color; 180 Lo, Hi : Cairo_Color; 181 Ptrn : Cairo_Pattern; 182 Note : constant Gtk_Notebook := 183 Gtk_Notebook (Get_Parent (Button.Child)); 184 185 begin 186 if not Button.In_Titlebar 187 and then not Button.Tab_Over 188 and then not Button.Over 189 then 190 return True; 191 end if; 192 193 if Realized_Is_Set (Button) then 194 X := Get_Allocation_X (Button); 195 Y := Get_Allocation_Y (Button); 196 Width := Get_Allocation_Width (Button); 197 Height := Get_Allocation_Height (Button); 198 199 dW := Gdouble (Button.Default_Size); 200 201 -- Make sure the button fits in the allocated space 202 if dW > Gdouble (Width) then 203 dW := Gdouble (Width); 204 end if; 205 206 -- Height - 4 : we want at least 1 px margin (so *2) + 1px for the 207 -- thin hilight effect at the bottom of the button. We add another px 208 -- to center the button (compensate the hilight size). 209 if dW > Gdouble (Height - 4) then 210 dW := Gdouble (Height - 4); 211 end if; 212 213 X := X + Width - Gint (dW); 214 Y := Y + (Height - Gint (dW)) / 2; 215 216 Cr := Create (Get_Window (Button)); 217 218 Cairo.Set_Line_Width (Cr, 1.0); 219 Cairo.Translate (Cr, Gdouble (X), Gdouble (Y)); 220 Cross_W := dW * 0.7; 221 222 -- Retrieve the parent's actual background color for a nice 223 -- transparency effect 224 if Button.Child.MDI.Focus_Child = Button.Child then 225 Bg := Button.Child.MDI.Focus_Title_Color; 226 elsif Button.In_Titlebar 227 and then Get_Current_Page (Note) = Page_Num (Note, Button.Child) 228 then 229 Bg := Button.Child.MDI.Title_Bar_Color; 230 else 231 Bg := Gtk.Style.Get_Bg (Get_Style (Button.Child), State_Normal); 232 end if; 233 234 -- Shade the color according to the button's state 235 if Button.Pressed then 236 Base := Shade (Bg, 0.5); 237 Alpha := 1.0; 238 elsif Button.Over then 239 Base := Shade (Bg, 0.65); 240 Alpha := 1.0; 241 else 242 Base := Shade (Bg, 0.8); 243 Alpha := 0.6; 244 end if; 245 246 Lo := Shade (Bg, 0.6); 247 Hi := Shade (Bg, 1.25); 248 249 -- Clip the cross 250 Cairo.Set_Fill_Rule (Cr, Cairo_Fill_Rule_Even_Odd); 251 Cairo.Rectangle 252 (Cr, -1.0, -1.0, dW + 2.0, dW + 2.0); 253 Cross (Cr, dW, Cross_W, dW / 5.0); 254 Cairo.Clip (Cr); 255 Cairo.Set_Fill_Rule (Cr, Cairo_Fill_Rule_Winding); 256 257 -- Now actually draw the button 258 259 -- Fill the base color 260 Cairo.Set_Source_Rgba (Cr, Base.R, Base.G, Base.B, Alpha); 261 Rounded_Rectangle (Cr, 0.0, 0.0, dW, dW, 2.5); 262 Cairo.Fill (Cr); 263 264 -- Add some radial shadow to simulate shadow under the cross 265 Ptrn := Cairo.Pattern.Create_Radial 266 (dW * 0.5, dW * 0.5, 2.0, dW * 0.5, dW * 0.5, Cross_W / 2.0); 267 Cairo.Pattern.Add_Color_Stop_Rgba 268 (Ptrn, 0.0, Lo.R, Lo.G, Lo.B, Alpha); 269 Cairo.Pattern.Add_Color_Stop_Rgba 270 (Ptrn, 1.0, Lo.R, Lo.G, Lo.B, 0.0); 271 Rounded_Rectangle (Cr, 0.0, 0.0, dW, dW, 2.5); 272 Cairo.Set_Source (Cr, Ptrn); 273 Cairo.Pattern.Destroy (Ptrn); 274 Cairo.Fill (Cr); 275 276 -- Add a hilighted border with height bigger than shadowed border 277 -- to just display a thin hilighted border under the button 278 Cairo.Set_Source_Rgba (Cr, Hi.R, Hi.G, Hi.B, Alpha); 279 Rounded_Rectangle (Cr, 0.5, 0.5, dW - 1.0, dW, 2.5); 280 Cairo.Stroke (Cr); 281 282 -- Now add the shadowed border 283 Cairo.Set_Source_Rgba (Cr, Lo.R, Lo.G, Lo.B, Alpha); 284 Rounded_Rectangle (Cr, 0.5, 0.5, dW - 1.0, dW - 1.0, 2.5); 285 Cairo.Stroke (Cr); 286 287 Cairo.Destroy (Cr); 288 end if; 289 290 return True; 291 end On_Draw; 292 293 ----------- 294 -- Shade -- 295 ----------- 296 297 function Shade 298 (Color : Gdk_Color; 299 Value : Gdouble) return Cairo_Color 300 is 301 Ret : Cairo_Color; 302 begin 303 Ret := 304 (R => Gdouble (Red (Color)) / 65535.0 * Value, 305 G => Gdouble (Green (Color)) / 65535.0 * Value, 306 B => Gdouble (Blue (Color)) / 65535.0 * Value); 307 308 if Value > 1.0 then 309 if Ret.R > 1.0 then 310 Ret.R := 1.0; 311 end if; 312 313 if Ret.G > 1.0 then 314 Ret.G := 1.0; 315 end if; 316 317 if Ret.B > 1.0 then 318 Ret.B := 1.0; 319 end if; 320 end if; 321 322 return Ret; 323 end Shade; 324 325 ----------------------- 326 -- Rounded_Rectangle -- 327 ----------------------- 328 329 procedure Rounded_Rectangle 330 (Cr : Cairo_Context; 331 X, Y, W, H : Gdouble; 332 Radius : Gdouble) is 333 begin 334 Cairo.Move_To (Cr, X + Radius, Y); 335 Cairo.Arc 336 (Cr, X + W - Radius, Y + Radius, Radius, Pi * 1.5, Pi * 2.0); 337 Cairo.Arc 338 (Cr, X + W - Radius, Y + H - Radius, Radius, 0.0, Pi * 0.5); 339 Cairo.Arc 340 (Cr, X + Radius, Y + H - Radius, Radius, Pi * 0.5, Pi); 341 Cairo.Arc 342 (Cr, X + Radius, Y + Radius, Radius, Pi, Pi * 1.5); 343 end Rounded_Rectangle; 344 345 ----------- 346 -- Cross -- 347 ----------- 348 349 procedure Cross 350 (Cr : Cairo_Context; 351 W, Size, Thin : Gdouble) 352 is 353 Matrix : aliased Cairo_Matrix; 354 begin 355 Cairo.Get_Matrix (Cr, Matrix'Access); 356 357 -- 10+--+9 358 -- 11| |8 359 -- 12 +--+ +--+ 7 360 -- | | 361 -- 1 +--+ +--+ 6 362 -- 2| |5 363 -- 3+--+4 364 -- 365 -- <--> 366 -- Thin 367 -- 368 -- <--------> 369 -- Size 370 371 Cairo.Translate (Cr, W / 2.0, W / 2.0); 372 Cairo.Rotate (Cr, Pi * 0.25); 373 Cairo.Move_To (Cr, -Size / 2.0, -Thin / 2.0); -- 1 374 Cairo.Line_To (Cr, -Thin / 2.0, -Thin / 2.0); -- 2 375 Cairo.Line_To (Cr, -Thin / 2.0, -Size / 2.0); -- 3 376 Cairo.Line_To (Cr, Thin / 2.0, -Size / 2.0); -- 4 377 Cairo.Line_To (Cr, Thin / 2.0, -Thin / 2.0); -- 5 378 Cairo.Line_To (Cr, Size / 2.0, -Thin / 2.0); -- 6 379 Cairo.Line_To (Cr, Size / 2.0, Thin / 2.0); -- 7 380 Cairo.Line_To (Cr, Thin / 2.0, Thin / 2.0); -- 8 381 Cairo.Line_To (Cr, Thin / 2.0, Size / 2.0); -- 9 382 Cairo.Line_To (Cr, -Thin / 2.0, Size / 2.0); -- 10 383 Cairo.Line_To (Cr, -Thin / 2.0, Thin / 2.0); -- 11 384 Cairo.Line_To (Cr, -Size / 2.0, Thin / 2.0); -- 12 385 Cairo.Close_Path (Cr); 386 -- Restore the transformation matrix 387 Cairo.Set_Matrix (Cr, Matrix'Access); 388 end Cross; 389 390 ---------------- 391 -- Invalidate -- 392 ---------------- 393 394 procedure Invalidate (Widget : access Gtk_Widget_Record'Class) is 395 begin 396 if Realized_Is_Set (Widget) then 397 Invalidate_Rect 398 (Gtk.Widget.Get_Window (Widget), 399 (Get_Allocation_X (Widget), 400 Get_Allocation_Y (Widget), 401 Get_Allocation_Width (Widget), 402 Get_Allocation_Height (Widget)), 403 False); 404 Queue_Draw (Widget); 405 end if; 406 end Invalidate; 407 408 ------------------ 409 -- On_Tab_Enter -- 410 ------------------ 411 412 function On_Tab_Enter 413 (Widget : access Gtk_Widget_Record'Class; 414 Event : Gdk.Event.Gdk_Event_Crossing) 415 return Boolean 416 is 417 pragma Unreferenced (Event); 418 begin 419 Gtkada_MDI_Close_Button (Widget).Tab_Over := True; 420 Invalidate (Widget); 421 422 return False; 423 end On_Tab_Enter; 424 425 ------------------ 426 -- On_Tab_Leave -- 427 ------------------ 428 429 function On_Tab_Leave 430 (Widget : access Gtk_Widget_Record'Class; 431 Event : Gdk.Event.Gdk_Event_Crossing) 432 return Boolean 433 is 434 begin 435 Gtkada_MDI_Close_Button (Widget).Tab_Over := False; 436 437 return On_Leave (Widget, Event); 438 end On_Tab_Leave; 439 440 -------------- 441 -- On_Enter -- 442 -------------- 443 444 function On_Enter 445 (Widget : access Gtk_Widget_Record'Class; 446 Event : Gdk.Event.Gdk_Event_Crossing) 447 return Boolean 448 is 449 pragma Unreferenced (Event); 450 begin 451 Gtkada_MDI_Close_Button (Widget).Over := True; 452 Invalidate (Widget); 453 454 return False; 455 end On_Enter; 456 457 -------------- 458 -- On_Leave -- 459 -------------- 460 461 function On_Leave 462 (Widget : access Gtk_Widget_Record'Class; 463 Event : Gdk.Event.Gdk_Event_Crossing) 464 return Boolean 465 is 466 pragma Unreferenced (Event); 467 begin 468 Gtkada_MDI_Close_Button (Widget).Over := False; 469 Gtkada_MDI_Close_Button (Widget).Pressed := False; 470 Invalidate (Widget); 471 472 return False; 473 end On_Leave; 474 475 ---------------------- 476 -- On_Mouse_Pressed -- 477 ---------------------- 478 479 function On_Mouse_Pressed 480 (Widget : access Gtk_Widget_Record'Class; 481 Event : Gdk.Event.Gdk_Event_Button) 482 return Boolean 483 is 484 Button : constant Gtkada_MDI_Close_Button := 485 Gtkada_MDI_Close_Button (Widget); 486 487 begin 488 if Gdk.Event.Get_Button (Event) = 1 and then Button.Over then 489 Button.Pressed := True; 490 Invalidate (Widget); 491 492 return True; 493 end if; 494 495 return False; 496 end On_Mouse_Pressed; 497 498 ----------------------- 499 -- On_Mouse_Released -- 500 ----------------------- 501 502 function On_Mouse_Released 503 (Widget : access Gtk_Widget_Record'Class; 504 Event : Gdk.Event.Gdk_Event_Button) 505 return Boolean 506 is 507 Button : constant Gtkada_MDI_Close_Button := 508 Gtkada_MDI_Close_Button (Widget); 509 510 begin 511 if Button.Pressed and then Gdk.Event.Get_Button (Event) = 1 then 512 Close_Child (Button.Child); 513 514 return True; 515 end if; 516 517 return False; 518 end On_Mouse_Released; 519 520end Close_Button; 521