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-- <description> 26-- This package is a rewrite of Gtkada.Canvas, with hopefully more 27-- capabilities and a cleaner API. 28-- 29-- It provides a drawing area (canvas) on which items can be displayed and 30-- linked together. It also supports interactive manipulation of those 31-- items. 32-- 33-- This package is organized around the concept of Model-View-Controller: 34-- - The model is an item that gives access to all the items contained 35-- in the canvas, although it need not necessarily own them. A default 36-- model implementation is provided which indeed stores the items 37-- internally, but it is possible to create a model which is a simple 38-- wrapper around an application-specific API that would already have the 39-- list of items. 40-- 41-- - The view is in charge of representing the model, or a subset of it. It 42-- is possible to have multiple views for a single model, each displaying 43-- a different subset or a different part of the whole canvas. 44-- When a view is put inside a Gtk_Scrolled_Window, it automatically 45-- supports scrolling either via the scrollbars, or directly with the 46-- mouse wheel or touchpad. 47-- 48-- - The controller provides the user interaction in the canvas, and will 49-- change the view and model properties when the user performs actions. 50-- 51-- A view does not draw any background (image, grid,...). This is because 52-- there are simply too many ways application want to take advantage of the 53-- background. Instead, you should override the Draw_Internal primitive and 54-- take advantage (optionally) of some of the helps in 55-- Gtkada.Canvas_View.Views, which among other things provide ways to draw 56-- grids. 57-- 58-- Likewise, a view does not handle events by default (except for scrolling 59-- when it is put in a Gtk_Scrolled_Window). This is also because applications 60-- want to do widely different things (for some, clicking in the background 61-- should open a menu, whereas others will want to let the user scroll by 62-- dragging the mouse in the background -- likewise when clicking on items 63-- for instance). 64-- 65-- Differences with Gtkada.Canvas 66-- ============================== 67-- 68-- This package is organized around the concept of Model-View-Controller, 69-- which provides a much more flexible approach. There is for instance no 70-- need to duplicate the items in memory if you already have them available 71-- somewhere else in your application. 72-- 73-- Various settings that were set on an Interactive_Canvas (like the font for 74-- annotations, arrow sizes,...) are now configured on each item or link 75-- separately, which provides much more flexibility in what this canvas can 76-- display. 77-- 78-- The support for items is much richer: via a number of new primitive 79-- operations, it is possible to control with more details the behavior of 80-- items and where links should be attached to them. 81-- More importantly, this package provides a ready-to-use set of predefined 82-- items (rectangles, circles, text, polygons,...) which can be composited 83-- and have automatic size computation. This makes it easier than before to 84-- have an item that contains, for instance, a list of text fields, since 85-- there is no need any more to compute the size of the text explicitly. 86-- 87-- This package systematically use a Gdouble for coordinates (in any of the 88-- coordinate systems), instead of the mix of Gint, Gdouble and Gfloat that 89-- the Gtkada.Canvas is using. In fact, most of the time applications will 90-- only have to deal with the item coordinate system (see below), and never 91-- with the view coordinate system. 92-- 93-- The behavior of snap-to-grid is different: whereas in Gtkada.Canvas it 94-- forces items to always be aligned with the grid (with no way to have items 95-- not aligned), the Canvas_View's effect is more subtle: basically, when an 96-- item is moved closed enough to the grid, it will be aligned to the grid. 97-- But if it is far from any grid line, you can drop it anywhere. 98-- Snapping also takes into account all four edges of items, not just their 99-- topleft corner. 100-- 101-- User interaction 102-- ================ 103-- 104-- By default, limited user interaction is supported: 105-- * When a view is added to a Gtk_Scrolled_Window, scrolling is 106-- automatically supported (it is handled by the scrolled window). 107-- Users can use the mouse wheel to scroll vertically, shift and the 108-- mouse wheel to scroll horizontally, or use the touchpad to navigate 109-- (in general with multiple fingers). 110-- 111-- But of course it supports much more advanced interactions, like clicking 112-- on items, moving them with the mouse or keyboard,... 113-- 114-- For this, you need to connect to the "item_event" signal, and either 115-- directly handle the signal (a simple click for instance), or set some 116-- data in the details parameters, to enable dragging items or the background 117-- of the canvas (for scrolling). The package Gtkada.Canvas_View.Views 118-- provides a number of precoded behaviors. 119-- 120-- When dragging items, the view will scroll automatically if the mouse is 121-- going outside of the visible area. Scrolling will continue while the mouse 122-- stays there, even if the user does not move the mouse. 123-- 124-- The following has not been backported yet: 125-- ========================================== 126-- 127-- Items are selected automatically when they are clicked. If Control is 128-- pressed at the same time, multiple items can be selected. 129-- If the background is clicked (and control is not pressed), then all items 130-- are unselected. 131-- Pressing and dragging the mouse in the backgroudn draws a virtual box on 132-- the screen. All the items fully included in this box when it is released 133-- will be selected (this will replace the current selection if Control was 134-- not pressed). 135-- 136-- </description> 137-- <group>Drawing</group> 138-- <testgtk>create_canvas_view.adb</testgtk> 139 140pragma Ada_2012; 141 142with Ada.Containers.Doubly_Linked_Lists; 143private with Ada.Containers.Hashed_Maps; 144with Ada.Containers.Hashed_Sets; 145with Ada.Numerics.Generic_Elementary_Functions; use Ada.Numerics; 146private with Ada.Unchecked_Deallocation; 147private with GNAT.Strings; 148with Cairo; 149with Gdk.Event; use Gdk.Event; 150with Gdk.Pixbuf; use Gdk.Pixbuf; 151with Gdk.Types; use Gdk.Types; 152private with Glib.Main; 153with Glib; use Glib; 154with Glib.Object; use Glib.Object; 155with Gtk.Adjustment; use Gtk.Adjustment; 156with Gtk.Handlers; 157with Gtk.Bin; use Gtk.Bin; 158with Gtk.Widget; 159with Gtkada.Style; use Gtkada.Style; 160with Pango.Layout; use Pango.Layout; 161 162package Gtkada.Canvas_View is 163 164 package Gdouble_Elementary_Functions is new 165 Ada.Numerics.Generic_Elementary_Functions (Gdouble); 166 167 type Canvas_View_Record is new Gtk.Widget.Gtk_Widget_Record with private; 168 type Canvas_View is access all Canvas_View_Record'Class; 169 -- A view is a display of one particular part of the model, or a subset of 170 -- it. Multiple views can be associated with a specific model, and will 171 -- monitor changes to it view signals. 172 -- The view automatically refreshes its display when its model changes. 173 174 type Canvas_Model_Record 175 is abstract new Glib.Object.GObject_Record with private; 176 type Canvas_Model is access all Canvas_Model_Record'Class; 177 -- A model is a common interface to query the list of items that should 178 -- be displayed in the canvas. It does not assume anything regarding the 179 -- actual storage of the items, so it is possible to create your own 180 -- model implementation that simply query the rest of your application 181 -- (or a database, or some other source of data) as needed, without 182 -- duplicating the items. 183 -- 184 -- This type is not an Ada interface because it needs to inherit from 185 -- GObject so that it can send signals. 186 -- 187 -- The interface does not provide support for adding items to the model: 188 -- instead, this is expected to be done by the concrete implementations of 189 -- the model, which must then send the signal "layout_changed". 190 191 ----------------- 192 -- Coordinates -- 193 ----------------- 194 -- There are multiple coordinate systems used in this API. Here is a full 195 -- description: 196 -- 197 -- - Model coordinates: these are the coordinates of items without 198 -- considering canvas scrolling or zooming. These do not change when the 199 -- view is zoomed or scrolled, and these are therefore the coordinates 200 -- that are stored in the model. 201 -- The drawing of links is done within this system. 202 -- These coordinates are in general oriented so that x increases towards 203 -- the right, and y increases towards the bottom of the screen. This 204 -- can be changed by overriding Set_Transform below. 205 -- 206 -- - View coordinates: these are the coordinates of items in the widget 207 -- representing the view. They change when the view is scrolled or 208 -- zoomed. These coordinates are mostly an implementation detail. 209 -- 210 -- - Item coordinates: these are the coordinates relative to the 211 -- top-left corner of an item as if it was displayed at a zoom level of 212 -- 100%. All drawing of items is done with this system, so that the 213 -- same item can be displayed at different positions in the view 214 -- without changing the drawing instructions. 215 -- The drawing coordinates are automatically converted to the view 216 -- coordinates by the use of a transformation matrix, which is done very 217 -- efficiently on modern systems. 218 -- 219 -- - Window coordinates 220 -- These are rarely used, only when interfacing with gtk+ events. These 221 -- are the coordinates relative to the Gdk_Window of the view. 222 223 subtype Model_Coordinate is Gdouble; 224 subtype View_Coordinate is Gdouble; 225 subtype Item_Coordinate is Gdouble; 226 subtype Window_Coordinate is Gdouble; 227 -- We use subtypes for convenience in your applications to avoid casts. 228 229 type Model_Rectangle is record 230 X, Y, Width, Height : Model_Coordinate; 231 end record; 232 type View_Rectangle is record 233 X, Y, Width, Height : View_Coordinate; 234 end record; 235 type Item_Rectangle is record 236 X, Y, Width, Height : Item_Coordinate; 237 end record; 238 type Window_Rectangle is record 239 X, Y, Width, Height : Window_Coordinate; 240 end record; 241 -- A rectangle in various coordinates 242 243 type Model_Point is record 244 X, Y : Model_Coordinate; 245 end record; 246 type View_Point is record 247 X, Y : View_Coordinate; 248 end record; 249 type Window_Point is record 250 X, Y : Window_Coordinate; 251 end record; 252 subtype Item_Point is Gtkada.Style.Point; 253 -- A point in various coordinates 254 255 type Model_Point_Array is array (Natural range <>) of Model_Point; 256 type Model_Point_Array_Access is access Model_Point_Array; 257 258 subtype Item_Point_Array is Gtkada.Style.Point_Array; 259 subtype Item_Point_Array_Access is Gtkada.Style.Point_Array_Access; 260 261 No_Rectangle : constant Model_Rectangle := (0.0, 0.0, 0.0, 0.0); 262 No_Point : constant Model_Point := (Gdouble'First, Gdouble'First); 263 No_Item_Point : constant Item_Point := (Gdouble'First, Gdouble'First); 264 265 function Point_In_Rect 266 (Rect : Model_Rectangle; P : Model_Point) return Boolean; 267 function Point_In_Rect 268 (Rect : Item_Rectangle; P : Item_Point) return Boolean; 269 -- Whether the point is in the rectangle 270 271 function Intersects (Rect1, Rect2 : Model_Rectangle) return Boolean; 272 function Intersects (Rect1, Rect2 : Item_Rectangle) return Boolean; 273 -- Whether the two rectangles intersect. 274 275 procedure Union 276 (Rect1 : in out Model_Rectangle; 277 Rect2 : Model_Rectangle); 278 -- Store in Rect1 the minimum rectangle that contains both Rect1 and Rect2. 279 280 ------------------ 281 -- Enumerations -- 282 ------------------ 283 284 type Side_Attachment is (Auto, Top, Right, Bottom, Left, No_Clipping); 285 -- Which side of the toplevel item the link is attached to. 286 -- 287 -- For toplevel items, this can be controlled by using the 288 -- Anchor_Attachment's X and Y properties. 289 -- But for nested item, this forces the link to start from the 290 -- toplevel item's border. Here is an example: 291 -- +----------+ 292 -- | +-+ | 293 -- | |A| |\ 294 -- | +-+ | \1 295 -- | B |\ \ 296 -- +----------+ \ \ 297 -- 2\ +----------------+ 298 -- \| C | 299 -- +----------------+ 300 -- 301 -- The link 1 is attached to the nested item A, and the side_attachment 302 -- is set to Right. As a result, it always starts at the same height as A 303 -- itself. 304 -- The link 2 is also attached to A, but the side is set to Auto. So the 305 -- canvas draws the shortest path from A to C (and clips the line to the 306 -- border of B). So it is not as visible that 2 is linked to A. 307 -- 308 -- The "No_Clipping" side should be used when a link is connected to 309 -- another link, since in that case there is no notion of link. 310 311 type Anchor_Attachment is record 312 X, Y : Glib.Gdouble := 0.5; 313 Toplevel_Side : Side_Attachment := Auto; 314 Distance : Model_Coordinate := 0.0; 315 end record; 316 Middle_Attachment : constant Anchor_Attachment := (0.5, 0.5, Auto, 0.0); 317 -- Where in the item the link is attached (0.5 means the middle, 0.0 318 -- means left or top, and 1.0 means right or bottom). 319 -- 320 -- For the target side of a link, if X or Y are negative, Gtkada will try 321 -- to draw a strictly orthogonal or vertical segment next on that end by 322 -- adjusting the location of the end point along the border of the item. If 323 -- it cannot, then GtkAda will use the absolute value of X and Y to specify 324 -- the attachment. 325 -- 326 -- You can therefore force a link to always emerge from the right side of 327 -- an item by setting X to 1.0 and Y to any value, for instance. 328 -- See the description of Side_Attachment for an example on how to use 329 -- Toplevel_Side. 330 -- Distance indicates at which distance from the border of the item the 331 -- link should stop. By default, it reaches the border. 332 333 type Route_Style is (Orthogonal, Straight, Arc, Curve); 334 -- This defines how a link is routed between its two ends. 335 -- Curve is similar to orthogonal (links restricted to horizontal and 336 -- vertical lines), but using a bezier curve. 337 338 ------------------ 339 -- Draw context -- 340 ------------------ 341 342 type Draw_Context is record 343 Cr : Cairo.Cairo_Context := Cairo.Null_Context; 344 Layout : Pango.Layout.Pango_Layout := null; 345 View : Canvas_View := null; 346 end record; 347 -- Context to perform the actual drawing 348 349 function Build_Context 350 (Self : not null access Canvas_View_Record'Class) 351 return Draw_Context; 352 -- Returns a draw context for the view. This context is suitable for 353 -- computing sizes (in Refresh_Layout), but not for actual drawing. 354 355 -------------------- 356 -- Abstract Items -- 357 -------------------- 358 359 type Abstract_Item_Record is interface; 360 type Abstract_Item is access all Abstract_Item_Record'Class; 361 -- These are all the elements that can be displayed on a canvas, including 362 -- the boxes, the links between the boxes, any annotations on those links, 363 -- and so on. 364 -- Items can be grouped, so that toplevel items contain one or more 365 -- other items. The toplevel items are the ones that are moved 366 -- interactively by the user, and their contained items will be moved 367 -- along. 368 -- All primitive operations on items, except its position, are done in the 369 -- Item's own coordinate systems so that it is easy to create new types of 370 -- items without paying attention to any of its parents rotation or 371 -- scaling, or the rotation and scaling of the view itself). 372 -- 373 -- This interface is meant for use when you already have ways to store 374 -- coordinates and sizes in your own data types, at which point you can 375 -- implement a simpler wrapper for your data type that implements this 376 -- interface. In general, though, it is better to extend the type 377 -- Abstract_Item_Record which provides its own non-abstract handling for a 378 -- number of subprograms below. 379 380 package Items_Lists is new Ada.Containers.Doubly_Linked_Lists 381 (Abstract_Item); 382 383 function Is_Link 384 (Self : not null access Abstract_Item_Record) return Boolean is abstract; 385 -- Whether this item should be considered as a link between two other 386 -- items. 387 -- Such links have a few specific behavior: for instance, they cannot be 388 -- dragged by the user to a new position (their layout is provided by the 389 -- items they are linked to). 390 -- They also do not contribute to the smart guides that are used while 391 -- items are moved around. 392 393 No_Position : constant Gtkada.Style.Point := (Gdouble'First, Gdouble'First); 394 -- Indicates that the item did not get assigned a proper position 395 396 function Position 397 (Self : not null access Abstract_Item_Record) 398 return Gtkada.Style.Point is abstract; 399 -- The coordinates of the item within its parent. 400 -- If the item has no parent, the coordinates should be returned in model 401 -- coordinates. These coordinates describe the origin (0,0) point of 402 -- the item's coordinate system (even if Set_Position was specified to 403 -- point to another location in the item). 404 405 procedure Set_Position 406 (Self : not null access Abstract_Item_Record; 407 Pos : Gtkada.Style.Point) is null; 408 -- Used to change the position of an item (by default an item cannot be 409 -- moved). You must call the model's Refresh_Layout after moving items. 410 411 function Bounding_Box 412 (Self : not null access Abstract_Item_Record) 413 return Item_Rectangle is abstract; 414 -- Returns the area occupied by the item. 415 -- Any drawing for the item, including shadows for instance, must be 416 -- within this area. 417 -- This bounding box is always returned in the item's own coordinate 418 -- system, so that it is not necessary to pay attention to the current 419 -- scaling factor or rotation for the item, its parents or the canvas view. 420 421 -- 422 -- The coordinates of the item are always the top-left corner of their 423 -- bounding box. These coordinates are either relative to the item's 424 -- toplevel container, or model coordinates for toplevel items. 425 -- 426 -- The bounding box is also used for fast detection on whether the item 427 -- might be clicked on by the user. 428 429 procedure Refresh_Layout 430 (Self : not null access Abstract_Item_Record; 431 Context : Draw_Context) is null; 432 -- Called when Refresh_Layout is called on the model. 433 -- This is an opportunity for the item to update its size for instance, or 434 -- do other computation that might impact the result of Bounding_Box. 435 436 procedure Draw 437 (Self : not null access Abstract_Item_Record; 438 Context : Draw_Context) is abstract; 439 -- Draw the item on the given cairo context. 440 -- A transformation matrix has already been applied to Cr, so that all 441 -- drawing should be done in item-coordinates for Self, so that (0,0) is 442 -- the top-left corner of Self's bounding box. 443 -- Do not call this procedure directly. Instead, call 444 -- Translate_And_Draw_Item below. 445 446 procedure Translate_And_Draw_Item 447 (Self : not null access Abstract_Item_Record'Class; 448 Context : Draw_Context; 449 As_Outline : Boolean := False; 450 Outline_Style : Drawing_Style := No_Drawing_Style); 451 -- Translate the transformation matrix and draw the item. 452 -- This procedure should be used instead of calling Draw directly. 453 -- If As_Outline is true, then only the outline of the item is displayed, 454 -- using the provided style 455 456 procedure Draw_Outline 457 (Self : not null access Abstract_Item_Record; 458 Style : Gtkada.Style.Drawing_Style; 459 Context : Draw_Context) is null; 460 -- Draw an outline for Self (which is used for the selection for instance). 461 -- Do not call this procedure directly, use Translate_And_Draw_Item 462 -- instead, unless called directly from an overriding of Draw. 463 464 procedure Draw_As_Selected 465 (Self : not null access Abstract_Item_Record; 466 Context : Draw_Context) is abstract; 467 -- Draw the item when it is selected. 468 -- The default is to draw both the item and its outline. 469 -- Do not call this procedure directly, use Translate_And_Draw_Item 470 -- instead, unless called directly from an overriding of Draw. 471 472 function Contains 473 (Self : not null access Abstract_Item_Record; 474 Point : Item_Point; 475 Context : Draw_Context) return Boolean is abstract; 476 -- Should test whether Point is within the painted region for Self (i.e. 477 -- whether Self should be selected when the user clicks on the point). 478 -- For an item with holes, this function should return False when the 479 -- point is inside one of the holes, for instance. 480 481 function Edit_Widget 482 (Self : not null access Abstract_Item_Record; 483 View : not null access Canvas_View_Record'Class) 484 return Gtk.Widget.Gtk_Widget is abstract; 485 -- Return the widget to use for in-place editing of the item. 486 -- null should be returned when the item is not editable in place. 487 -- It is the responsibility of the returned widget to monitor events and 488 -- validate the editing, update Self, and then call model's layout_changed 489 -- signal. 490 491 procedure Destroy 492 (Self : not null access Abstract_Item_Record; 493 In_Model : not null access Canvas_Model_Record'Class) is null; 494 -- Called when Self is no longer needed. 495 -- Do not call directly. 496 497 function Parent 498 (Self : not null access Abstract_Item_Record) 499 return Abstract_Item is abstract; 500 -- Return the item inside which Self is contained. 501 -- null is returned for toplevel items, in which case the coordinates of 502 -- the bounding box are model coordinats. Otherwise, the coordinates are 503 -- relative to the returned item. 504 505 function Get_Toplevel_Item 506 (Self : not null access Abstract_Item_Record'Class) 507 return Abstract_Item; 508 -- Return the toplevel item that contains Self (or self itself) 509 510 function Inner_Most_Item 511 (Self : not null access Abstract_Item_Record; 512 At_Point : Model_Point; 513 Context : Draw_Context) 514 return Abstract_Item is abstract; 515 -- Return the inner-most item at the specific coordinates in Self (or 516 -- Self itself). 517 518 function Link_Anchor_Point 519 (Self : not null access Abstract_Item_Record; 520 Anchor : Anchor_Attachment) 521 return Item_Point is abstract; 522 -- Return the anchor point for links to or from this item. In general, 523 -- this anchor point is in the middle of the item or depends on the 524 -- Anchor parameter, and the link will automatically be clipped to one 525 -- of the borders. The coordinates are absolute. 526 -- This anchor point can be in the middle of an item, the link itself 527 -- will be clipped with a call to Clip_Line_On_Top_Level 528 529 function Clip_Line 530 (Self : not null access Abstract_Item_Record; 531 P1, P2 : Item_Point) return Item_Point is abstract; 532 -- Returns the intersection of the line from P1 to P2 with the border of 533 -- the item. Drawing a line from this intersection point to P2 will not 534 -- intersect the item. 535 536 function Model_Bounding_Box 537 (Self : not null access Abstract_Item_Record'Class) 538 return Model_Rectangle; 539 -- Return the bounding box of Self always in model coordinates. 540 -- As opposed to Bounding_Box, model coordinates are also returned 541 -- for nested items. 542 543 function Is_Invisible 544 (Self : not null access Abstract_Item_Record) 545 return Boolean is abstract; 546 -- True if Self has no filling or stroke information (and therefore is 547 -- invisible even when displayed, although some of its children might be 548 -- visible). 549 -- This function is independent of Set_Visibility_Threshold, Show or Hide. 550 551 procedure Set_Visibility_Threshold 552 (Self : not null access Abstract_Item_Record; 553 Threshold : Gdouble) is null; 554 function Get_Visibility_Threshold 555 (Self : not null access Abstract_Item_Record) return Gdouble is abstract; 556 -- When the items bounding box (on the screen) width or height are less 557 -- than Threshold pixels, the item is automatically hidden. 558 -- Making the item invisibile does not impact the visibility of links from 559 -- or to that item (but you could use Include_Related_Items to find these 560 -- related items. 561 -- You need to refresh the view afterwards 562 563 procedure Show (Self : not null access Abstract_Item_Record'Class); 564 procedure Hide (Self : not null access Abstract_Item_Record'Class); 565 -- Hide or show the item unconditionally. This overrides the settings 566 -- done by Set_Visibility_Threshold. 567 568 ----------- 569 -- Items -- 570 ----------- 571 572 type Canvas_Item_Record is abstract new Abstract_Item_Record with private; 573 type Canvas_Item is access all Canvas_Item_Record'Class; 574 -- An implementation of the Abstract_Item interface, which handles a 575 -- number of the operations automatically. For instance, it will store the 576 -- position of the item and its bounding box. 577 -- It is easier to derive from this type when you want to create your own 578 -- items, unless you want complete control of the data storage. 579 580 overriding function Is_Link 581 (Self : not null access Canvas_Item_Record) return Boolean is (False); 582 overriding function Parent 583 (Self : not null access Canvas_Item_Record) 584 return Abstract_Item is (null); 585 overriding function Is_Invisible 586 (Self : not null access Canvas_Item_Record) 587 return Boolean is (False); 588 function Inner_Most_Item 589 (Self : not null access Canvas_Item_Record; 590 At_Point : Model_Point; 591 Context : Draw_Context) 592 return Abstract_Item is (Self); 593 overriding function Position 594 (Self : not null access Canvas_Item_Record) return Gtkada.Style.Point; 595 overriding function Contains 596 (Self : not null access Canvas_Item_Record; 597 Point : Item_Point; 598 Context : Draw_Context) return Boolean; 599 overriding function Link_Anchor_Point 600 (Self : not null access Canvas_Item_Record; 601 Anchor : Anchor_Attachment) 602 return Item_Point; 603 overriding function Clip_Line 604 (Self : not null access Canvas_Item_Record; 605 P1, P2 : Item_Point) return Item_Point; 606 overriding function Edit_Widget 607 (Self : not null access Canvas_Item_Record; 608 View : not null access Canvas_View_Record'Class) 609 return Gtk.Widget.Gtk_Widget; 610 overriding procedure Draw_As_Selected 611 (Self : not null access Canvas_Item_Record; 612 Context : Draw_Context); 613 overriding procedure Draw_Outline 614 (Self : not null access Canvas_Item_Record; 615 Style : Gtkada.Style.Drawing_Style; 616 Context : Draw_Context); 617 overriding procedure Set_Visibility_Threshold 618 (Self : not null access Canvas_Item_Record; 619 Threshold : Gdouble); 620 overriding function Get_Visibility_Threshold 621 (Self : not null access Canvas_Item_Record) return Gdouble; 622 623 overriding procedure Set_Position 624 (Self : not null access Canvas_Item_Record; 625 Pos : Gtkada.Style.Point); 626 -- Sets the position of the item within its parent (or within the canvas 627 -- view if Self has no parent). 628 629 ------------------ 630 -- Canvas_Model -- 631 ------------------ 632 633 function Model_Get_Type return Glib.GType; 634 pragma Convention (C, Model_Get_Type); 635 -- Return the internal type 636 637 procedure Initialize 638 (Self : not null access Canvas_Model_Record'Class); 639 -- Initialize the internal data so that signals can be sent. 640 -- This procedure must always be called when you create a new model. 641 642 type Item_Kind_Filter is (Kind_Item, Kind_Link, Kind_Any); 643 procedure For_Each_Item 644 (Self : not null access Canvas_Model_Record; 645 Callback : not null access procedure 646 (Item : not null access Abstract_Item_Record'Class); 647 Selected_Only : Boolean := False; 648 Filter : Item_Kind_Filter := Kind_Any; 649 In_Area : Model_Rectangle := No_Rectangle) is abstract; 650 -- Calls Callback for each item in the model, including links. 651 -- Only the items that intersect In_Area should be returned for 652 -- efficiency, although it is valid to return all items. 653 -- 654 -- If Selected_Only is true, then only selected items are returned 655 -- 656 -- Items are returned in z-layer order: lowest items first, highest items 657 -- last. 658 -- 659 -- You should not remove items while iterating, since removing items might 660 -- end up removing other items (links to or from the original item for 661 -- instance). Instead, create a temporary structure via 662 -- Include_Related_Items and use Remove to remove them all at once. 663 664 function Hash (Key : Abstract_Item) return Ada.Containers.Hash_Type; 665 package Item_Sets is new Ada.Containers.Hashed_Sets 666 (Element_Type => Abstract_Item, 667 Hash => Hash, 668 Equivalent_Elements => "=", 669 "=" => "="); 670 671 procedure For_Each_Link 672 (Self : not null access Canvas_Model_Record; 673 Callback : not null access procedure 674 (Item : not null access Abstract_Item_Record'Class); 675 From_Or_To : Item_Sets.Set); 676 -- This iterator should return all the links in the model. 677 -- If possible, it should restrict itself to the links with at least one 678 -- end on an item in From_Or_To (or on a link to such an item). 679 -- This function is important for performance when draggin items in a 680 -- large model (tens of thousands of items). The default implementation 681 -- simply calls For_Each_Item. 682 -- From_Or_To is never empty. 683 684 procedure Include_Related_Items 685 (Self : not null access Canvas_Model_Record'Class; 686 Item : not null access Abstract_Item_Record'Class; 687 Set : in out Item_Sets.Set); 688 -- Append Item and all items and links related to Item (i.e. the links for 689 -- which one of the ends is Item, and then the links to these links, and so 690 -- on). 691 692 function Bounding_Box 693 (Self : not null access Canvas_Model_Record; 694 Margin : Model_Coordinate := 0.0) 695 return Model_Rectangle; 696 -- Returns the rectangle that encompasses all the items in the model. 697 -- This is used by views to compute the maximum area that should be made 698 -- visible. 699 -- An extra margin is added to each side of the box. 700 -- The default implementation is not efficient, since it will iterate all 701 -- items one by one to compute the rectangle. No caching is done. 702 703 procedure Refresh_Layout 704 (Self : not null access Canvas_Model_Record; 705 Send_Signal : Boolean := True); 706 -- Refresh the layout of Self. 707 -- This procedure should be called every time items are moved (because 708 -- this impacts links to or from these items), or when they are added or 709 -- removed (it could also impact the layout of links if they displays to 710 -- avoid going underneath items). 711 -- This procedure is also used to compute the size of items (see 712 -- Container_Item below). 713 -- The default implementation will simply iterate over all items, but it 714 -- could be implemented more efficiently. 715 -- 716 -- This procedure will in general send a Layout_Changed signal if 717 -- Send_Signal is true. This should in general always be left to True 718 -- unless you are writting your own model. 719 -- 720 -- WARNING: this procedure must be called only once at least one view has 721 -- been created for the model. This ensures that the necessary information 722 -- for the layout of text has been retrieved from the view layer. If you 723 -- do not have at least one view, all text will be hidden or displayed as 724 -- ellipsis. 725 -- In fact, this procedure is called automatically on the model the first 726 -- time it is associated with a view. 727 728 function Toplevel_Item_At 729 (Self : not null access Canvas_Model_Record; 730 Point : Model_Point; 731 Context : Draw_Context) return Abstract_Item; 732 -- Return the toplevel item at the specific coordinates (if any). 733 -- The default implementation simply traverses the list of items, and 734 -- calls Contains on each child. 735 -- This function returns the topmost item 736 737 procedure Remove 738 (Self : not null access Canvas_Model_Record; 739 Item : not null access Abstract_Item_Record'Class) is null; 740 -- Remove an item to the model, and destroy it. 741 -- This also removes all links to and from the element, and links to 742 -- these links (and so on). 743 744 procedure Remove 745 (Self : not null access Canvas_Model_Record; 746 Set : Item_Sets.Set); 747 -- Remove all elements in the set from the model. 748 -- It is expected that the set already contains related items (see 749 -- Include_Related_Items) 750 -- The default implementation is to call Remove for each of the element in 751 -- the set, so you will need to override this procedure if your 752 -- implementation of Remove calls this one. 753 754 procedure Raise_Item 755 (Self : not null access Canvas_Model_Record; 756 Item : not null access Abstract_Item_Record'Class) is abstract; 757 procedure Lower_Item 758 (Self : not null access Canvas_Model_Record; 759 Item : not null access Abstract_Item_Record'Class) is abstract; 760 -- Change the z-order of the item. 761 -- This emits the layout_changed signal 762 763 type Selection_Mode is 764 (Selection_None, Selection_Single, Selection_Multiple); 765 procedure Set_Selection_Mode 766 (Self : not null access Canvas_Model_Record; 767 Mode : Selection_Mode); 768 -- Controls whether items can be selected. 769 -- Changing the mode always clears the selection. 770 771 procedure Clear_Selection (Self : not null access Canvas_Model_Record); 772 procedure Add_To_Selection 773 (Self : not null access Canvas_Model_Record; 774 Item : not null access Abstract_Item_Record'Class); 775 procedure Remove_From_Selection 776 (Self : not null access Canvas_Model_Record; 777 Item : not null access Abstract_Item_Record'Class); 778 function Is_Selected 779 (Self : not null access Canvas_Model_Record; 780 Item : not null access Abstract_Item_Record'Class) 781 return Boolean; 782 -- Handling of selection. Depending on the selection mode, some of these 783 -- operations might have no effect, or might unselect the current selection 784 -- before selecting a new item. 785 -- The selection might contain child items (i.e. not just toplevel items). 786 -- 787 -- Whenever the selection is changed, the signal "selection_changed" is 788 -- emitted. 789 790 function Is_Selectable 791 (Self : not null access Canvas_Model_Record; 792 Item : not null access Abstract_Item_Record'Class) 793 return Boolean is (True); 794 -- Whether the given item is selectable. By default, all items are 795 -- selectable. 796 797 procedure Selection_Changed 798 (Self : not null access Canvas_Model_Record'Class; 799 Item : access Abstract_Item_Record'Class := null); 800 function On_Selection_Changed 801 (Self : not null access Canvas_Model_Record'Class; 802 Call : not null access procedure 803 (Self : not null access GObject_Record'Class; 804 Item : Abstract_Item); 805 Slot : access GObject_Record'Class := null) 806 return Gtk.Handlers.Handler_Id; 807 Signal_Selection_Changed : constant Glib.Signal_Name := "selection_changed"; 808 -- Item is set to null when the selection was cleared, otherwise it is 809 -- set to the element that was just added or removed from the selection. 810 811 procedure Layout_Changed (Self : not null access Canvas_Model_Record'Class); 812 function On_Layout_Changed 813 (Self : not null access Canvas_Model_Record'Class; 814 Call : not null access procedure 815 (Self : not null access GObject_Record'Class); 816 Slot : access GObject_Record'Class := null) 817 return Gtk.Handlers.Handler_Id; 818 Signal_Layout_Changed : constant Glib.Signal_Name := "layout_changed"; 819 -- Emits or handles the "layout_changed" signal. 820 -- This signal must be emitted by models whenever new items are added, 821 -- existing items are resized or removed, or any other event that impacts 822 -- coordinates of any item in the model. 823 -- It is recommended to emit this signal only once per batch of changes, 824 825 procedure Item_Contents_Changed 826 (Self : not null access Canvas_Model_Record'Class; 827 Item : not null access Abstract_Item_Record'Class); 828 function On_Item_Contents_Changed 829 (Self : not null access Canvas_Model_Record'Class; 830 Call : not null access procedure 831 (Self : access GObject_Record'Class; Item : Abstract_Item); 832 Slot : access GObject_Record'Class := null) 833 return Gtk.Handlers.Handler_Id; 834 Signal_Item_Contents_Changed : constant Glib.Signal_Name := 835 "item_contents_changed"; 836 -- This signal should be emitted instead of layout_changed when only the 837 -- contents of an item (but not its size) has changed). This will only 838 -- trigger the refresh of that specific item. 839 840 function On_Item_Destroyed 841 (Self : not null access Canvas_Model_Record'Class; 842 Call : not null access procedure 843 (Self : access GObject_Record'Class; 844 Item : Abstract_Item); 845 Slot : access GObject_Record'Class := null) 846 return Gtk.Handlers.Handler_Id; 847 Signal_Item_Destroyed : constant Glib.Signal_Name := "item_destroyed"; 848 -- This signal is emitted just before an item is destroyed. 849 850 ---------------- 851 -- List Model -- 852 ---------------- 853 854 type List_Canvas_Model_Record is new Canvas_Model_Record with private; 855 type List_Canvas_Model is access all List_Canvas_Model_Record'Class; 856 -- A very simple-minded concrete implementation for a model. 857 -- This model is suitable for most cases where only a few thousands items 858 -- are displayed. If you have tens of thousands, you should consider 859 -- wrapping this model with a Gtkada.Canvas_View.Models.Rtree_Model to 860 -- speed things up. 861 862 procedure Gtk_New (Self : out List_Canvas_Model); 863 -- Create a new model 864 865 procedure Add 866 (Self : not null access List_Canvas_Model_Record; 867 Item : not null access Abstract_Item_Record'Class); 868 -- Add a new item to the model. 869 870 procedure Clear 871 (Self : not null access List_Canvas_Model_Record); 872 -- Remove all items from the model, and destroy them. 873 874 overriding procedure Remove 875 (Self : not null access List_Canvas_Model_Record; 876 Item : not null access Abstract_Item_Record'Class); 877 overriding procedure Remove 878 (Self : not null access List_Canvas_Model_Record; 879 Set : Item_Sets.Set); 880 overriding procedure For_Each_Item 881 (Self : not null access List_Canvas_Model_Record; 882 Callback : not null access procedure 883 (Item : not null access Abstract_Item_Record'Class); 884 Selected_Only : Boolean := False; 885 Filter : Item_Kind_Filter := Kind_Any; 886 In_Area : Model_Rectangle := No_Rectangle); 887 overriding procedure Raise_Item 888 (Self : not null access List_Canvas_Model_Record; 889 Item : not null access Abstract_Item_Record'Class); 890 overriding procedure Lower_Item 891 (Self : not null access List_Canvas_Model_Record; 892 Item : not null access Abstract_Item_Record'Class); 893 overriding function Toplevel_Item_At 894 (Self : not null access List_Canvas_Model_Record; 895 Point : Model_Point; 896 Context : Draw_Context) return Abstract_Item; 897 898 ----------------- 899 -- Canvas_View -- 900 ----------------- 901 902 View_Margin : constant View_Coordinate := 20.0; 903 -- The number of blank pixels on each sides of the view. This avoids having 904 -- items displays exactly next to the border of the view. 905 906 procedure Gtk_New 907 (Self : out Canvas_View; 908 Model : access Canvas_Model_Record'Class := null); 909 procedure Initialize 910 (Self : not null access Canvas_View_Record'Class; 911 Model : access Canvas_Model_Record'Class := null); 912 -- Create a new view which displays the model. 913 -- A new reference to the model is created (and released when the view is 914 -- destroyed), so that in general the code will look like: 915 -- Model := new ....; 916 -- Initialize (Model); 917 -- Gtk_New (View, Model); 918 -- Unref (Model); -- unless you need to keep a handle on it too 919 920 procedure Set_Model 921 (Self : not null access Canvas_View_Record'Class; 922 Model : access Canvas_Model_Record'Class); 923 -- Change the model, and redraw the whole draw. 924 925 function Model 926 (Self : not null access Canvas_View_Record'Class) 927 return Canvas_Model; 928 -- Return the model 929 930 function View_Get_Type return Glib.GType; 931 pragma Convention (C, View_Get_Type); 932 -- Return the internal type 933 934 procedure Set_Grid_Size 935 (Self : not null access Canvas_View_Record'Class; 936 Size : Model_Coordinate := 30.0); 937 -- Set the size of the grid. 938 -- This grid is not visible by default. To display it, you should override 939 -- Draw_Internal and call one of the functions in Gtkada.Canvas_View.Views. 940 -- 941 -- This grid is also size for snapping of items while they are moved: when 942 -- they are dragged to a position close to one of the grid lines, they will 943 -- be moved by a small extra amount to align on this grid line. 944 945 Default_Guide_Style : constant Gtkada.Style.Drawing_Style := 946 Gtkada.Style.Gtk_New (Stroke => (0.957, 0.363, 0.913, 1.0)); 947 948 procedure Set_Snap 949 (Self : not null access Canvas_View_Record'Class; 950 Snap_To_Grid : Boolean := True; 951 Snap_To_Guides : Boolean := False; 952 Snap_Margin : Model_Coordinate := 5.0; 953 Guides_Style : Gtkada.Style.Drawing_Style := Default_Guide_Style); 954 -- Configure the snapping feature. 955 -- When items are moved interactively, they will tend to snap to various 956 -- coordinates, as defined for instance by Set_Grid_Size. 957 -- For instance, when any size of the item gets close to one of the grid 958 -- lines (i.e. less than Snap_Margin), it will be moved an extra small 959 -- amount so that the coordinate of that size of the item is exactly that 960 -- of the grid line. This results in nicer alignment of the items. 961 -- 962 -- No snapping to grid occurs if the grid size is set to 0. 963 964 procedure Draw_Internal 965 (Self : not null access Canvas_View_Record; 966 Context : Draw_Context; 967 Area : Model_Rectangle); 968 -- Redraw either the whole view, or a specific part of it only. 969 -- The transformation matrix has already been set on the context. 970 -- This procedure can be overridden if you need to perform special 971 -- operations, like drawing a grid for instance. See the various helper 972 -- subprograms in Gtkada.Canvas_View.Views to do so. 973 974 function Get_Visible_Area 975 (Self : not null access Canvas_View_Record) 976 return Model_Rectangle; 977 -- Return the area of the model that is currently displayed in the view. 978 -- This is in model coordinates (since the canvas coordinates are always 979 -- from (0,0) to (Self.Get_Allocation_Width, Self.Get_Allocation_Height). 980 981 procedure Set_Transform 982 (Self : not null access Canvas_View_Record; 983 Cr : Cairo.Cairo_Context; 984 Item : access Abstract_Item_Record'Class := null); 985 -- Set the transformation matrix for the current settings (scrolling and 986 -- zooming). 987 -- 988 -- The effect is that any drawing on this context should now be done using 989 -- the model coordinates, which will automatically be converted to the 990 -- canvas_coordinates internally. 991 -- 992 -- If Item is specified, all drawing becomes relative to that item 993 -- instead of the position of the top-left corner of the view. All drawing 994 -- to this context must then be done in item_coordinates, which will 995 -- automatically be converted to canvas_coordinates internally. 996 -- 997 -- This procedure does not need to be call directly in general, since the 998 -- context passed to the Draw primitive of the item has already been set 999 -- up appropriately. 1000 -- 1001 -- The default coordinates follow the industry standard of having y 1002 -- increase downwards. This is sometimes unusual for mathematically- 1003 -- oriented people. One solution is to override this procedure in your 1004 -- own view, and call Cairo.Set_Scale as in: 1005 -- procedure Set_Transform (Self, Cr) is 1006 -- Set_Transform (Canvas_View_Record (Self.all)'Access, Cr); 1007 -- Cairo.Set_Scale (Cr, 1.0, -1.0); 1008 -- which will make y increase upwards instead. 1009 1010 function View_To_Model 1011 (Self : not null access Canvas_View_Record; 1012 Rect : View_Rectangle) return Model_Rectangle; 1013 function View_To_Model 1014 (Self : not null access Canvas_View_Record; 1015 P : View_Point) return Model_Point; 1016 function Model_To_View 1017 (Self : not null access Canvas_View_Record; 1018 Rect : Model_Rectangle) return View_Rectangle; 1019 function Model_To_View 1020 (Self : not null access Canvas_View_Record; 1021 P : Model_Point) return View_Point; 1022 function Model_To_Window 1023 (Self : not null access Canvas_View_Record; 1024 Rect : Model_Rectangle) return Window_Rectangle; 1025 function Window_To_Model 1026 (Self : not null access Canvas_View_Record; 1027 Rect : Window_Rectangle) return Model_Rectangle; 1028 function Window_To_Model 1029 (Self : not null access Canvas_View_Record; 1030 P : Window_Point) return Model_Point; 1031 function Item_To_Model 1032 (Item : not null access Abstract_Item_Record'Class; 1033 Rect : Item_Rectangle) return Model_Rectangle; 1034 function Item_To_Model 1035 (Item : not null access Abstract_Item_Record'Class; 1036 P : Item_Point) return Model_Point; 1037 function Model_To_Item 1038 (Item : not null access Abstract_Item_Record'Class; 1039 P : Model_Point) return Item_Point; 1040 function Model_To_Item 1041 (Item : not null access Abstract_Item_Record'Class; 1042 P : Model_Rectangle) return Item_Rectangle; 1043 -- Conversion between the various coordinate systems. 1044 -- Calling these should seldom be needed, as Cairo uses a transformation 1045 -- matrix to automatically (and efficiently) do the transformation on 1046 -- your behalf. See the documentation for Set_Transform. 1047 1048 procedure Set_Selection_Style 1049 (Self : not null access Canvas_View_Record; 1050 Style : Gtkada.Style.Drawing_Style); 1051 function Get_Selection_Style 1052 (Self : not null access Canvas_View_Record) 1053 return Gtkada.Style.Drawing_Style; 1054 -- The style used to highlight selected items 1055 1056 procedure Set_Scale 1057 (Self : not null access Canvas_View_Record; 1058 Scale : Gdouble := 1.0; 1059 Preserve : Model_Point := No_Point); 1060 -- Changes the scaling factor for Self. 1061 -- This also scrolls the view so that either Preserve or the current center 1062 -- of the view remains at the same location in the widget, as if the user 1063 -- was zooming towards that specific point. 1064 -- See also Gtkada.Canvas_View.Views.Animate_Scale for a way to do this 1065 -- change via an animation. 1066 1067 procedure Set_Topleft 1068 (Self : not null access Canvas_View_Record; 1069 Topleft : Model_Point); 1070 -- Set a specific position for the topleft corner of the visible area. 1071 -- This function is mostly useful to restore previous settings (which you 1072 -- can get through Get_Visible_Area). Interactively, it is likely better 1073 -- to call one of Center_On, Scroll_Into_View or Scale_To_Fit. 1074 1075 procedure Center_On 1076 (Self : not null access Canvas_View_Record; 1077 Center_On : Model_Point; 1078 X_Pos, Y_Pos : Gdouble := 0.5; 1079 Duration : Standard.Duration := 0.0); 1080 -- Scroll the canvas so that Center_On appears at the given position 1081 -- within the view (center when using 0.5, or left when using 0.0, and so 1082 -- on). 1083 -- If the duration is not 0, animation is used. 1084 1085 procedure Scroll_Into_View 1086 (Self : not null access Canvas_View_Record; 1087 Item : not null access Abstract_Item_Record'Class; 1088 Duration : Standard.Duration := 0.0); 1089 procedure Scroll_Into_View 1090 (Self : not null access Canvas_View_Record; 1091 Rect : Model_Rectangle; 1092 Duration : Standard.Duration := 0.0); 1093 -- Do the minimal amount of scrolling to make the item or rectangle 1094 -- visible. If the duration is not 0, animation is used. 1095 1096 function Get_Scale 1097 (Self : not null access Canvas_View_Record) return Gdouble; 1098 -- Return the current scale 1099 1100 procedure Scale_To_Fit 1101 (Self : not null access Canvas_View_Record; 1102 Rect : Model_Rectangle := No_Rectangle; 1103 Min_Scale : Gdouble := 1.0 / 4.0; 1104 Max_Scale : Gdouble := 4.0; 1105 Duration : Standard.Duration := 0.0); 1106 -- Chose the scale and scroll position so that the whole model (or the 1107 -- specified rectangle) is visible. 1108 -- This procedure leaves a small margin on each sides of the model, since 1109 -- that looks nicer. 1110 -- This function can be called even before Self has got a size assigned by 1111 -- window manager, but the computation of the scale will be delayed until 1112 -- an actual size is known. 1113 -- If a duration is specified, the scaling and scrolling will be animated 1114 1115 procedure Avoid_Overlap 1116 (Self : not null access Canvas_View_Record'Class; 1117 Avoid : Boolean; 1118 Duration : Standard.Duration := 0.2); 1119 -- Sets whether items should avoid overlap when possible. 1120 -- When the user is moving items interactively and dropping them in a new 1121 -- position, items that would be overlapped are moved aside to make space 1122 -- for the new item. 1123 -- If Duration is not 0, the other items are animated to the new position. 1124 -- 1125 -- This setting has no effect when you set the position of items 1126 -- explicitly via a call to Set_Position. In such cases, you can force 1127 -- the behavior manually by calling Gtkada.Canvas_View.Views.Reserve_Space. 1128 1129 type Page_Format is record 1130 Width_In_Inches, Height_In_Inches : Gdouble; 1131 end record; 1132 1133 A3_Portrait : constant Page_Format := (11.7, 16.5); 1134 A3_Landscape : constant Page_Format := (16.5, 11.7); 1135 A4_Portrait : constant Page_Format := (8.3, 11.7); 1136 A4_Landscape : constant Page_Format := (11.7, 8.3); 1137 Letter_Portrait : constant Page_Format := (8.5, 11.0); 1138 Letter_Landscape : constant Page_Format := (11.0, 8.5); 1139 1140 type Export_Format is (Export_PDF, Export_SVG, Export_PNG); 1141 1142 function Export 1143 (Self : not null access Canvas_View_Record; 1144 Filename : String; 1145 Page : Page_Format; 1146 Format : Export_Format := Export_PDF; 1147 Visible_Area_Only : Boolean := True) 1148 return Boolean; 1149 -- Create a file with the contents of the view (or the whole model 1150 -- if Visible_Area_Only is False). 1151 -- True is returned if the file was created successfully, False otherwise 1152 1153 No_Drag_Allowed : constant Model_Rectangle := (0.0, 0.0, 0.0, 0.0); 1154 Drag_Anywhere : constant Model_Rectangle := 1155 (Gdouble'First, Gdouble'First, Gdouble'Last, Gdouble'Last); 1156 -- Values for the Event_Details.Allowed_Drag_Area field 1157 1158 type Canvas_Event_Type is 1159 (Button_Press, Button_Release, Double_Click, 1160 Start_Drag, In_Drag, End_Drag, Key_Press, Scroll, Custom); 1161 -- The event types that are emitted for the Item_Event signal: 1162 -- * Button_Press is called when the user presses any mouse buttton either 1163 -- on an item or in the background. 1164 -- This event can also be used to start a drag event (by 1165 -- setting the Allowed_Drag_Area field of the Canvas_Event_Details). 1166 -- It can be used also to display contextual menus. 1167 -- 1168 -- * Double_Click is used when the left mouse button is pressed twice in 1169 -- rapid succession (note that Button_Press is also emitted for the first 1170 -- click). 1171 -- 1172 -- * Start_Drag is used after a user has pressed a mouse button, and the 1173 -- callback has enabled a drag area, and the mouse has moved by at least 1174 -- a small margin. It applies to either the item (and all other selected 1175 -- items, or to the background, for instance to scroll the canvas). 1176 -- 1177 -- * In_Drag is used during an actual drag. 1178 -- 1179 -- * End_Drag is used after a successfull drag, when the mouse is released. 1180 -- 1181 -- * Button_Release is called when the mouse is released but no drag action 1182 -- too place. This is the event to use to modify the current selection, 1183 -- either by unselecting everything, adding the specific item to the 1184 -- selection,... 1185 -- 1186 -- * Key_Press is used when the user types something on the keyboard while 1187 -- the canvas has the focus. It can be used to move items with the arrow 1188 -- keys, edit an item,... 1189 -- 1190 -- * Scroll is used when the user uses the mouse wheel. It is not possible 1191 -- to start a drag from this event. 1192 -- In the Canvas_Event_Details, the button is set to either 5 or 6, 1193 -- depending on the direction of the scrolling. 1194 -- 1195 -- * Custom is used when generating a custom event from the code. 1196 1197 type Canvas_Event_Details is record 1198 Event_Type : Canvas_Event_Type; 1199 Button : Guint; 1200 1201 State : Gdk.Types.Gdk_Modifier_Type; 1202 -- The modifier keys (shift, alt, control). It can be used to activate 1203 -- different behavior in such cases. 1204 1205 Key : Gdk.Types.Gdk_Key_Type; 1206 -- The key that was pressed (for key events) 1207 1208 Root_Point : Gtkada.Style.Point; 1209 -- Coordinates in root window. 1210 -- Attributes of the low-level event. 1211 -- This is an implementation detail for proper handling of dragging. 1212 1213 M_Point : Model_Point; 1214 -- Where in the model the user clicked. This is independent of the zoom 1215 -- level or current scrolling. 1216 1217 Item : Abstract_Item; 1218 -- The actual item that was clicked. 1219 -- Set to null when the user clicked in the background. 1220 1221 Toplevel_Item : Abstract_Item; 1222 -- The toplevel item that contains Item (might be Item itself). 1223 -- Set to null when the user clicked in the background. 1224 1225 T_Point : Item_Point; 1226 -- The corodinates of the click in toplevel_item 1227 1228 I_Point : Item_Point; 1229 -- The coordinates of the click in Item 1230 1231 Allowed_Drag_Area : Model_Rectangle := No_Drag_Allowed; 1232 -- Allowed_Drag_Area should be modified by the callback when the event 1233 -- is a button_press event. It should be set to the area within which 1234 -- the item (and all currently selected items) can be moved. If you 1235 -- leave it to No_Drag_Allowed, the item cannot be moved. 1236 -- 1237 -- This field is ignored for events other than button_press, since it 1238 -- makes no sense for instance to start a drag on a button release. 1239 1240 Allow_Snapping : Boolean := True; 1241 -- If set to False, this temporary overrides the settings from 1242 -- Set_Snap, and prevents any snapping on the grid or smart guides. 1243 -- It should be set at the same time that Allowed_Drag_Area is set. 1244 end record; 1245 type Event_Details_Access is not null access all Canvas_Event_Details; 1246 -- This record describes high-level aspects of user interaction with the 1247 -- canvas. 1248 1249 procedure Initialize_Details 1250 (Self : not null access Canvas_View_Record'Class; 1251 Details : out Canvas_Event_Details); 1252 -- Initialize Details for a Custom event type. 1253 -- When you have a real Gtk event, better to use Set_Details below. 1254 1255 procedure Set_Details 1256 (Self : not null access Canvas_View_Record'Class; 1257 Details : out Canvas_Event_Details; 1258 Event : Gdk.Event.Gdk_Event_Button); 1259 -- Set the details from a specific gtk+ event 1260 1261 procedure Viewport_Changed 1262 (Self : not null access Canvas_View_Record'Class); 1263 function On_Viewport_Changed 1264 (Self : not null access Canvas_View_Record'Class; 1265 Call : not null access procedure 1266 (Self : not null access GObject_Record'Class); 1267 Slot : access GObject_Record'Class := null) 1268 return Gtk.Handlers.Handler_Id; 1269 Signal_Viewport_Changed : constant Glib.Signal_Name := "viewport_changed"; 1270 -- This signal is emitted whenever the view is zoomed or scrolled. 1271 -- This can be used for instance to synchronize multiple views, or display 1272 -- a "mini-map" of the whole view. 1273 1274 function Item_Event 1275 (Self : not null access Canvas_View_Record'Class; 1276 Details : Event_Details_Access) return Boolean; 1277 procedure On_Item_Event 1278 (Self : not null access Canvas_View_Record'Class; 1279 Call : not null access function 1280 (Self : not null access GObject_Record'Class; 1281 Details : Event_Details_Access) 1282 return Boolean; 1283 Slot : access GObject_Record'Class := null); 1284 Signal_Item_Event : constant Glib.Signal_Name := "item_event"; 1285 -- This signal is emitted whenever the user interacts with an item (button 1286 -- press or release, key events,...). 1287 -- It is recommended to connect to this signal rather than the lower-level 1288 -- Button_Press_Event, Button_Release_Event,... since most information is 1289 -- provided here in the form of the details parameter. 1290 -- 1291 -- The callback should return True if the event was processed, or False if 1292 -- the default handling should be performed. 1293 -- 1294 -- The package Gtkada.Canvas_View.Views contains a number of examples of 1295 -- compatible callbacks which enable behaviors such as a moving items, 1296 -- scrolling the canvas by dragging the background,... 1297 1298 ------------------------ 1299 -- Object hierarchies -- 1300 ------------------------ 1301 -- The above declarations for Abstract_Item and Canvas_Item will let you 1302 -- create your own custom items. However, they will require the overriding 1303 -- of a number of subprograms to be useful. 1304 -- Instead, some predefined types of items are defined below, which can 1305 -- be combined into a hierarchy of items: toplevel items act as 1306 -- containers for one or more other objets. The size of items can be 1307 -- computed automatically, or forced when the item is created. 1308 -- 1309 -- Children can be put at specific coordinates in their parents, or 1310 -- stacked vertically or horizontally. 1311 1312 type Container_Item_Record is abstract new Canvas_Item_Record with private; 1313 type Container_Item is access all Container_Item_Record'Class; 1314 1315 type Child_Layout_Strategy is (Horizontal_Stack, Vertical_Stack); 1316 procedure Set_Child_Layout 1317 (Self : not null access Container_Item_Record'Class; 1318 Layout : Child_Layout_Strategy); 1319 -- How should the children of a container be organized: either one on top 1320 -- of another, or one next to another. 1321 1322 type Margins is record 1323 Top, Right, Bottom, Left : Model_Coordinate; 1324 end record; 1325 No_Margins : constant Margins := (0.0, 0.0, 0.0, 0.0); 1326 1327 type Alignment_Style is (Align_Start, Align_Center, Align_End); 1328 -- How an item should be aligned within its parent. 1329 -- When the parent stacks its children vertically, alignment is taken into 1330 -- account horizontally; and similarly when the parent organizes its 1331 -- children horizontally, the alignment is vertical. 1332 -- 1333 -- When an item does not request a specific size along the alignment axis, 1334 -- it always uses the full width or height of its parent, so the alignment 1335 -- does not play a role. 1336 -- 1337 -- However, when the item requests a size smaller than its parent's along 1338 -- the alignment axis, extra margin needs to be added, and they are added 1339 -- either to its left/top (when Align_Start), to both sides (when 1340 -- Align_Center), or to its right/bottom (when Align_End).. 1341 -- 1342 -- Alignment does not apply to floating children, nor to children with 1343 -- a specific position given along a specific axis (in which case the 1344 -- Anchor_X or Anchor_Y might be used for a slightly similar effect). 1345 1346 type Overflow_Style is (Overflow_Prevent, Overflow_Hide); 1347 -- An overflow situation occurs when an item's contents is larger than its 1348 -- contents. 1349 -- If Overflow_Prevent is true, an item will always request enough size to 1350 -- fit all its contents. There might still be cases where the parent item 1351 -- was set to a small size, though, and the overflow is hidden nonetheless. 1352 -- If Overflow_Hide is true, an item will request a minimal size, and 1353 -- simply hide the part of its contents that does not fit. 1354 1355 procedure Add_Child 1356 (Self : not null access Container_Item_Record'Class; 1357 Child : not null access Container_Item_Record'Class; 1358 Align : Alignment_Style := Align_Start; 1359 Pack_End : Boolean := False; 1360 Margin : Margins := No_Margins; 1361 Float : Boolean := False; 1362 Overflow : Overflow_Style := Overflow_Prevent); 1363 -- Add a new child to the container. 1364 -- If the child's position is set, it is then interpreted as relative to 1365 -- Self. If the position is not specified, it will be computed 1366 -- automatically based on the container's policy (either below the previous 1367 -- child, or to its right). 1368 -- 1369 -- When Pack_End is true, the child will be added at the end of the 1370 -- parent's area (right or bottom depending on orientation). If the 1371 -- parent's size is larger than that needed by all its children, there 1372 -- will thus be an empty space between children with Pack_End=>False and 1373 -- children with Pack_End => True. 1374 -- 1375 -- When Pack_End is True, the children are put in reverse order starting 1376 -- from the end of Self: for a vertical layout, for instance, the first 1377 -- pack_end child will appear at the bottom of Self. 1378 -- 1379 -- Margin are added to each size of the child. The child's width, as set 1380 -- via Set_Size, does not include the margins. 1381 -- 1382 -- A floating child does not participate in the stacking: it will still be 1383 -- displayed below or to the right of the previous child, but the next 1384 -- item will then be displayed at the same coordinate as the floating 1385 -- child. 1386 1387 procedure Clear 1388 (Self : not null access Container_Item_Record; 1389 In_Model : not null access Canvas_Model_Record'Class); 1390 -- Remove all children of Self 1391 1392 type Size_Unit is (Unit_Pixels, Unit_Percent, Unit_Auto, Unit_Fit); 1393 -- A size can be expressed either in actual screen pixels, or 1394 -- proportionnaly to the parent's size. 1395 -- When the unit is Unit_Auto, the size of the item is computed 1396 -- automatically based on its children or its own intrinsic needs 1397 -- (for a text, this is the size needed to display the text in the given 1398 -- font). 1399 -- When the unit is Unit_Fit: this sets the width of a child so that 1400 -- this width plus the child's margins take the full width of the parent 1401 -- container. Setting a width to 100% using Unit_Percent would not take 1402 -- the margins into account, so that the full size (margins+width) might 1403 -- actually be wider than the parent. When the parent layout is 1404 -- horizontal, the above description applies to the height of the child. 1405 -- In both cases, Unit_Fit is ignored for the other axis (height for 1406 -- a vertical layout), in which case the child's height will be that 1407 -- computed from the children. 1408 1409 type Size (Unit : Size_Unit := Unit_Pixels) is record 1410 case Unit is 1411 when Unit_Auto | Unit_Fit => 1412 null; 1413 when Unit_Pixels => 1414 Length : Model_Coordinate; 1415 when Unit_Percent => 1416 Value : Percent; 1417 end case; 1418 end record; 1419 1420 Auto_Size : constant Size := (Unit => Unit_Auto); 1421 Fit_Size : constant Size := (Unit => Unit_Fit); 1422 -- See the descriptions for Size_Unit. 1423 1424 procedure Set_Width_Range 1425 (Self : not null access Container_Item_Record; 1426 Min, Max : Size := Auto_Size); 1427 procedure Set_Height_Range 1428 (Self : not null access Container_Item_Record; 1429 Min, Max : Size := Auto_Size); 1430 -- Specify a minimal and maximal size for the item, along each axis. 1431 -- The default is for items to occupy the full width of their parent 1432 -- (in vertical layout) or the full height (in horizontal layout), 1433 -- and the child required by their children for the other axis. 1434 -- Calling this procedure overrides any specific size set via 1435 -- Set_Size or one of the constructors for the items, like rectangles 1436 -- and ellipsis, for that axis. 1437 1438 procedure Set_Size 1439 (Self : not null access Container_Item_Record; 1440 Width, Height : Size := Auto_Size); 1441 -- Force a specific size for the item if any of the dimensions is positive. 1442 -- When Auto_Size is given, the size along that axis will be computed 1443 -- automatically. 1444 -- Calling this procedure cancels effects from Set_Size_Range. 1445 -- The size of a container is influenced by its children as follows: 1446 -- * the preferred size for each child is computed, based on its own 1447 -- intrinsic needs (given size for rectangles, text size,...) 1448 -- * if the child has a min and max size given in pixels, these 1449 -- constraints are applied immediately. 1450 -- * the container will then use the maximal computed size amongst 1451 -- its children. 1452 -- * Once the size of the container is known, the size for its 1453 -- children is recomputed when the size or the size constraints 1454 -- were given as percent of the parent size. It means that sizees 1455 -- given in percent do not influence the parent's size computation. 1456 1457 procedure Size_Request 1458 (Self : not null access Container_Item_Record; 1459 Context : Draw_Context); 1460 -- Compute the ideal size for Self. 1461 -- It might be either a size specifically forced by the user, or computed 1462 -- from Self's children's own size_request. 1463 -- The size is stored internally in the object. 1464 -- The requested size must not include the margins that were defined in 1465 -- Add_Child. 1466 -- Self can modify its computed position (i.e. the position within its 1467 -- parent) as part of the size computation in this procedure. 1468 -- One example of overridding this procedure is when you are building an 1469 -- item which shoud align some text on two columns (for instance in a UML 1470 -- diagram we might want the field names and their types to each be on 1471 -- their own column. In this case, the container's Size_Request would 1472 -- first call the inherited version (so that each child requests a size), 1473 -- then iterate over the children in each column and compute the maximum 1474 -- requested width for that column. Finally, another pass for the children 1475 -- in each column to call Set_Size_Request and override their requested 1476 -- width. 1477 1478 procedure Set_Size_Request 1479 (Self : not null access Container_Item_Record; 1480 Width, Height : Gdouble := -1.0); 1481 -- This procedure should only be called from an override of Size_Request 1482 -- (but it can then be called for any item, not just the one passed in 1483 -- parameter). 1484 -- It can be used to request a specific size for an item, or override the 1485 -- size already computed. When Width or Height is negative, they do not 1486 -- override the existing size request. 1487 1488 procedure Size_Allocate 1489 (Self : not null access Container_Item_Record); 1490 -- Called once the size of the parent object has been decided (i.e. after 1491 -- all the calls to Size_Request). 1492 -- The parent must set its child's position and size, and then call 1493 -- Size_Allocate to let it know about the final size and position. 1494 -- This can be used to compute attributes that need the actual size of the 1495 -- item (gradients, centering or right-aligning objects,...) 1496 -- Alignments and margins are automatically handled by the parent. 1497 1498 procedure For_Each_Child 1499 (Self : not null access Container_Item_Record'Class; 1500 Callback : not null access procedure 1501 (Child : not null access Container_Item_Record'Class); 1502 Recursive : Boolean := False); 1503 -- Traverse all children of Self, and calls Callback for each. 1504 1505 procedure Draw_Children 1506 (Self : not null access Container_Item_Record'Class; 1507 Context : Draw_Context); 1508 -- Display all the children of Self 1509 1510 procedure Set_Style 1511 (Self : not null access Container_Item_Record; 1512 Style : Drawing_Style); 1513 function Get_Style 1514 (Self : not null access Container_Item_Record) return Drawing_Style; 1515 -- Return the style used for the drawingo of this item. 1516 -- When changing the style, you must force a refresh of the canvas. 1517 1518 overriding procedure Refresh_Layout 1519 (Self : not null access Container_Item_Record; 1520 Context : Draw_Context); 1521 overriding procedure Set_Position 1522 (Self : not null access Container_Item_Record; 1523 Pos : Gtkada.Style.Point); 1524 procedure Set_Position 1525 (Self : not null access Container_Item_Record; 1526 Pos : Gtkada.Style.Point := (Gdouble'First, Gdouble'First); 1527 Anchor_X : Percent; 1528 Anchor_Y : Percent); 1529 -- Anchor_X and Anchor_Y indicate which part of the item is at the given 1530 -- coordinates. For instance, (0, 0) indicates that Pos is the location of 1531 -- the top-left corner of the item, but (0.5, 0.5) indicates that Pos is 1532 -- the position of the center of the item. 1533 1534 overriding procedure Destroy 1535 (Self : not null access Container_Item_Record; 1536 In_Model : not null access Canvas_Model_Record'Class); 1537 overriding function Position 1538 (Self : not null access Container_Item_Record) return Gtkada.Style.Point; 1539 overriding function Parent 1540 (Self : not null access Container_Item_Record) 1541 return Abstract_Item; 1542 overriding function Bounding_Box 1543 (Self : not null access Container_Item_Record) 1544 return Item_Rectangle; 1545 overriding function Inner_Most_Item 1546 (Self : not null access Container_Item_Record; 1547 At_Point : Model_Point; 1548 Context : Draw_Context) return Abstract_Item; 1549 overriding function Is_Invisible 1550 (Self : not null access Container_Item_Record) 1551 return Boolean; 1552 1553 ---------------- 1554 -- Rectangles -- 1555 ---------------- 1556 1557 type Rect_Item_Record is new Container_Item_Record with private; 1558 type Rect_Item is access all Rect_Item_Record'Class; 1559 -- A predefined type object which displays itself as a rectangle or a 1560 -- rectangle with rounded corners. 1561 1562 Fit_Size_As_Double : constant Model_Coordinate := -1.0; 1563 Auto_Size_As_Double : constant Model_Coordinate := -2.0; 1564 -- See the description of Fit_Size and Auto_Size. 1565 -- These are used for parameters that take a Double instead of a Size 1566 -- for backward compatibility (consider using Set_Size instead). 1567 1568 function Gtk_New_Rect 1569 (Style : Gtkada.Style.Drawing_Style; 1570 Width, Height : Model_Coordinate := Fit_Size_As_Double; 1571 Radius : Model_Coordinate := 0.0) 1572 return Rect_Item; 1573 procedure Initialize_Rect 1574 (Self : not null access Rect_Item_Record'Class; 1575 Style : Gtkada.Style.Drawing_Style; 1576 Width, Height : Model_Coordinate := Fit_Size_As_Double; 1577 Radius : Model_Coordinate := 0.0); 1578 -- Create a new rectangle item. 1579 -- Specifying the size should rather be done with a call to 1580 -- Set_Size, which provides more flexibility with regards to the units 1581 -- used to describe the size. 1582 1583 overriding procedure Draw 1584 (Self : not null access Rect_Item_Record; 1585 Context : Draw_Context); 1586 overriding procedure Draw_Outline 1587 (Self : not null access Rect_Item_Record; 1588 Style : Gtkada.Style.Drawing_Style; 1589 Context : Draw_Context); 1590 1591 -------------- 1592 -- Ellipses -- 1593 -------------- 1594 1595 type Ellipse_Item_Record is new Container_Item_Record with private; 1596 type Ellipse_Item is access all Ellipse_Item_Record'Class; 1597 -- A predefined object that displays itself as a circle or an ellipse 1598 -- inscribed in a given rectangle. 1599 1600 function Gtk_New_Ellipse 1601 (Style : Gtkada.Style.Drawing_Style; 1602 Width, Height : Model_Coordinate := Fit_Size_As_Double) 1603 return Ellipse_Item; 1604 procedure Initialize_Ellipse 1605 (Self : not null access Ellipse_Item_Record'Class; 1606 Style : Gtkada.Style.Drawing_Style; 1607 Width, Height : Model_Coordinate := Fit_Size_As_Double); 1608 -- Create a new ellipse item. 1609 -- If either Width or Height are negative, they will be computed based on 1610 -- the children's requested size (if there are no children, a default size 1611 -- is used). 1612 -- The ellipse is inscribed in the rectangle given by the item's position 1613 -- and the size passed in argument to this function. 1614 1615 overriding procedure Draw 1616 (Self : not null access Ellipse_Item_Record; 1617 Context : Draw_Context); 1618 overriding function Contains 1619 (Self : not null access Ellipse_Item_Record; 1620 Point : Item_Point; 1621 Context : Draw_Context) return Boolean; 1622 1623 ------------ 1624 -- Images -- 1625 ------------ 1626 1627 type Image_Item_Record is new Container_Item_Record with private; 1628 type Image_Item is access all Image_Item_Record'Class; 1629 -- An item that shows an image. 1630 -- The style is used to draw a rectangle around the image 1631 1632 function Gtk_New_Image 1633 (Style : Gtkada.Style.Drawing_Style; 1634 Image : not null access Gdk.Pixbuf.Gdk_Pixbuf_Record'Class; 1635 Allow_Rescale : Boolean := True; 1636 Width, Height : Model_Coordinate := Fit_Size_As_Double) 1637 return Image_Item; 1638 procedure Initialize_Image 1639 (Self : not null access Image_Item_Record'Class; 1640 Style : Gtkada.Style.Drawing_Style; 1641 Image : not null access Gdk.Pixbuf.Gdk_Pixbuf_Record'Class; 1642 Allow_Rescale : Boolean := True; 1643 Width, Height : Model_Coordinate := Fit_Size_As_Double); 1644 -- Create a new image item. 1645 -- By default, the size is computed from the image, but if self is 1646 -- actually allocated a different size, the image will be rescaled as 1647 -- appropriate. You can disable this behavior by setting Allow_Rescale to 1648 -- False. 1649 1650 function Gtk_New_Image 1651 (Style : Gtkada.Style.Drawing_Style; 1652 Icon_Name : String; 1653 Allow_Rescale : Boolean := True; 1654 Width, Height : Model_Coordinate := Fit_Size_As_Double) 1655 return Image_Item; 1656 procedure Initialize_Image 1657 (Self : not null access Image_Item_Record'Class; 1658 Style : Gtkada.Style.Drawing_Style; 1659 Icon_Name : String; 1660 Allow_Rescale : Boolean := True; 1661 Width, Height : Model_Coordinate := Fit_Size_As_Double); 1662 -- Same as buffer, but the image is created from one of the files given 1663 -- by the Gtk.Icon_Theme. This will often result in better (more sharp) 1664 -- rendering. 1665 -- You should in general specify the size you want to use, since the 1666 -- icon_name itself does not provide this information. 1667 1668 overriding procedure Draw 1669 (Self : not null access Image_Item_Record; 1670 Context : Draw_Context); 1671 overriding procedure Destroy 1672 (Self : not null access Image_Item_Record; 1673 In_Model : not null access Canvas_Model_Record'Class); 1674 overriding procedure Size_Request 1675 (Self : not null access Image_Item_Record; 1676 Context : Draw_Context); 1677 1678 --------------- 1679 -- Polylines -- 1680 --------------- 1681 1682 type Polyline_Item_Record is new Container_Item_Record with private; 1683 type Polyline_Item is access all Polyline_Item_Record'Class; 1684 -- A predefine object that displays itself as a set of joined lines. 1685 -- This object can optionally contain children, and the polyline can thus 1686 -- be used to draw a polygon around those items 1687 1688 function Gtk_New_Polyline 1689 (Style : Gtkada.Style.Drawing_Style; 1690 Points : Item_Point_Array; 1691 Close : Boolean := False; 1692 Relative : Boolean := False) 1693 return Polyline_Item; 1694 procedure Initialize_Polyline 1695 (Self : not null access Polyline_Item_Record'Class; 1696 Style : Gtkada.Style.Drawing_Style; 1697 Points : Item_Point_Array; 1698 Close : Boolean := False; 1699 Relative : Boolean := False); 1700 -- Create a new polyline item. 1701 -- If Relative is true, then each point is relative to the previous one 1702 -- (i.e. its coordinates are the previous points's coordinate plus the 1703 -- offset given in points). The first point is of course in item 1704 -- coordinates. 1705 1706 overriding procedure Draw 1707 (Self : not null access Polyline_Item_Record; 1708 Context : Draw_Context); 1709 overriding procedure Destroy 1710 (Self : not null access Polyline_Item_Record; 1711 In_Model : not null access Canvas_Model_Record'Class); 1712 overriding procedure Size_Request 1713 (Self : not null access Polyline_Item_Record; 1714 Context : Draw_Context); 1715 overriding function Contains 1716 (Self : not null access Polyline_Item_Record; 1717 Point : Item_Point; 1718 Context : Draw_Context) return Boolean; 1719 overriding function Clip_Line 1720 (Self : not null access Polyline_Item_Record; 1721 P1, P2 : Item_Point) return Item_Point; 1722 1723 ----------- 1724 -- Texts -- 1725 ----------- 1726 1727 type Text_Item_Record is new Container_Item_Record with private; 1728 type Text_Item is access all Text_Item_Record'Class; 1729 -- A predefined object that displays itself as text. 1730 1731 type Text_Arrow_Direction is 1732 (No_Text_Arrow, 1733 Up_Text_Arrow, 1734 Down_Text_Arrow, 1735 Left_Text_Arrow, 1736 Right_Text_Arrow); 1737 1738 function Gtk_New_Text 1739 (Style : Gtkada.Style.Drawing_Style; 1740 Text : Glib.UTF8_String; 1741 Directed : Text_Arrow_Direction := No_Text_Arrow; 1742 Width, Height : Model_Coordinate := Fit_Size_As_Double) 1743 return Text_Item; 1744 procedure Initialize_Text 1745 (Self : not null access Text_Item_Record'Class; 1746 Style : Gtkada.Style.Drawing_Style; 1747 Text : Glib.UTF8_String; 1748 Directed : Text_Arrow_Direction := No_Text_Arrow; 1749 Width, Height : Model_Coordinate := Fit_Size_As_Double); 1750 -- Create a new text item 1751 -- 1752 -- Directed indicates whether the text should be followed (or preceded) 1753 -- by a directional arrow. This is used when displaying text along links, 1754 -- to help users read the meaning of the label. 1755 1756 procedure Set_Directed 1757 (Self : not null access Text_Item_Record; 1758 Directed : Text_Arrow_Direction := No_Text_Arrow); 1759 -- Change the direction of the arrow. 1760 -- In particular, this is done automatically when the text is used on a 1761 -- link. 1762 1763 procedure Set_Text 1764 (Self : not null access Text_Item_Record; 1765 Text : String); 1766 -- Change the text displayed in the item. 1767 -- This does not force a refresh of the item, and it is likely that you 1768 -- will need to call the Model's Refresh_Layout method to properly 1769 -- recompute sizes of items and link paths. 1770 1771 overriding procedure Draw 1772 (Self : not null access Text_Item_Record; 1773 Context : Draw_Context); 1774 overriding procedure Destroy 1775 (Self : not null access Text_Item_Record; 1776 In_Model : not null access Canvas_Model_Record'Class); 1777 overriding procedure Size_Request 1778 (Self : not null access Text_Item_Record; 1779 Context : Draw_Context); 1780 1781 ------------------- 1782 -- Editable text -- 1783 ------------------- 1784 1785 type Editable_Text_Item_Record is new Text_Item_Record with private; 1786 type Editable_Text_Item is access all Editable_Text_Item_Record'Class; 1787 -- A special text item that can be double-clicked on to be editing in 1788 -- place (provided the Gtkada.Canvas_View.Views.On_Item_Event_Edit 1789 -- callback was added to the view). 1790 1791 function Gtk_New_Editable_Text 1792 (Style : Gtkada.Style.Drawing_Style; 1793 Text : Glib.UTF8_String; 1794 Directed : Text_Arrow_Direction := No_Text_Arrow) 1795 return Editable_Text_Item; 1796 procedure Initialize_Editable_Text 1797 (Self : not null access Editable_Text_Item_Record'Class; 1798 Style : Gtkada.Style.Drawing_Style; 1799 Text : Glib.UTF8_String; 1800 Directed : Text_Arrow_Direction := No_Text_Arrow); 1801 -- Create a new text item 1802 1803 procedure On_Edited 1804 (Self : not null access Editable_Text_Item_Record'Class; 1805 Old_Text : String) is null; 1806 -- Called after the text has been edited 1807 1808 overriding function Edit_Widget 1809 (Self : not null access Editable_Text_Item_Record; 1810 View : not null access Canvas_View_Record'Class) 1811 return Gtk.Widget.Gtk_Widget; 1812 1813 ---------------------- 1814 -- Horizontal lines -- 1815 ---------------------- 1816 1817 type Hr_Item_Record is new Container_Item_Record with private; 1818 type Hr_Item is access all Hr_Item_Record'Class; 1819 -- A predefined object that displays itself as a horizontal line with 1820 -- optional text in the middle. This thus looks like: 1821 -- ---- text ---- 1822 1823 function Gtk_New_Hr 1824 (Style : Gtkada.Style.Drawing_Style; 1825 Text : String := "") 1826 return Hr_Item; 1827 procedure Initialize_Hr 1828 (Self : not null access Hr_Item_Record'Class; 1829 Style : Gtkada.Style.Drawing_Style; 1830 Text : String := ""); 1831 -- Create a new horizontal rule 1832 1833 overriding procedure Draw 1834 (Self : not null access Hr_Item_Record; 1835 Context : Draw_Context); 1836 overriding procedure Destroy 1837 (Self : not null access Hr_Item_Record; 1838 In_Model : not null access Canvas_Model_Record'Class); 1839 overriding procedure Size_Request 1840 (Self : not null access Hr_Item_Record; 1841 Context : Draw_Context); 1842 1843 ------------------ 1844 -- Canvas links -- 1845 ------------------ 1846 1847 type Canvas_Link_Record is new Abstract_Item_Record with private; 1848 type Canvas_Link is access all Canvas_Link_Record'Class; 1849 -- Special support is provided for links. 1850 -- These are a special kind of item, which provides automatic routing 1851 -- algorithms. They always join two items (including possibly two lines) 1852 1853 function Gtk_New 1854 (From, To : not null access Abstract_Item_Record'Class; 1855 Style : Gtkada.Style.Drawing_Style; 1856 Routing : Route_Style := Straight; 1857 Label : access Container_Item_Record'Class := null; 1858 Anchor_From : Anchor_Attachment := Middle_Attachment; 1859 Label_From : access Container_Item_Record'Class := null; 1860 Anchor_To : Anchor_Attachment := Middle_Attachment; 1861 Label_To : access Container_Item_Record'Class := null) 1862 return Canvas_Link; 1863 procedure Initialize 1864 (Link : not null access Canvas_Link_Record'Class; 1865 From, To : not null access Abstract_Item_Record'Class; 1866 Style : Gtkada.Style.Drawing_Style; 1867 Routing : Route_Style := Straight; 1868 Label : access Container_Item_Record'Class := null; 1869 Anchor_From : Anchor_Attachment := Middle_Attachment; 1870 Label_From : access Container_Item_Record'Class := null; 1871 Anchor_To : Anchor_Attachment := Middle_Attachment; 1872 Label_To : access Container_Item_Record'Class := null); 1873 -- Create a new link between the two items. 1874 -- This link is not automatically added to the model. 1875 -- Both items must belong to the same model. 1876 -- 1877 -- The label is displayed approximately in the middle of the link. 1878 -- The Label_From is displayed next to the origin of the link, whereas 1879 -- Label_To is displayed next to the target of the link. 1880 -- These labels will generally be some Text_Item, but it might make sense 1881 -- to use more complex labels, for instance to draw something with a 1882 -- polyline item, or using an image. 1883 -- 1884 -- If the Label is directed, the direction of the arrow will be changed 1885 -- automatically to match the layout of the link. 1886 1887 function Get_From 1888 (Self : not null access Canvas_Link_Record) return Abstract_Item; 1889 function Get_To 1890 (Self : not null access Canvas_Link_Record) return Abstract_Item; 1891 -- Return both ends of the link 1892 1893 procedure Set_Offset 1894 (Self : not null access Canvas_Link_Record; 1895 Offset : Gdouble); 1896 -- This only applies to arc links, and is used to specify the curve of the 1897 -- arc (this is basically the maximal distance between the straight line 1898 -- and the summit of the arc). 1899 -- Offset must not be 0.0 1900 1901 procedure Refresh_Layout 1902 (Self : not null access Canvas_Link_Record; 1903 Context : Draw_Context); 1904 -- Recompute the layout/routing for the link. 1905 -- This procedure should be called whenever any of the end objects changes 1906 -- side or position. The view will do this automatically the first time, 1907 -- but will not update links later on. 1908 1909 procedure Set_Waypoints 1910 (Self : not null access Canvas_Link_Record; 1911 Points : Item_Point_Array; 1912 Relative : Boolean := False); 1913 -- Set explicit waypoints for the link, which forces the link to go through 1914 -- the given points. 1915 -- Relative should be true if all 1916 1917 procedure Set_Style 1918 (Self : not null access Canvas_Link_Record; 1919 Style : Drawing_Style); 1920 function Get_Style 1921 (Self : not null access Canvas_Link_Record) return Drawing_Style; 1922 -- Return the style used for the drawingo of this link. 1923 -- When changing the style, you must force a refresh of the canvas. 1924 1925 function Get_Points 1926 (Self : not null access Canvas_Link_Record) 1927 return Item_Point_Array_Access; 1928 -- Return the computed points for the link. 1929 -- Do not free or store the result 1930 1931 overriding function Is_Invisible 1932 (Self : not null access Canvas_Link_Record) 1933 return Boolean is (False); 1934 overriding function Inner_Most_Item 1935 (Self : not null access Canvas_Link_Record; 1936 At_Point : Model_Point; 1937 Context : Draw_Context) 1938 return Abstract_Item is (null); 1939 overriding function Parent 1940 (Self : not null access Canvas_Link_Record) 1941 return Abstract_Item is (null); 1942 overriding function Edit_Widget 1943 (Self : not null access Canvas_Link_Record; 1944 View : not null access Canvas_View_Record'Class) 1945 return Gtk.Widget.Gtk_Widget is (null); 1946 overriding procedure Set_Visibility_Threshold 1947 (Self : not null access Canvas_Link_Record; 1948 Threshold : Gdouble); 1949 overriding function Get_Visibility_Threshold 1950 (Self : not null access Canvas_Link_Record) return Gdouble; 1951 overriding procedure Destroy 1952 (Self : not null access Canvas_Link_Record; 1953 In_Model : not null access Canvas_Model_Record'Class); 1954 overriding function Bounding_Box 1955 (Self : not null access Canvas_Link_Record) 1956 return Item_Rectangle; 1957 overriding function Position 1958 (Self : not null access Canvas_Link_Record) 1959 return Gtkada.Style.Point; 1960 overriding procedure Draw 1961 (Self : not null access Canvas_Link_Record; 1962 Context : Draw_Context); 1963 overriding function Contains 1964 (Self : not null access Canvas_Link_Record; 1965 Point : Item_Point; 1966 Context : Draw_Context) return Boolean; 1967 overriding function Clip_Line 1968 (Self : not null access Canvas_Link_Record; 1969 P1, P2 : Item_Point) return Item_Point; 1970 overriding function Link_Anchor_Point 1971 (Self : not null access Canvas_Link_Record; 1972 Anchor : Anchor_Attachment) 1973 return Item_Point; 1974 overriding function Is_Link 1975 (Self : not null access Canvas_Link_Record) 1976 return Boolean is (True); 1977 procedure Draw_As_Selected 1978 (Self : not null access Canvas_Link_Record; 1979 Context : Draw_Context); 1980 1981private 1982 procedure Unchecked_Free is new Ada.Unchecked_Deallocation 1983 (Gtkada.Style.Point_Array, Gtkada.Style.Point_Array_Access); 1984 1985 type Canvas_Model_Record is abstract new Glib.Object.GObject_Record 1986 with record 1987 Layout : Pango.Layout.Pango_Layout; 1988 1989 Selection : Item_Sets.Set; 1990 Mode : Selection_Mode := Selection_Single; 1991 end record; 1992 1993 type Canvas_Item_Record is abstract new Abstract_Item_Record with record 1994 Position : Gtkada.Style.Point := No_Position; 1995 -- Position within its parent or the canvas view. 1996 1997 Visibility_Threshold : Gdouble := 0.0; 1998 -- See Set_Visibility_Threshold. 1999 end record; 2000 2001 type Container_Item_Record is abstract new Canvas_Item_Record with record 2002 Width, Height : Model_Coordinate; 2003 -- Computed by Size_Request. Always expressed in pixels. 2004 -- These do not include the margins. 2005 2006 Computed_Position : Gtkada.Style.Point := (Gdouble'First, Gdouble'First); 2007 -- The position within the parent, as computed in Size_Allocate. 2008 -- The field Position is used for the position specifically requested by 2009 -- the user. 2010 -- This is always the position of the top-left corner, no matter what 2011 -- Anchor_X and Anchor_Y are set to. 2012 2013 Anchor_X : Percent := 0.0; 2014 Anchor_Y : Percent := 0.0; 2015 -- The position within the item that Self.Position points to. This 2016 -- is only relevant when an explicit position was given by the user. 2017 2018 Margin : Margins := No_Margins; 2019 -- Margins around the child 2020 2021 Parent : Container_Item; 2022 -- The parent item 2023 2024 Min_Width, Min_Height : Size := (Unit_Pixels, 1.0); 2025 Max_Width, Max_Height : Size := Fit_Size; 2026 -- Size constraints for the child. If Max_* if Fixed_Size, then the 2027 -- child is constrained to have Min_* has a specific size. 2028 2029 Pack_End : Boolean := False; 2030 Layout : Child_Layout_Strategy := Vertical_Stack; 2031 Align : Alignment_Style := Align_Start; 2032 Float : Boolean := False; 2033 Overflow : Overflow_Style := Overflow_Prevent; 2034 2035 Style : Gtkada.Style.Drawing_Style; 2036 2037 Children : Items_Lists.List; 2038 end record; 2039 2040 type Rect_Item_Record is new Container_Item_Record with record 2041 Radius : Model_Coordinate; 2042 end record; 2043 2044 type Image_Item_Record is new Container_Item_Record with record 2045 Image : Gdk.Pixbuf.Gdk_Pixbuf; 2046 Icon_Name : GNAT.Strings.String_Access; 2047 Allow_Rescale : Boolean := True; 2048 end record; 2049 2050 type Polyline_Item_Record is new Container_Item_Record with record 2051 Points : Item_Point_Array_Access; 2052 Close : Boolean; 2053 Relative : Boolean; 2054 end record; 2055 2056 type Ellipse_Item_Record is new Container_Item_Record with null record; 2057 2058 type Text_Item_Record is new Container_Item_Record with record 2059 Text : GNAT.Strings.String_Access; 2060 Directed : Text_Arrow_Direction; 2061 end record; 2062 2063 type Editable_Text_Item_Record is new Text_Item_Record with null record; 2064 2065 type Hr_Item_Record is new Container_Item_Record with record 2066 Text : GNAT.Strings.String_Access; 2067 Requested_Width, Requested_Height : Model_Coordinate; 2068 2069 Space : Model_Coordinate := 4.0; 2070 -- Space between text and lines 2071 end record; 2072 2073 No_Waypoints : constant Item_Point_Array := (1 .. 0 => (0.0, 0.0)); 2074 2075 type Item_Drag_Info is record 2076 Item : Abstract_Item; 2077 Pos : Model_Point; 2078 end record; 2079 2080 package Item_Drag_Infos is new Ada.Containers.Hashed_Maps 2081 (Key_Type => Abstract_Item, 2082 Element_Type => Item_Drag_Info, 2083 Hash => Hash, 2084 Equivalent_Keys => "="); 2085 2086 type Continuous_Scroll_Data is record 2087 Id : Glib.Main.G_Source_Id := Glib.Main.No_Source_Id; 2088 -- The timeout callback used to provide continuous scrolling 2089 2090 Dx, Dy : Model_Coordinate := 0.0; 2091 -- Amount of scrolling at each step 2092 2093 Timeout : Glib.Guint := 30; 2094 -- Number of milliseconds between each step of the auto scrolling 2095 2096 Margin : View_Coordinate := 10.0; 2097 -- Number of pixels on each side of the view in which the auto 2098 -- scrolling should start. We can't start it only when the mouse is 2099 -- outside of the view, since otherwise there would be no way to get 2100 -- it started when the view is aligned with the screen edge. 2101 2102 Speed : Model_Coordinate := 15.0; 2103 -- Speed of the scrolling at each step 2104 end record; 2105 2106 type Smart_Guide is record 2107 Pos : Model_Coordinate; 2108 Min, Max : Model_Coordinate; 2109 Visible : Boolean := False; 2110 end record; 2111 -- Description for a smart guide: 2112 -- For a horizontal guide, Pos is the y coordinate of the guide, and 2113 -- Min,Max are its minimum and maximum x coordinates for all items along 2114 -- that guide. 2115 2116 package Smart_Guide_Lists is new Ada.Containers.Doubly_Linked_Lists 2117 (Smart_Guide); 2118 2119 type Snap_Data is record 2120 Grid : Boolean := True; 2121 Smart_Guides : Boolean := False; 2122 Margin : Model_Coordinate := 5.0; 2123 2124 Hguides, Vguides : Smart_Guide_Lists.List; 2125 Style : Gtkada.Style.Drawing_Style := Default_Guide_Style; 2126 end record; 2127 2128 type Inline_Edit_Data is record 2129 Item : Abstract_Item; 2130 end record; 2131 -- Data used when editing a widget 2132 2133 type Base_Animation_Data is abstract tagged null record; 2134 type Base_Animation_Data_Access is access Base_Animation_Data'Class; 2135 2136 type Canvas_View_Record is new Gtk.Bin.Gtk_Bin_Record with record 2137 Model : Canvas_Model; 2138 Topleft : Model_Point := (0.0, 0.0); 2139 Scale : Gdouble := 1.0; 2140 Grid_Size : Model_Coordinate := 20.0; 2141 2142 Animation_Data : Base_Animation_Data_Access; 2143 Id_Animation : Glib.Main.G_Source_Id := Glib.Main.No_Source_Id; 2144 -- The animation loop (see Gtkada.Canvas_View.Views.Animate) 2145 2146 Id_Layout_Changed, 2147 Id_Item_Contents_Changed, 2148 Id_Item_Destroyed, 2149 Id_Selection_Changed : Gtk.Handlers.Handler_Id := 2150 (Gtk.Handlers.Null_Handler_Id, null); 2151 -- Connections to model signals 2152 2153 Layout : Pango.Layout.Pango_Layout; 2154 Hadj, Vadj : Gtk.Adjustment.Gtk_Adjustment; 2155 2156 Selection_Style : Gtkada.Style.Drawing_Style := 2157 Gtkada.Style.Gtk_New 2158 (Stroke => (0.8, 0.0, 0.0, 0.3), 2159 Line_Width => 4.0); 2160 2161 Scale_To_Fit_Requested : Gdouble := 0.0; 2162 Scale_To_Fit_Area : Model_Rectangle; 2163 -- Set to true when the user calls Scale_To_Fit before the view has had 2164 -- a size allocated (and thus we could not perform computation). 2165 -- This is set to the maximal zoom requested (or 0.0 if not requested) 2166 2167 Last_Button_Press : Canvas_Event_Details; 2168 -- Attributes of the last button_press event, used to properly handle 2169 -- dragging and avoid recomputing the selectd item on button_release. 2170 2171 Dragged_Items : Item_Drag_Infos.Map; 2172 -- The items that are being dragged. 2173 2174 In_Drag : Boolean := False; 2175 -- Whether we are in the middle of a drag. 2176 2177 Topleft_At_Drag_Start : Model_Point; 2178 -- Toplevel at the stat of the drag 2179 2180 Avoid_Overlap : Boolean := False; 2181 Avoid_Overlap_Duration : Standard.Duration := 0.2; 2182 2183 Continuous_Scroll : Continuous_Scroll_Data; 2184 Snap : Snap_Data; 2185 Inline_Edit : Inline_Edit_Data; 2186 end record; 2187 2188 type Canvas_Link_Record is new Abstract_Item_Record with record 2189 From, To : Abstract_Item; 2190 Style : Gtkada.Style.Drawing_Style; 2191 Routing : Route_Style; 2192 Bounding_Box : Item_Rectangle; 2193 Label : Container_Item; 2194 Label_From : Container_Item; 2195 Label_To : Container_Item; 2196 2197 Visibility_Threshold : Gdouble := 0.0; 2198 2199 Offset : Gdouble := 10.0; 2200 -- For arc links 2201 2202 Waypoints : Item_Point_Array_Access; 2203 -- The waypoints created by the user (as opposed to Points, which 2204 -- contains the list of waypoints computed automatically, in addition 2205 -- to the user's waypoints). 2206 -- These are absolute coordinates. 2207 -- For straight and orthogonal links, these are the points the link must 2208 -- go through. 2209 -- For curve and arc links, these are the list of points and 2210 -- control points for the bezier curve: 2211 -- pt1, ctrl1, ctrl2, pt2, ctrl3, ctrl4, pt3, ... 2212 2213 Relative_Waypoints : Boolean := False; 2214 -- Whether the waypoints are given in relative coordinates. 2215 -- This does not apply to Points. 2216 2217 Points : Item_Point_Array_Access; 2218 -- The cached computation of waypoints for this link. 2219 -- These are recomputed every time the layout of the canvas changes, but 2220 -- are cached so that redrawing the canvas is fast. 2221 -- These are absolute coordinates, even if waypoints are relative. 2222 -- See the documentation on Waypoints for more information on the format 2223 2224 Anchor_From : Anchor_Attachment := Middle_Attachment; 2225 Anchor_To : Anchor_Attachment := Middle_Attachment; 2226 end record; 2227 2228 type List_Canvas_Model_Record is new Canvas_Model_Record with record 2229 Items : Items_Lists.List; 2230 -- items are sorted: lowest items first (minimal z-layer) 2231 end record; 2232 2233 procedure Refresh_Link_Layout 2234 (Model : not null access Canvas_Model_Record'Class; 2235 Items : Item_Drag_Infos.Map := Item_Drag_Infos.Empty_Map); 2236 -- Refresh the layout for all links (or only the ones linked to Item, or 2237 -- indirectly to a link to Item). 2238 2239 procedure Copy_Selected_To_Dragged_Items 2240 (Self : not null access Canvas_View_Record'Class; 2241 Force : access Abstract_Item_Record'Class); 2242 -- Setup the 'dragged_items" field from the contents of the selection, and 2243 -- forces a specific item to be there (in addition) 2244 2245 procedure Set_Adjustment_Values 2246 (Self : not null access Canvas_View_Record'Class); 2247 -- Update the values for both adjustments 2248 2249end Gtkada.Canvas_View; 2250