-----------------------------------------------------------------------
-- GtkAda - Ada95 binding for Gtk+/Gnome --
-- --
-- Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet --
-- Copyright (C) 2000-2011, AdaCore --
-- --
-- This library is free software; you can redistribute it and/or --
-- modify it under the terms of the GNU General Public --
-- License as published by the Free Software Foundation; either --
-- version 2 of the License, or (at your option) any later version. --
-- --
-- This library is distributed in the hope that it will be useful, --
-- but WITHOUT ANY WARRANTY; without even the implied warranty of --
-- MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU --
-- General Public License for more details. --
-- --
-- You should have received a copy of the GNU General Public --
-- License along with this library; if not, write to the --
-- Free Software Foundation, Inc., 59 Temple Place - Suite 330, --
-- Boston, MA 02111-1307, USA. --
-- --
-- --
-- --
-- --
-- --
-- --
-- --
-----------------------------------------------------------------------
--
-- This package provides an interactive canvas, on which the user can put
-- items, move them with the mouse, etc. The items can be connected together,
-- and the connections remain active while the items are moved.
--
-- It also supports scrolling if put in a Gtk_Scrolled_Window.
-- The canvas will be scrolled (and the selected items moved) if an item is
-- selected and the mouse is dragged on a small area on the side of the canvas
-- or even directly outside of the canvas. Scrolling will continue until the
-- mouse is either released or moved back inside the canvas.
--
-- The scrolling speed will slightly increase over time if the mouse is kept
-- outside of the canvas. This makes the canvas much more comfortable to use
-- for the user.
--
-- All items put in this canvas must inherit from the type Canvas_Item_Record.
-- However, it is your responsability, as a programmer, to provide drawing
-- routines. In fact, all these items should draw in a pixmap, which is then
-- copied automatically to the screen whenever the canvas needs to redraw
-- itself.
--
-- The items can also react to mouse events: mouse clicks are transmitted to
-- the item if the mouse did not move more than a given amount of pixels.
-- To decide what their reaction should be, you should override the
-- On_Button_Click subprogram.
--
-- This canvas is not intended for cases where you want to put hundreds of
-- items on the screen. For instance, it does not provide any smart
-- double-buffering other than the one provided by gtk+ itself, and thus you
-- would get some flicker if there are too many items.
--
-- There are three coordinate systems used by widget. All the subprograms
-- expect a specific coordinate system as input or output. Here are the three
-- systems:
-- - World coordinates
-- The position of an item is reported in pixels, as if the canvas
-- currently had a zoom level of 100%. This is fully independent, at any
-- time, from the current zoom level of the canvas.
-- Since the canvas is considered to expand ad infinitum, the top-left
-- corner doesn't have any specific fixed coordinates. It can be known by
-- checking the current lower value of the adjustments (aka scrollbars).
--
-- - Canvas coordinates
-- This is similar to world coordinates, except these depend on the
-- current zoom level of the canvas. This also affect the width and height
-- of the objects in the canvas.
-- The subprograms To_Canvas_Coordinates and To_World_Coordinates can be
-- used to convert lengths from world to canvas coordinates.
-- The same behavior as world coordinates applies for the top-left corner.
-- All drawing to the screen, in particular for Draw_Background, must be
-- done using this coordinate systems
--
-- - Item coordinates
-- The position of a point is relative to the top-left corner of the
-- current item. This corner therefore has coordinates (0, 0).
-- This coordinate systems assumes a zoom-level of 100%
--
-- Items are selected automatically when they are clicked. If Control is
-- pressed at the same time, multiple items can be selected.
-- If the background is clicked (and control is not pressed), then all items
-- are unselected.
-- Pressing and dragging the mouse in the backgroudn draws a virtual box on
-- the screen. All the items fully included in this box when it is released
-- will be selected (this will replace the current selection if Control was
-- not pressed).
--
--
-- Drawing
-- create_canvas.adb
-- gtkada-canvas
with Ada.Calendar;
with Cairo;
with Cairo.Region;
with Gdk.Color;
with Gdk.Event;
with Glib;
with Glib.Graphs;
with Glib.Main;
with Gtk.Adjustment;
with Gtk.Drawing_Area;
with Pango.Font;
with Pango.Layout;
package Gtkada.Canvas is
type Interactive_Canvas_Record is new
Gtk.Drawing_Area.Gtk_Drawing_Area_Record with private;
type Interactive_Canvas is access all Interactive_Canvas_Record'Class;
-- A canvas on which items are put.
-- Each item can be moved interactively by the user, and links can be
-- drawn automatically from an item to another.
-- This widget can be inserted directly in a scrolled window to provide
-- support for scrolling.
type Canvas_Item_Record is abstract new Glib.Graphs.Vertex with private;
type Canvas_Item is access all Canvas_Item_Record'Class;
-- An item that can be put on the canvas.
-- This is an abstract type, as it does not provide any default drawing
-- routine. You must override the abstract Draw subprogram.
type Canvas_Link_Record is new Glib.Graphs.Edge with private;
type Canvas_Link is access all Canvas_Link_Record'Class;
type Canvas_Link_Access is access all Canvas_Link_Record;
-- A link between two items in the canvas.
-- The implementation provided in this package provides links that can
-- be either straight links or curved links.
-- This type is provided as a tagged type so that you can associated your
-- own user data with it.
-------------------
-- Customization --
-------------------
-- These are the default configuration values for the canvas. All the
-- values can be changed by the Configure subprogram.
Default_Annotation_Font : constant String := "Helvetica 8";
-- Font used when displaying link annotation. See Pango.Font for the
-- format.
Default_Grid_Size : constant := 15;
-- Number of pixels between two dots on the grid.
-- This is used for both horizontal and vertical orientation.
Default_Arc_Link_Offset : constant := 25;
-- Distance between two parallel arcs for two links. This is not the exact
-- distance, and it only used to compute the control points for the bezier
-- curves.
Default_Arrow_Angle : constant := 30;
-- Half angle for the arrows in degres
Default_Arrow_Length : constant := 6;
-- Length of the arrows in pixels.
Default_Motion_Threshold : constant := 4.0;
-- Mimimum motion the mouse must have before we start moving the selected
-- item. If the mouse has moved less than that amount of pixels in any
-- direction, then the mouse click is considered as being a selection
-- only and is transfered to the item itself.
-- This is in screen coordinates
----------------
-- Enum types --
----------------
type Arrow_Type is
(No_Arrow,
-- the link does not have an arrow
Start_Arrow,
-- the link has an arrow at its beginning
End_Arrow,
-- the link has an arrow at the end
Both_Arrow
-- the link has an arrow on both sides
);
-- Indicate whether the links have an arrow or not.
-----------------------
-- Creating a canvas --
-----------------------
procedure Gtk_New
(Canvas : out Interactive_Canvas; Auto_Layout : Boolean := True);
-- Create a new empty Canvas.
-- If Auto_Layout is True, then the items are automatically positioned as
-- they are put in the canvas, if no coordinates are specified.
procedure Initialize
(Canvas : access Interactive_Canvas_Record'Class;
Auto_Layout : Boolean := True);
-- Internal function used to initialize the canvas.
procedure Configure
(Canvas : access Interactive_Canvas_Record;
Grid_Size : Glib.Guint := Default_Grid_Size;
Annotation_Font : Pango.Font.Pango_Font_Description :=
Pango.Font.From_String (Default_Annotation_Font);
Arc_Link_Offset : Glib.Gint := Default_Arc_Link_Offset;
Arrow_Angle : Glib.Gint := Default_Arrow_Angle;
Arrow_Length : Glib.Gint := Default_Arrow_Length;
Motion_Threshold : Glib.Gdouble := Default_Motion_Threshold);
-- Change the parameters for the canvas.
-- A Grid_Size of 0 means than no grid should be drawn in the background of
-- canvas. Note that in that case you can never activate Align_On_Grid.
-- This setting doesn't apply if you have redefined Draw_Background, which
-- may not draw a grid.
function Get_Vadj
(Canvas : access Interactive_Canvas_Record'Class)
return Gtk.Adjustment.Gtk_Adjustment;
-- Return the vertical adjustment associated with Canvas
function Get_Hadj
(Canvas : access Interactive_Canvas_Record'Class)
return Gtk.Adjustment.Gtk_Adjustment;
-- Return the horizontal adjustment associated with Canva
procedure Get_Bounding_Box
(Canvas : access Interactive_Canvas_Record'Class;
Width : out Glib.Gdouble;
Height : out Glib.Gdouble);
-- Return the size occupied by the items drawn on the canvas.
procedure Draw_Area
(Canvas : access Interactive_Canvas_Record'Class;
Rect : Cairo.Region.Cairo_Rectangle_Int);
-- Draw in Canvas the specified area.
procedure Draw_All
(Canvas : access Interactive_Canvas_Record'Class;
Cr : Cairo.Cairo_Context);
-- Draws the whole canvas in Cr. Useful to print the canvas on an SVG or
-- PNG surface.
procedure Draw_Background
(Canvas : access Interactive_Canvas_Record;
Cr : Cairo.Cairo_Context);
-- Draw the background of the canvas. This procedure should be overriden if
-- you want to draw something else on the background. It must first clear
-- the area on the screen.
--
-- The default implementation draws a grid.
--
-- An example implementation that draws a background image is shown at the
-- end of this file.
procedure Draw_Grid
(Canvas : access Interactive_Canvas_Record;
Cr : Cairo.Cairo_Context);
-- Helper function that can be called from Draw_Background. It cannot be
-- used directly as Draw_Background, since it doesn't clear the area first.
procedure Set_Orthogonal_Links
(Canvas : access Interactive_Canvas_Record;
Orthogonal : Boolean);
-- If Orthogonal is True, then all the links will be drawn only with
-- vertical and horizontal lines. This is not applied for the second or
-- more link between two items.
function Get_Orthogonal_Links
(Canvas : access Interactive_Canvas_Record) return Boolean;
-- Return True if the links are only drawn horizontally and vertically.
procedure Align_On_Grid
(Canvas : access Interactive_Canvas_Record;
Align : Boolean := True);
-- Choose whether the items should be aligned on the grid when moved.
-- Existing items are not moved even if you set this parameter to True,
-- this will only take effect the next time the items are moved.
function Get_Align_On_Grid
(Canvas : access Interactive_Canvas_Record) return Boolean;
-- Return True if items are currently aligned on grid.
procedure Move_To
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class;
X, Y : Glib.Gint := Glib.Gint'First);
-- Move the item in the canvas, to world coordinates (X, Y).
-- Item is assumed to be already in the canvas.
-- If you leave both coordinates X and Y to their default value, then the
-- item's location will be automatically computed when you layout the
-- canvas (it is your responsability to call Layout).
procedure Set_Items
(Canvas : access Interactive_Canvas_Record;
Items : Glib.Graphs.Graph);
-- Set the items and links to display in the canvas from Items.
-- All items previously in the canvas are removed, and replaced by the
-- vertices in Items.
-- Note that the vertices in Items must be in Canvas_Item_Record'Class, and
-- the links must be in Canvas_Link_Record'Class.
-- If you do not have an automatic layout set up in Canvas, you need to set
-- the coordinates of all the vertices by calling Move_To separately.
--
-- You mustn't destroy items yourself, this is done automatically when the
-- canvas is destroyed.
procedure Put
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class;
X, Y : Glib.Gint := Glib.Gint'First);
-- Add a new item to the canvas, at world coordinates (X, Y).
-- The item is added at a specific location.
-- If you leave both X and Y to their default value, the item's location
-- will be computed automatically when you call Layout on the canvas,
-- unless Auto_Layout has been set, in which case the position will be
-- computed immediately.
function Item_At_Coordinates
(Canvas : access Interactive_Canvas_Record;
X, Y : Glib.Gint) return Canvas_Item;
-- Return the item at world coordinates (X, Y) which is on top of all
-- others.
-- null is returned if there is no such item.
function Item_At_Coordinates
(Canvas : access Interactive_Canvas_Record; Event : Gdk.Event.Gdk_Event)
return Canvas_Item;
-- Same as above, but using the canvas coordinates of the event, taking
-- into account the current zoom level and current scrolling
procedure Item_At_Coordinates
(Canvas : access Interactive_Canvas_Record;
Event : Gdk.Event.Gdk_Event;
Item : out Canvas_Item;
X, Y : out Glib.Gint);
-- Same as above, but also returns the coordinates (X, Y) within the item.
-- The coordinates are not set if Item is null on exit.
procedure Clear (Canvas : access Interactive_Canvas_Record);
-- Remove all items from the canvas
procedure Remove
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class);
-- Remove an item and all the links to and from it from the canvas.
-- The item itself is not freed, but the links are.
-- Nothing is done if the item is not part of the canvas.
procedure Item_Updated
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class);
-- This should be called when Item has changed the contents of its
-- pixmap, and thus the Canvas should be updated.
procedure Refresh_Canvas (Canvas : access Interactive_Canvas_Record);
-- Redraw the whole canvas (both in the double buffer and on the screen).
procedure Raise_Item
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class);
-- Raise the item so that it is displayed on top of all the others
-- The canvas is refreshed as needed to reflect the change.
-- Nothing happens if Item is not part of the canvas.
procedure Lower_Item
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class);
-- Lower the item so that it is displayed below all the others.
-- The canvas is refreshed as needed to reflect the change.
-- Nothing happens if Item is not part of the canvas.
function Is_On_Top
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class) return Boolean;
-- Return True if Item is displayed on top of all the others in the canvas.
procedure Show_Item
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class);
-- Scroll the canvas so that Item is visible. Nothing is done if the item
-- is already visible
procedure Align_Item
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class;
X_Align : Float := 0.5;
Y_Align : Float := 0.5);
-- Scroll the canvas so that the Item appears at the given location in the
-- canvas. If X_Align is 0.0, the item is align on the left. With 0.5, it
-- is centered horizontally. If 1.0, it is aligned on the right.
function Get_Arrow_Angle
(Canvas : access Interactive_Canvas_Record'Class) return Glib.Gdouble;
-- Return the angle of arrows in the canvas.
function Get_Arrow_Length
(Canvas : access Interactive_Canvas_Record'Class) return Glib.Gint;
-- Return the length of arrows in the canvas.
--------------------------
-- Iterating over items --
--------------------------
type Item_Processor is access function
(Canvas : access Interactive_Canvas_Record'Class;
Item : access Canvas_Item_Record'Class) return Boolean;
procedure For_Each_Item
(Canvas : access Interactive_Canvas_Record;
Execute : Item_Processor;
Linked_From_Or_To : Canvas_Item := null);
-- Execute an action on each of the items contained in the canvas.
-- If Execute returns False, we stop traversing the list of children.
-- It is safe to remove the items in Item_Processor.
--
-- If Linked_From_Or_To is not null, then only the items linked to this one
-- will be processed. It is possible that a given item will be returned
-- twice, if it is both linked to and from the item.
type Item_Iterator is private;
function Start
(Canvas : access Interactive_Canvas_Record;
Linked_From_Or_To : Canvas_Item := null;
Selected_Only : Boolean := False) return Item_Iterator;
-- Return the first item in the canvas.
-- The same restriction as above applies if Linked_From_Or_To is not null.
procedure Next (Iter : in out Item_Iterator);
function Next (Iter : Item_Iterator) return Item_Iterator;
-- Move the iterator to the next item.
-- All items will eventually be returned if you do not add new items during
-- the iteration and none are removed. However, it is safe to remove items
-- at any time, except the current item
function Get (Iter : Item_Iterator) return Canvas_Item;
-- Return the item pointed to by the iterator.
-- null is returned when there are no more item in the canvas.
function Is_Linked_From (Iter : Item_Iterator) return Boolean;
-- Return True if there is a link from:
-- Get (Iter) -> Linked_From_Or_To
-- Linked_From_Or_To is the item passed to Start. False is returned if this
-- item was null.
-------------
-- Zooming --
-------------
procedure Zoom
(Canvas : access Interactive_Canvas_Record;
Percent : Glib.Gdouble := 1.0;
Length : Duration := 0.0);
-- Zoom in or out in the canvas.
--
-- Length is the length of the zooming animation.
--
-- Note that one possible use for this function is to refresh the canvas
-- and emit the "zoomed" signal, which might redraw all the items. This can
-- be accomplished by keeping the default 1.0 value for Percent.
function Get_Zoom
(Canvas : access Interactive_Canvas_Record) return Glib.Gdouble;
-- Return the current zoom level
procedure Get_World_Coordinates
(Canvas : access Interactive_Canvas_Record'Class;
X, Y : out Glib.Gdouble;
Width : out Glib.Gdouble;
Height : out Glib.Gdouble);
-- Return the world coordinates of Canvas.
---------------------
-- Layout of items --
---------------------
type Layout_Algorithm is access procedure
(Canvas : access Interactive_Canvas_Record'Class;
Graph : Glib.Graphs.Graph;
Force : Boolean;
Vertical_Layout : Boolean);
-- A general layout algorithm. It should compute the position of all the
-- vertices of the graph, and set them directly in the graph itself.
-- Note: all the vertices in the graph are of type Canvas_Item_Record'Class
-- and you should use that to set the coordinates through a call to
-- Move_To.
--
-- Algorithms are encouraged to preserve the current layout as much as
-- possible, taking into account items that have been moved manually by
-- the user, so that the latter can preserver his mental map of the graph.
-- However, if Force is set to True, then the whole layout should be
-- recomputed as if all items had just been inserted.
--
-- Items that have just been inserted in the graph, but whose position has
-- never been computed, are set at coordinates (Gint'First, Gint'First).
-- Check the result of Get_Coord.
--
-- This function doesn't need to align items, this is done automatically by
-- the canvas if necessary.
procedure Set_Layout_Algorithm
(Canvas : access Interactive_Canvas_Record;
Algorithm : Layout_Algorithm);
-- Set the layout algorithm to use to compute the position of the items.
-- Algorithm mustn't be null.
procedure Default_Layout_Algorithm
(Canvas : access Interactive_Canvas_Record'Class;
Graph : Glib.Graphs.Graph;
Force : Boolean;
Vertical_Layout : Boolean);
-- The default algorithm used in the canvas.
-- Basically, items are put next to each other, unless there is a link
-- between two items. In that case, the second item is put below the first,
-- as space allows.
procedure Set_Auto_Layout
(Canvas : access Interactive_Canvas_Record;
Auto_Layout : Boolean);
-- If Auto_Layout is true, then every time an item is inserted in the
-- canvas, the layout algorithm is called. If set to False, it is the
-- responsability of the caller to call Layout below to force a
-- recomputation of the layout, preferably after inserting a number of
-- items.
procedure Set_Layout_Orientation
(Canvas : access Interactive_Canvas_Record;
Vertical_Layout : Boolean := False);
-- Specify the layout orientation to use for this canvas. The setting is
-- passed as a parameter to the layout algorithm
procedure Layout
(Canvas : access Interactive_Canvas_Record;
Force : Boolean := False);
-- Recompute the layout of the canvas.
-- Force can be used to control the layout algorithm, as described above
-- for Layout_Algorithm.
-----------
-- Links --
-----------
procedure Configure
(Link : access Canvas_Link_Record;
Arrow : Arrow_Type := End_Arrow;
Descr : Glib.UTF8_String := "");
-- Configure a link.
-- The link is an oriented bound between two items on the canvas.
-- If Descr is not the empty string, it will be displayed in the middle
-- of the link, and should indicate what the link means.
-- Arrow indicates whether some arrows should be printed as well.
function Get_Descr
(Link : access Canvas_Link_Record) return Glib.UTF8_String;
-- Return the description for the link, or "" if there is none
function Get_Arrow_Type
(Link : access Canvas_Link_Record) return Arrow_Type;
-- Return the location of the arrows on Link
procedure Set_Src_Pos
(Link : access Canvas_Link_Record; X_Pos, Y_Pos : Glib.Gfloat := 0.5);
-- Set the position of the link's attachment in its source item.
-- X_Pos and Y_Pos should be given between 0.0 and 1.0 (from left to right
-- or top to bottom)..
-- By default, all links are considered to be attached to the center of
-- items. However, in some cases it is more convenient to attach it to a
-- specific part of the item. For instance, you can force a link to always
-- start from the top of the item by setting Y_Pos to 0.0.
procedure Set_Dest_Pos
(Link : access Canvas_Link_Record; X_Pos, Y_Pos : Glib.Gfloat := 0.5);
-- Same as Set_Src_Pos for the destination item
procedure Get_Src_Pos
(Link : access Canvas_Link_Record; X, Y : out Glib.Gfloat);
-- Return the attachment position of the link along its source item
procedure Get_Dest_Pos
(Link : access Canvas_Link_Record; X, Y : out Glib.Gfloat);
-- Return the attachment position of the link along its destination item
function Has_Link
(Canvas : access Interactive_Canvas_Record;
From, To : access Canvas_Item_Record'Class;
Name : Glib.UTF8_String := "") return Boolean;
-- Test whether there is a link from From to To, with the same name.
-- If Name is the empty string "", then no check is done on the name,
-- and True if returned if there is any link between the two items.
procedure Add_Link
(Canvas : access Interactive_Canvas_Record;
Link : access Canvas_Link_Record'Class;
Src : access Canvas_Item_Record'Class;
Dest : access Canvas_Item_Record'Class;
Arrow : Arrow_Type := End_Arrow;
Descr : Glib.UTF8_String := "");
-- Add Link in the canvas. This connects the two items Src and Dest.
-- Simpler procedure to add a standard link.
-- This takes care of memory allocation, as well as adding the link to
-- the canvas.
procedure Remove_Link
(Canvas : access Interactive_Canvas_Record;
Link : access Canvas_Link_Record'Class);
-- Remove a link from the canvas.
-- It also destroys the link itself, and free the memory allocated to it.
-- Nothing is done if Link does not belong to canvas.
type Link_Processor is access function
(Canvas : access Interactive_Canvas_Record'Class;
Link : access Canvas_Link_Record'Class) return Boolean;
procedure For_Each_Link
(Canvas : access Interactive_Canvas_Record;
Execute : Link_Processor;
From, To : Canvas_Item := null);
-- Execute an action on each of the links contained in the canvas.
-- If Execute returns False, we stop traversing the list of links.
-- It is safe to remove the link from the list in Link_Processor.
--
-- (From, To) can be used to limit what links are looked for.
--
-- ??? Would be nicer to give direct access to the Graph iterators
procedure Destroy (Link : in out Canvas_Link_Record);
-- Method called every time a link is destroyed. You should override this
-- if you define your own link types.
-- Note that the link might already have been removed from the canvas
-- when this subprogram is called.
-- This shouldn't free the link itself, only its fields.
-------------------
-- Drawing links --
-------------------
-- Drawing of links can be controlled at several levels:
-- - Redefining Update_Links gives control at the canvas level. This can
-- be used to implement routing algorithms for the links where the
-- routes must be computed before any link is actually drawn (otherwise
-- it is better to redefine Draw_Link). It can also be used to control
-- in what order the links should be drawn.
-- - Redefining Draw_Link gives the opportunity to draw links any way you
-- need (several bends, ...). It can be used to control the routing of
-- this specific link, for routing algorithms that only rely on the
-- items layout and not on other links. Otherwise see Update_Links.
-- - Redefining Draw_Straight_Line if slightly lower-level. This is
-- called by the default Draw_Link procedure, once the ends of the
-- links have been computed.
procedure Update_Links
(Canvas : access Interactive_Canvas_Record;
Cr : Cairo.Cairo_Context;
Invert_Mode : Boolean;
From_Selection : Boolean);
-- Redraw all the links in the canvas, after the items have been laid out.
--
-- If From_Selection is true, then only the links to or from one of the
-- selected items need to be drawn.
procedure Draw_Link
(Canvas : access Interactive_Canvas_Record'Class;
Link : access Canvas_Link_Record;
Cr : Cairo.Cairo_Context;
Edge_Number : Glib.Gint;
Show_Annotation : Boolean := True);
-- Redraw the link on the canvas.
-- Note that this is a primitive procedure of Link, not of Canvas, and thus
-- can easily be overrided for specific links. The default version draws
-- either straight or arc links (the latter when there are multiple links
-- between two given items).
-- This function shouldn't be called if one of the two ends of the link is
-- invisible.
--
-- Cr is the Cairo_Context that is used to draw the link.
-- The link is drawn using the current cairo brush, so if you need to
-- specify some particular color, you can do it directly in the
-- Cairo_Context
--
-- Edge_Number indicates the index of link in the list of links that join
-- the same source to the same destination. It should be used so that two
-- links do not overlap (for instance, the default is to draw the first
-- link straight, and the others as arcs).
type Item_Side is (East, West, North, South);
-- Each side of an item, along its rectangle bounding box
procedure Clip_Line
(Src : access Canvas_Item_Record;
Canvas : access Interactive_Canvas_Record'Class;
To_X : Glib.Gint;
To_Y : Glib.Gint;
X_Pos : Glib.Gfloat;
Y_Pos : Glib.Gfloat;
Side : out Item_Side;
X_Out : out Glib.Gint;
Y_Out : out Glib.Gint);
-- Clip the line that goes from Src at pos (X_Pos, Y_Pos) to (To_X, To_Y)
-- in world coordinates.
-- The intersection between that line and the border of Rect is returned
-- in (X_Out, Y_Out). The result should be in world coordinates.
-- X_Pos and Y_Pos have the same meaning as Src_X_Pos and Src_Y_Pos in the
-- link record.
-- This procedure is called when computing the position for the links
-- within the default Draw_Link procedure. The default implementation only
-- works with rectangular items. The computed coordinates are then passed
-- on directly to Draw_Straight_Line.
procedure Draw_Straight_Line
(Link : access Canvas_Link_Record;
Cr : Cairo.Cairo_Context;
Src_Side : Item_Side;
X1, Y1 : Glib.Gdouble;
Dest_Side : Item_Side;
X2, Y2 : Glib.Gdouble);
-- Draw a straight link between two points. This could be overriden if you
-- need to draw an something along the link.
-- The links goes from (Src, X1, Y1) to (Dest, X2, Y2), in canvas
-- coordinates. The coordinates have already been clipped so that they do
-- not override the item.
---------------
-- Selection --
---------------
procedure Clear_Selection (Canvas : access Interactive_Canvas_Record);
-- Clear the list of currently selected items.
procedure Add_To_Selection
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class);
-- Add Item to the selection. This is only meaningful during a drag
-- operation (ie during a button press and the matching button
-- release). Item will be moved at the same time that the selection is
-- moved.
-- Item is not added again if it is already in the selection.
-- This function can be called from the Button_Click subprogram to force
-- moving items.
-- This emits the "item_selected" signal.
procedure Remove_From_Selection
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class);
-- Remove Item from the selection.
-- This emits the "item_unselected" signal.
procedure Select_All (Canvas : access Interactive_Canvas_Record);
-- Select all the Item in the canvas.
function Is_Selected
(Canvas : access Interactive_Canvas_Record;
Item : access Canvas_Item_Record'Class) return Boolean;
-- Return True if the item is currently selected
------------------------
-- Items manipulation --
------------------------
function Canvas
(Item : access Canvas_Item_Record) return Interactive_Canvas;
-- Retrieve the canvas this item is attached to, or null if it does not
-- belong to a canvas.
procedure Selected
(Item : access Canvas_Item_Record;
Canvas : access Interactive_Canvas_Record'Class;
Is_Selected : Boolean);
-- Called when the item is selected or unselected.
-- The default is to do nothing.
function Point_In_Item
(Item : access Canvas_Item_Record;
X, Y : Glib.Gint) return Boolean;
-- This function should return True if (X, Y) is inside the item. X and Y
-- are in world coordinates.
-- This function is meant to be overriden for non-rectangular items, since
-- the default behavior works for rectangular items.
-- This function is never called for invisible items
procedure Set_Screen_Size
(Item : access Canvas_Item_Record;
Width : Glib.Gint;
Height : Glib.Gint);
-- Set the size of bounding box for the item in world coordinates.
-- The item itself needn't occupy the whole area of this bounding box,
-- see Point_In_Item.
-- You need to redraw the item, and call Item_Updated to force the canvas
-- to refresh the screen.
procedure Draw_Selected
(Item : access Canvas_Item_Record;
Cr : Cairo.Cairo_Context);
-- Draws a selected item. By default, this adds a semi-transparent overlay
-- above the item, drawn using the below call to Draw
procedure Draw
(Item : access Canvas_Item_Record;
Cr : Cairo.Cairo_Context) is abstract;
-- This subprogram, that must be overridden, should draw the item on
-- Cr. The Item is drawn from coordinates (0,0), and does not need to take
-- care of the zoom level.
-- If you need to change the contents of the item, you should call
-- Item_Updated after having done the drawing.
procedure Destroy (Item : in out Canvas_Item_Record);
-- Free the memory occupied by the item (not the item itself). You should
-- override this function if you define your own widget type, but always
-- call the parent's Destroy subprogram.
function On_Button_Click
(Item : access Canvas_Item_Record;
Event : Gdk.Event.Gdk_Event_Button) return Boolean;
-- Function called whenever mouse events occured.
-- The following mouse events may be received:
-- Mouse_Press,
-- Motion_Notify
-- (only once the mouse is pressed, and On_Button_Click returned True),
-- Mouse_Release
-- (only once the mouse is pressed, and On_Button_Click returned True),
-- Returns whether the event was handled or not.
--
-- The coordinates (X, Y) in the Event are relative to the top-left corner
-- of Item.
function Get_Coord
(Item : access Canvas_Item_Record)
return Cairo.Region.Cairo_Rectangle_Int;
-- Return the coordinates and size of the bounding box for item, in world
-- coordinates.
-- If the item has never been resized, it initially has a width and height
-- of 1.
procedure Set_Visibility
(Item : access Canvas_Item_Record;
Visible : Boolean);
-- Set the visibility status of the item. An invisible item will not be
-- visible on the screen, and will not take part in the computation of the
-- the scrollbars for the canvas.
-- The canvas is not refreshed (this is your responsibility to do it after
-- you have finished doing all the modifications).
function Is_Visible (Item : access Canvas_Item_Record) return Boolean;
-- Return True if the item is currently visible
function Is_From_Auto_Layout
(Item : access Canvas_Item_Record) return Boolean;
-- Return True if the current location of the item is the result from the
-- auto layout algorithm.
-- False is returned if the item was moved manually by the user.
--------------------
-- Buffered items --
--------------------
type Buffered_Item_Record is new Canvas_Item_Record with private;
type Buffered_Item is access all Buffered_Item_Record'Class;
-- A widget that has a double-buffer associated. You should use this one
-- when drawing items can take a long time, or you do not want to handle
-- the zoom yourself.
-- You only need to update the contents of the double pixmap when the
-- contents of the item changes, since all the drawing and zooming is
-- taken care of automatically. Once the drawing is done, call Item_Updated
-- to force the canvas to refresh the screen.
-- This buffered_item is meant to handle rectangular items. However, it can
-- be used for polygonal items by overriding Draw. The new version should
-- set the clip mask for the GC, then call Draw for the buffered item, and
-- finally reset the clip mask. The clip mask must take into account the
-- current zoom level.
function Surface (Item : access Buffered_Item_Record)
return Cairo.Cairo_Surface;
-- Return the double-buffer.
-------------
-- Signals --
-------------
--
-- The following new signals are defined for this widget:
--
-- - "background_click"
-- procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
-- Event : Gdk.Event.Gdk_Event);
--
-- Called every time the user clicks in the background (ie not on an item,
-- or On_Button_Click would be called).
-- This is called both on Button_Release and Button_Press events.
-- The coordinates (X, Y) in the Event are relative to the top-left corner
-- of Canvas.
--
-- - "item_selected"
-- procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
-- Item : Canvas_Item);
--
-- Emitted when the user has clicked on an item to select it, ie before any
-- drag even has occured. This is a good time to add other items to the
-- selection if you need. At thee same time, the primitive operation
-- Selected is called for the item.
--
-- - "item_unselected"
-- procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
-- Item : Canvas_Item);
--
-- Emitted when the Item was unselected. At the same time, the primitive
-- operation Selected is called for the item.
--
-- - "item_moved"
-- procedure Handler (Canvas : access Interactive_Canvas_Record'Class;
-- Item : Canvas_Item);
--
-- Emitted when Item has been moved. New coordinates have been assigned to
-- Item. However, the canvas hasn't been refreshed yet. This signal might
-- be called multiple time when the user finishes a drag action, in case
-- there were several selected items.
--
-- - "zoomed"
-- procedure Handler (Canvas : access Interactive_Canvas_Record'Class);
--
-- Emitted when the canvas has been zoomed in or out. You do not need to
-- redraw the items yourself, since this will be handled by calls to Draw
--
-- - "set_scroll_adjustments"
-- procedure Handler (Canvas : access Interactive_Canvas_Record'Class);
--
-- Emitted when the canvas has scrolled.
--
--
Signal_Background_Click : constant Glib.Signal_Name :=
"background_click";
Signal_Item_Selected : constant Glib.Signal_Name :=
"item_selected";
Signal_Item_Unselected : constant Glib.Signal_Name :=
"item_unselected";
Signal_Item_Moved : constant Glib.Signal_Name :=
"item_moved";
Signal_Zoomed : constant Glib.Signal_Name :=
"zoomed";
Signal_Set_Scroll_Adjustments : constant Glib.Signal_Name :=
"set_scroll_adjustments";
private
type String_Access is access Glib.UTF8_String;
type Canvas_Link_Record is new Glib.Graphs.Edge with record
Descr : String_Access;
Arrow : Arrow_Type := End_Arrow;
Src_X_Pos : Glib.Gfloat := 0.5;
Src_Y_Pos : Glib.Gfloat := 0.5;
Dest_X_Pos : Glib.Gfloat := 0.5;
Dest_Y_Pos : Glib.Gfloat := 0.5;
-- Position of the link's attachment in each of the src and dest items.
end record;
type Interactive_Canvas_Record is new
Gtk.Drawing_Area.Gtk_Drawing_Area_Record
with record
Children : Glib.Graphs.Graph;
World_X, World_Y : Glib.Gdouble;
-- The World coordinates at canvas (0,0)
Layout : Layout_Algorithm := Default_Layout_Algorithm'Access;
Auto_Layout : Boolean := True;
Vertical_Layout : Boolean := False;
-- The algorithm to use when laying out items on the canvas.
World_X_At_Click : Glib.Gdouble;
World_Y_At_Click : Glib.Gdouble;
-- Coordinates of the last button_press event in the canvas.
-- These are world-coordinates, so that even if the canvas is scrolled
-- they remain valid
Selected_Count : Natural := 0;
-- Number of selected items
Offset_X_World : Glib.Gint;
Offset_Y_World : Glib.Gint;
-- How much world-coordinates have we moved the mouse since the last
-- button press event ?
Mouse_Has_Moved : Boolean;
-- True if mouse has moved while the button was clicked. This is used
-- to distinguish between item motion and item selection.
Background_Press : Boolean;
-- True if the mouse press event occured in the background
Item_Press : Canvas_Item;
-- Points to the canvas item that received the press event
Show_Item : Canvas_Item;
Show_Canvas_X, Show_Canvas_Y : Glib.Gdouble;
-- The item that should be made visible when the canvas is resized.
-- This is required since the canvas doesn't necessarily have a size yet
-- when Show_Item() is called the first time.
Grid_Size : Glib.Guint := Default_Grid_Size;
-- The current number of pixels between each dot of the grid. If this
-- is strictly below 2, the grid is not drawn.
Arc_Link_Offset : Glib.Gint := Default_Arc_Link_Offset;
Arrow_Angle : Glib.Gdouble;
Arrow_Length : Glib.Gint := Default_Arrow_Length;
Motion_Threshold : Glib.Gdouble := Default_Motion_Threshold;
Align_On_Grid : Boolean := False;
Black_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
Sel_Color : Gdk.Color.Gdk_Color := Gdk.Color.Null_Color;
Annotation_Layout : Pango.Layout.Pango_Layout;
-- Layout used to draw the annotations
Hadj, Vadj : Gtk.Adjustment.Gtk_Adjustment;
Scrolling_Timeout_Id : Glib.Main.G_Source_Id := 0;
Orthogonal_Links : Boolean := False;
-- True if the links should be orthogonal
Surround_Box_Scroll : Glib.Gdouble;
-- Amount of scrolling for each step while the cursor is left in the
-- surrounding box.
Zoom : Glib.Gdouble := 1.0;
-- Zoom level in percent (100% is normal size)
Initial_Zoom : Glib.Gdouble := 1.0;
Target_Zoom : Glib.Gdouble := 1.0;
Zoom_Duration : Duration := 0.0;
Zoom_Start : Ada.Calendar.Time;
Zoom_X : Glib.Gdouble := 0.0;
Zoom_Y : Glib.Gdouble := 0.0;
-- Variables used while smooth-scrolling the canvas
Freeze : Boolean := False;
end record;
type Canvas_Item_Record is abstract new Glib.Graphs.Vertex with record
Canvas : Interactive_Canvas := null;
Coord : aliased Cairo.Region.Cairo_Rectangle_Int;
-- This is the bounding box of the item
Visible : Boolean := True;
Selected : Boolean := False;
From_Auto_Layout : Boolean := True;
-- True if the item's current location is the result of the automatic
-- layout algorithm.
end record;
type Buffered_Item_Record is new Canvas_Item_Record with record
Pixmap : Cairo.Cairo_Surface := Cairo.Null_Surface;
end record;
procedure Set_Screen_Size
(Item : access Buffered_Item_Record;
Width, Height : Glib.Gint);
-- See documentation from inherited subprogram
procedure Draw
(Item : access Buffered_Item_Record;
Cr : Cairo.Cairo_Context);
-- Draw the item's double-buffer onto Dest.
procedure Destroy (Item : in out Buffered_Item_Record);
-- Free the double-buffer allocated for the item
type Item_Iterator is record
Vertex : Glib.Graphs.Vertex_Iterator;
Edge : Glib.Graphs.Edge_Iterator;
Linked_From_Or_To : Canvas_Item;
Selected_Only : Boolean;
end record;
pragma Inline (Get_Arrow_Type);
end Gtkada.Canvas;
--
-- -- The following example shows a possible Draw_Background procedure,
-- -- that draws a background image on the canvas's background. It fully
-- -- handles zooming and tiling of the image. Note that drawing a large
-- -- image will dramatically slow down the performances.
--
-- Bg_Image : constant String := "my_background.png";
--
-- procedure Draw_Background
-- (Canvas : access Image_Canvas_Record;
-- Cr : Cairo.Cairo_Context)
-- is
-- Surface : Cairo.Cairo_Surface;
-- Background : Cairo.Cairo_Pattern;
-- begin
-- Surface := Cairo.Png.Create_From_Png (Bg_Image);
-- Background := Cairo.Pattern.Create_For_Surface (Surface);
-- Cairo.Pattern.Set_Extend (Canvas.Background, Cairo_Extend_Repeat);
-- Destroy (Surface);
-- Cairo.Save (Cr);
-- Cairo.Set_Source (Cr, Canvas.Background);
-- Cairo.Paint (Cr);
-- Cairo.Restore (Cr);
-- end Draw_Background;
--