1------------------------------------------------------------------------------ 2-- GtkAda - Ada95 binding for Gtk+/Gnome -- 3-- -- 4-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet -- 5-- Copyright (C) 1998-2015, AdaCore -- 6-- -- 7-- This library is free software; you can redistribute it and/or modify it -- 8-- under terms of the GNU General Public License as published by the Free -- 9-- Software Foundation; either version 3, or (at your option) any later -- 10-- version. This library is distributed in the hope that it will be useful, -- 11-- but WITHOUT ANY WARRANTY; without even the implied warranty of MERCHAN- -- 12-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE. -- 13-- -- 14-- As a special exception under Section 7 of GPL version 3, you are granted -- 15-- additional permissions described in the GCC Runtime Library Exception, -- 16-- version 3.1, as published by the Free Software Foundation. -- 17-- -- 18-- You should have received a copy of the GNU General Public License and -- 19-- a copy of the GCC Runtime Library Exception along with this program; -- 20-- see the files COPYING3 and COPYING.RUNTIME respectively. If not, see -- 21-- <http://www.gnu.org/licenses/>. -- 22-- -- 23------------------------------------------------------------------------------ 24 25-- Various support utilities for the grid and smart guides in the canvas 26 27with Ada.Calendar; use Ada.Calendar; 28with Glib.Object; 29with GNAT.Calendar; use GNAT.Calendar; 30with Gtk.Enums; 31 32package Gtkada.Canvas_View.Views is 33 34 ---------------------------- 35 -- Drawing the background -- 36 ---------------------------- 37 -- Various subprograms that draw the background of a view. 38 -- By default, a view only displays a white background, but you can 39 -- override the Draw_Internal primitive and call one of the following 40 -- subprograms if you want to draw alternate backgrounds. 41 -- 42 -- You could also use an image as the background, by creating a 43 -- cairo pattern: 44 -- Surf : Cairo_Surface := Cairo.Png.Create_From_Png ("file.png"); 45 -- Pattern : Cairo_Pattern := Cairo.Pattern.Create_For_Surface (Surf); 46 -- Cairo.Pattern.Set_Extend (Pattern, Cairo_Extend_Repeat); 47 -- Destroy (Surf); 48 -- and then drawing that pattern. 49 -- Set_Source (Context.Cr, Pattern); 50 -- Paint (Context.Cr); 51 -- With that code, the image will be scrolled when the canvas is scrolled. 52 -- If you do not want to scroll it, you need to set the identity matrix as 53 -- the transformation matrix. 54 -- 55 -- Using a custom background color can be done with: 56 -- Set_Source_Rgb (Context.Cr, Red, Green, Blue); 57 -- Paint (Context.Cr); 58 59 procedure Draw_Grid_Lines 60 (Self : not null access Canvas_View_Record'Class; 61 Style : Gtkada.Style.Drawing_Style; 62 Context : Draw_Context; 63 Area : Model_Rectangle); 64 -- Draw a grid with lines in the background. 65 -- The size of the grid can be set with Gtkada.Canvas_View.Set_Grid_Size. 66 -- This also sets the background color from the style's fill pattern. 67 68 procedure Draw_Grid_Dots 69 (Self : not null access Canvas_View_Record'Class; 70 Style : Gtkada.Style.Drawing_Style; 71 Context : Draw_Context; 72 Area : Model_Rectangle); 73 -- Draw a grid with dots in the background 74 -- This also sets the background color from the style's fill pattern. 75 76 ------------ 77 -- Easing -- 78 ------------ 79 -- These functions are used to compute the intermediate values during an 80 -- animation. They can be used to provide special effects like starting 81 -- slow, finish slow, or even bounding when reaching the end. 82 -- 83 -- see http://www.robertpenner.com/easing 84 -- and http://api.jqueryui.com/easings/ 85 86 type Animation_Progress is new Duration range 0.0 .. 1.0; 87 type Animation_Value is record 88 Start, Finish : Gdouble; 89 Duration : Standard.Duration; 90 end record; 91 -- Describes one value to be animated, giving its initial and final values, 92 -- as well as the duration that the total animation should take. 93 94 type Easing_Function is access function 95 (Value : Animation_Value; 96 Progress : Animation_Progress) return Gdouble; 97 -- A function that is responsible for computing the current value of 98 -- a property, given the initial and final values, and the current 99 -- progress. It returns the current value of the property. 100 101 function Easing_Linear 102 (Value : Animation_Value; Progress : Animation_Progress) return Gdouble; 103 -- The current value is on the straight line from Start to Finish. 104 -- Progresses at a constant pace. 105 106 function Easing_In_Out_Cubic 107 (Value : Animation_Value; Progress : Animation_Progress) return Gdouble; 108 -- Rate of change starts slow, increases to linear in the middle, and 109 -- slows done in the end. 110 111 function Easing_In_Cubic 112 (Value : Animation_Value; Progress : Animation_Progress) return Gdouble; 113 -- Starts slow, and then speeds up till the end. 114 115 function Easing_Out_Cubic 116 (Value : Animation_Value; Progress : Animation_Progress) return Gdouble; 117 -- Starts normally, then slows down near the end 118 119 function Easing_Out_Elastic 120 (Value : Animation_Value; Progress : Animation_Progress) return Gdouble; 121 -- Will move past the finish, then slightly back towards the start, and so 122 -- on. 123 124 function Easing_Out_Bounce 125 (Value : Animation_Value; Progress : Animation_Progress) return Gdouble; 126 -- Will reach the finish value early, then bounce back towards the start, 127 -- a few times. Does not go over the finish value. 128 129 --------------- 130 -- Callbacks -- 131 --------------- 132 -- These procedures contain a number of example callbacks for "item_event" 133 -- which enable various behaviors. Depending on your application, one of 134 -- these might be useful as is, or a starting point for your own callback 135 136 function On_Item_Event_Move_Item 137 (View : not null access Glib.Object.GObject_Record'Class; 138 Event : Event_Details_Access) 139 return Boolean; 140 -- Add this to the list of callbacks for "item_event" to enable dragging 141 -- items with the mouse. 142 -- If shift is pressed, no snapping on the grid or smart guides occurs. 143 -- You can call Avoid_Overlap below if you want over items to be moved 144 -- aside to avoid overlap. 145 146 function On_Item_Event_Scroll_Background 147 (View : not null access Glib.Object.GObject_Record'Class; 148 Event : Event_Details_Access) 149 return Boolean; 150 -- Add this to the list of callbacks for "item_event" to enable scrolling 151 -- the canvas by dragging the background. Scrolling is limited to the area 152 -- that actually contains items. 153 154 generic 155 Modifier : Gdk.Types.Gdk_Modifier_Type := Mod1_Mask; 156 Factor : Gdouble := 1.1; 157 Duration : Standard.Duration := 0.0; 158 Easing : Easing_Function := Easing_In_Out_Cubic'Access; 159 function On_Item_Event_Zoom_Generic 160 (View : not null access Glib.Object.GObject_Record'Class; 161 Event : Event_Details_Access) 162 return Boolean; 163 -- Add this to the list of callbacks for "item_event" to enable zooming in 164 -- or out with the mouse wheel and a keyboard modifier like ctrl, alt,... 165 -- (since the mouse wheel on its own is used for vertical scrolling by 166 -- gtk+, and for horizontal scrolling when used with shift). 167 -- If a duration other than 0.0 is provided, the scaling is animated. 168 169 function On_Item_Event_Select 170 (View : not null access Glib.Object.GObject_Record'Class; 171 Event : Event_Details_Access) 172 return Boolean; 173 -- When an item is clicked, it is added to the selection (or replaces the 174 -- selection, depending on the modifiers). 175 -- This callback should be connected first (before any of the others above) 176 177 generic 178 Modifier : Gdk.Types.Gdk_Modifier_Type := 0; 179 Ignore_Links : Boolean := True; 180 function On_Item_Event_Key_Navigate_Generic 181 (View : not null access Glib.Object.GObject_Record'Class; 182 Event : Event_Details_Access) 183 return Boolean; 184 -- Add this to the list of callbacks for "item_event" so that arrow keys 185 -- move the selection to another item. 186 187 generic 188 Modifier : Gdk.Types.Gdk_Modifier_Type := Mod1_Mask; 189 function On_Item_Event_Key_Scrolls_Generic 190 (View : not null access Glib.Object.GObject_Record'Class; 191 Event : Event_Details_Access) 192 return Boolean; 193 -- Add this to the list of callbacks for "item_event" so that arrow keys 194 -- scroll the view when no item is selected, or moves the selected items. 195 196 function On_Item_Event_Edit 197 (View : not null access Glib.Object.GObject_Record'Class; 198 Event : Event_Details_Access) 199 return Boolean; 200 -- Add this to the list of callbacks for "item_event" so that double 201 -- clicking on an item that supports it starts editing it. 202 -- This editing is by default only supported for Text_Item, but you can 203 -- override the Edit_Widget method for other items if you want to support 204 -- in-place editing for them too. 205 206 ------------- 207 -- Minimap -- 208 ------------- 209 210 type Minimap_View_Record is new Canvas_View_Record with private; 211 type Minimap_View is access all Minimap_View_Record'Class; 212 -- A special canvas view that monitors another view and displays the same 213 -- contents, but at a scale such that the whole model is visible (and the 214 -- area visible in the monitored view is drawn as a rectangle). 215 216 Default_Current_Region_Style : constant Gtkada.Style.Drawing_Style := 217 Gtkada.Style.Gtk_New 218 (Stroke => (0.0, 0.0, 0.0, 1.0), 219 Fill => Gtkada.Style.Create_Rgba_Pattern ((0.9, 0.9, 0.9, 0.2)), 220 Line_Width => 2.0); 221 222 procedure Gtk_New 223 (Self : out Minimap_View; 224 Style : Gtkada.Style.Drawing_Style := Default_Current_Region_Style); 225 procedure Initialize 226 (Self : not null access Minimap_View_Record'Class; 227 Style : Gtkada.Style.Drawing_Style := Default_Current_Region_Style); 228 -- Create a new minimap, which does not monitor any view yet. 229 -- The style is used to highlight the region currently visible in the 230 -- monitored view. 231 232 procedure Monitor 233 (Self : not null access Minimap_View_Record; 234 View : access Canvas_View_Record'Class := null); 235 -- Start monitoring a specific view. 236 -- Any change in the viewport or the model of that view will be reflected 237 -- in the display of Self. 238 239 overriding procedure Draw_Internal 240 (Self : not null access Minimap_View_Record; 241 Context : Draw_Context; 242 Area : Model_Rectangle); 243 244 ---------------- 245 -- Navigation -- 246 ---------------- 247 248 function Move_To_Item 249 (Self : not null access Canvas_View_Record'Class; 250 Item : not null access Abstract_Item_Record'Class; 251 Dir : Gtk.Enums.Gtk_Direction_Type; 252 Ignore_Links : Boolean := True) 253 return Abstract_Item; 254 -- Search for the next item in the given direction 255 256 -------------- 257 -- Snapping -- 258 -------------- 259 -- These functions are mostly for the internal implementation of the view. 260 261 function Snap_To_Grid 262 (Self : not null access Canvas_View_Record'Class; 263 Pos : Model_Coordinate; 264 Size : Model_Coordinate) return Model_Coordinate; 265 -- Snap the Pos coordinate to the canvas grid. 266 -- Size is the size of the item along that coordinate, since the item 267 -- could be snap either on its left (resp. top) or right (resp. bottom) 268 269 procedure Prepare_Smart_Guides 270 (Self : not null access Canvas_View_Record'Class); 271 -- Prepare data for the smart guides, before we start a drag operation. 272 273 procedure Free_Smart_Guides 274 (Self : not null access Canvas_View_Record'Class); 275 -- Free the memory used for the smart guidss 276 277 function Snap_To_Smart_Guides 278 (Self : not null access Canvas_View_Record'Class; 279 Pos : Model_Coordinate; 280 Size : Model_Coordinate; 281 Horizontal : Boolean) return Model_Coordinate; 282 -- Snap the Pos coordinate to the smart guides. 283 -- This also computes which smart guides should be made visible 284 285 procedure Draw_Visible_Smart_Guides 286 (Self : not null access Canvas_View_Record'Class; 287 Context : Draw_Context; 288 For_Item : not null access Abstract_Item_Record'Class); 289 -- Draw the visible smart guides, as computed by Snap_To_Smart_Guides; 290 291 ------------------------- 292 -- Continous scrolling -- 293 ------------------------- 294 -- These functions are mostly for the internal implementation of the view. 295 296 procedure Cancel_Continuous_Scrolling 297 (Self : not null access Canvas_View_Record'Class); 298 -- Stops the continuous scrolling (that occurs while dragging items outside 299 -- of the visible area) 300 301 -------------------- 302 -- Inline editing -- 303 -------------------- 304 305 procedure Start_Inline_Editing 306 (Self : not null access Canvas_View_Record'Class; 307 Item : not null access Abstract_Item_Record'Class); 308 -- If Item is editable, overlap a widget on top of it to allow its editing. 309 -- The widget is created via the Item.Edit_Widget method. 310 -- Returns True if such a widget could be displayed, False if editing could 311 -- not take place. 312 313 procedure Cancel_Inline_Editing 314 (Self : not null access Canvas_View_Record'Class); 315 -- Destroys any inline editing widget that might be set 316 317 --------------- 318 -- Animation -- 319 --------------- 320 -- The following subprograms provide a light-weight animation framework. 321 -- Rather than do your own animation through the use of gtk's idle or 322 -- timeout callbacks, it is more efficient to use this framework which will 323 -- register a single callback and avoid monopolizing the CPU for too long 324 -- each time. 325 -- To move an item from its current position to another with animation, 326 -- use something like: 327 -- Animate (View, Animate_Position (Item, (100.0, 100.0))); 328 329 type Animation_Status is mod 2 ** 16; 330 Needs_Refresh_Links_From_Item : constant Animation_Status := 2 ** 0; 331 -- Whether we need to recompute the layout of links to and from the 332 -- animated item. 333 334 Needs_Refresh_All_Links : constant Animation_Status := 2 ** 1; 335 -- Whether we need to recompute the layout of all links 336 337 Needs_Refresh_Layout : constant Animation_Status := 2 ** 2; 338 -- Whether we need to recompute the layout of the whole model (items and 339 -- links). 340 341 type Animator is abstract tagged private; 342 type Animator_Access is access all Animator'Class; 343 344 procedure Destroy (Self : in out Animator) is null; 345 -- Called when the animator has finished running 346 347 function Is_Unique_For_Item 348 (Self : not null access Animator) return Boolean; 349 -- If True, single animator of this type can be active for a given item. 350 -- As a result, when you call Animate for this animator, any other 351 -- registered similar animator for the same item is removed from the queue 352 -- (and not completed). 353 354 procedure Setup 355 (Self : in out Animator; 356 Duration : Standard.Duration; 357 Easing : not null Easing_Function := Easing_In_Out_Cubic'Access; 358 View : access Canvas_View_Record'Class := null; 359 Item : access Abstract_Item_Record'Class := null); 360 -- Initialize internal fields. This is only needed when you are writing 361 -- your own animators. 362 363 function Execute 364 (Self : not null access Animator; 365 Progress : Animation_Progress) return Animation_Status is abstract; 366 -- Performs one iteration of the animation. 367 -- For instance, this could be moving a specific item slightly closer to 368 -- its goal, or zooming the view a bit more. 369 370 procedure Start 371 (Self : access Animator'Class; 372 View : not null access Canvas_View_Record'Class); 373 -- Adds the animator to the animation queue. 374 -- The animator will be destroyed automatically (and memory reclaimed) when 375 -- it finishes its execution. 376 -- It is valid to pass a null animator (nothing happens in this case) 377 378 procedure Terminate_Animation 379 (Self : not null access Canvas_View_Record'Class); 380 -- Terminate the animation queue: 381 -- All animators are completed (i.e. for instance items are moved to their 382 -- final position,...) 383 384 procedure Terminate_Animation_For_Item 385 (Self : not null access Canvas_View_Record'Class; 386 Item : access Abstract_Item_Record'Class := null); 387 -- Terminate the animation for a specific item (or for the view itself when 388 -- Item is null). 389 390 --------------- 391 -- Animators -- 392 --------------- 393 -- Various prebuilt animators. 394 395 function Animate_Position 396 (Item : not null access Abstract_Item_Record'Class; 397 Final_Position : Gtkada.Style.Point; 398 Duration : Standard.Duration := 0.4; 399 Easing : Easing_Function := Easing_In_Out_Cubic'Access) 400 return Animator_Access; 401 -- Moves an item from one position to another. 402 -- Returns null if the item is already at the right position 403 404 function Animate_Scale 405 (View : not null access Canvas_View_Record'Class; 406 Final_Scale : Gdouble; 407 Preserve : Model_Point := No_Point; 408 Duration : Standard.Duration := 0.4; 409 Easing : Easing_Function := Easing_In_Out_Cubic'Access) 410 return Animator_Access; 411 -- Changes the scale of the view progressively 412 413 function Animate_Scroll 414 (View : not null access Canvas_View_Record'Class; 415 Final_Topleft : Model_Point; 416 Duration : Standard.Duration := 0.8; 417 Easing : Easing_Function := Easing_In_Out_Cubic'Access) 418 return Animator_Access; 419 -- Scroll the canvas until the top-left corner reaches the given coordinate 420 421 -------------- 422 -- Overlaps -- 423 -------------- 424 -- The following subprograms can be used to avoid overlap of items. 425 426 type Move_Direction is 427 (Left, Right, Up, Down, Horizontal, Vertical, Any); 428 type Specific_Direction is new Move_Direction range Left .. Down; 429 -- In which direction items should be moved to make space for other items. 430 431 procedure Reserve_Space 432 (Self : not null access Canvas_View_Record'Class; 433 Rect : Model_Rectangle; 434 Direction : Move_Direction := Any; 435 Do_Not_Move : Item_Sets.Set := Item_Sets.Empty_Set; 436 Duration : Standard.Duration := 0.0; 437 Easing : Easing_Function := Easing_In_Out_Cubic'Access); 438 -- Move aside all items that intersect with the rectangle, so that the 439 -- latter ends up being an empty area. 440 -- The direction constraints what is allowed. By default, the items are 441 -- moved in the direction of the minimal distance. Items can also end up 442 -- pushing other items in turn if they need some extra space. 443 -- Duration can be specified to animate items to their new position. 444 445 procedure Insert_And_Layout_Items 446 (Self : not null access Canvas_View_Record'Class; 447 Ref : not null access Abstract_Item_Record'Class; 448 Items : Items_Lists.List; 449 Direction : Specific_Direction; 450 Space_Between_Items : Gdouble := 10.0; 451 Space_Between_Layers : Gdouble := 20.0; 452 Duration : Standard.Duration := 0.0); 453 -- Insert several items in the view, with the following behavior: 454 -- * If Ref itself currenty has No_Position, it is moved to a position 455 -- to below all other items currently in the canvas (if Direction is 456 -- Left or Right) or to the right of all other items. 457 -- 458 -- * the other items will be displayed to one side of Ref, after one 459 -- below the other (if Direction is Left or Right), or one next to the 460 -- other. Their current position is ignored. 461 -- 462 -- Any item currently in those position will be moved aside via a call to 463 -- Reserve_Space. 464 -- This procedure can be used to avoid recomputing the whole layout of the 465 -- view, and perhaps preserve whatever changes the user has made to the 466 -- model. 467 -- 468 -- Direction is the position of the items in Items compared to Ref. 469 470private 471 type Minimap_View_Record is new Canvas_View_Record with record 472 Monitored : Canvas_View; 473 Viewport_Changed_Id : Gtk.Handlers.Handler_Id; 474 Area_Style : Gtkada.Style.Drawing_Style; 475 476 Drag_Pos_X, Drag_Pos_Y : Gdouble; 477 end record; 478 479 type Animator is abstract tagged record 480 Start : Ada.Calendar.Time := GNAT.Calendar.No_Time; 481 Duration : Standard.Duration; 482 Easing : Easing_Function; 483 484 Item : access Abstract_Item_Record'Class; 485 View : access Canvas_View_Record'Class; 486 -- Set only when animating a specific item or view 487 end record; 488 489end Gtkada.Canvas_View.Views; 490