libgtkada2.24.1-dev 2.24.1-2 / usr / share / ada / adainclude / gtkada / gtkada-canvas.adb

-----------------------------------------------------------------------
--               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.                                       --
--                                                                   --
-----------------------------------------------------------------------

with Ada.Numerics;                       use Ada.Numerics;
with Ada.Numerics.Generic_Elementary_Functions;
with Interfaces.C.Strings;               use Interfaces.C.Strings;
with System;
with Unchecked_Deallocation;
with GNAT.IO;                            use GNAT.IO;

with Cairo;                              use Cairo;
with Cairo.Image_Surface;                use Cairo.Image_Surface;
with Cairo.Pattern;                      use Cairo.Pattern;
with Cairo.Region;                       use Cairo.Region;
with Cairo.Surface;                      use Cairo.Surface;
with Pango.Cairo;                        use Pango.Cairo;

with Glib;                               use Glib;
with Glib.Graphs;                        use Glib.Graphs;
with Glib.Main;                          use Glib.Main;
with Glib.Object;                        use Glib.Object;
with Glib.Values;                        use Glib.Values;

with Gdk.Cairo;                          use Gdk.Cairo;
with Gdk.Color;                          use Gdk.Color;
with Gdk.Cursor;                         use Gdk.Cursor;
with Gdk.Event;                          use Gdk.Event;
with Gdk.Rectangle;                      use Gdk.Rectangle;
with Gdk.Window;                         use Gdk.Window;
with Gdk.Types;                          use Gdk.Types;
with Gdk.Types.Keysyms;                  use Gdk.Types.Keysyms;

with Gtk.Adjustment;                     use Gtk.Adjustment;
with Gtk.Arguments;                      use Gtk.Arguments;
with Gtk.Drawing_Area;                   use Gtk.Drawing_Area;
with Gtk.Enums;                          use Gtk.Enums;
with Gtk.Handlers;
with Gtk.Main;                           use Gtk.Main;
pragma Elaborate_All (Gtk.Main);
with Gtk.Object;
with Gtk.Style;                          use Gtk.Style;
with Gtk.Widget;                         use Gtk.Widget;

with Gtkada.Handlers;                    use Gtkada.Handlers;

with Pango.Font;                         use Pango.Font;
with Pango.Layout;                       use Pango.Layout;

--  TODO:
--   - would be nice to have a pixbuf item directly (for alpha layers)

package body Gtkada.Canvas is

   package Double_Elementary_Functions is new
     Ada.Numerics.Generic_Elementary_Functions (Gdouble);
   use Double_Elementary_Functions;

   use type Gdk_Window;
   use type System.Address;

   Traces : constant Boolean := False;

   Class_Record : GObject_Class := Uninitialized_Class;
   --  This pointer will keep a pointer to the C 'class record' for
   --  gtk. To avoid allocating memory for each widget, this may be done
   --  only once, and reused.
   --  ??? This is a global variable.

   Timeout_Between_Scrolls : constant := 50;
   --  Time between two scrollings when the mouse is in the bounding box.

   Scrolling_Margin : constant := 10;
   --  Width and height of the surrounding box in which "infinite"
   --  scrolling is started (it will continue while the mouse is kept in this
   --  area or moved outside of the canvas)

   Scrolling_Amount_Min      : constant Gdouble := 10.0;
   Scrolling_Amount_Max      : constant Gdouble := 20.0;
   Scrolling_Amount_Increase : constant Gdouble := 1.05;  --  +5% every step
   --  Number of pixels to scroll while the mouse is in the surrounding
   --  box. This is the initial value, and will keep increasing while the mouse
   --  is left in the box.

   Links_Threshold_While_Moving : constant := 20;
   --  Maximal number of links that are drawn while moving an item. This is
   --  used to make the canvas still usable when there are lots of links to a
   --  given item.

   Signals : constant chars_ptr_array :=
               (1 => New_String (String (Signal_Background_Click)),
                2 => New_String (String (Signal_Item_Selected)),
                3 => New_String (String (Signal_Zoomed)),
                4 => New_String (String (Signal_Set_Scroll_Adjustments)),
                5 => New_String (String (Signal_Item_Unselected)),
                6 => New_String (String (Signal_Item_Moved)));
   --  Array of the signals created for this widget

   -----------------
   -- Subprograms --
   -----------------
   --  Note: Some callbacks take Gtk_Widget_Record parameters, so that we can
   --  reuse the callbacks in Gtkada.Handlers, and thus save a lot of space
   --  in the GtkAda library.

   procedure Free is new Unchecked_Deallocation (String, String_Access);

   package Canvas_Timeout is
     new Glib.Main.Generic_Sources (Interactive_Canvas);

   function Expose
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk.Event.Gdk_Event) return Boolean;
   --  Handle the expose events for a canvas.

   procedure Canvas_Destroyed (Canvas : access Gtk_Widget_Record'Class);
   --  Called when the canvas is being destroyed. All the items and links
   --  are removed, and the double-buffer is freed

   procedure Size_Allocate
     (Canv : access Gtk_Widget_Record'Class; Args : Gtk_Args);
   --  When the item is resized.

   function Button_Pressed
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean;
   --  Called when the user has pressed the mouse button in the canvas.
   --  This tests whether an item was selected.

   function Button_Release
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean;
   --  Called when the user has released the mouse button.
   --  If an item was selected, this refreshed the canvas.

   function Button_Motion
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean;
   --  Called when the user moves the mouse while a button is pressed.
   --  If an item was selected, the item is moved.

   function Key_Press
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean;
   --  Handle key events, to provide scrolling through Page Up, Page Down, and
   --  arrow keys.

   procedure To_World_Coordinates
     (Canvas  : access Interactive_Canvas_Record'Class;
      X       : Gint;
      Y       : Gint;
      X_World : out Gdouble;
      Y_World : out Gdouble);

   procedure To_World_Coordinates
     (Canvas  : access Interactive_Canvas_Record'Class;
      Event   : Gdk_Event;
      X_World : out Gdouble;
      Y_World : out Gdouble);

   procedure Draw_Area
     (Canvas : access Interactive_Canvas_Record'Class;
      Rect   : Cairo_Rectangle_Int;
      Cr     : Cairo_Context);

   procedure Draw_Orthogonal_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Show_Annotation : Boolean);
   --  Draw a link on the screen, as possibly several orthogonal lines.
   --  This link includes both an arrow head on its destination, and an
   --  optional text displayed approximatively in its middle.

   procedure Draw_Straight_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Show_Annotation : Boolean);
   --  Draw Link on the screen as a straight line.
   --  This link includes both an arrow head on its destination, and an
   --  optional text displayed approximatively in its middle.

   procedure Draw_Arc_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Offset          : Gint;
      Show_Annotation : Boolean);
   --  Draw Link on the screen.
   --  The link is drawn as a curved link (ie there is an extra handle in its
   --  middle).
   --  This link includes both an arrow head on its destination, and an
   --  optional text displayed approximatively in its middle.

   procedure Draw_Self_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Offset          : Gint;
      Show_Annotation : Boolean);
   --  Draw a link when its source and destination items are the same

   procedure Update_Adjustments
     (Canvas       : access Interactive_Canvas_Record'Class;
      Min_Max      : Boolean := True;
      Page_Size    : Boolean := True;
      Clip_Value   : Boolean := True;
      Send_Changed : Boolean := True);
   --  Update the adjustments of the canvas.
   --  The bounds for the adjustments are automatically computed, given the
   --  list of items in it.
   --  If Clip_Value is set, this also makes sure that the adjustment values
   --  remain in the adjustment range

   procedure Draw_Arrow_Head
     (Canvas : access Interactive_Canvas_Record'Class;
      Cr     : Cairo_Context;
      X, Y   : Gint;
      Angle  : Gdouble);
   --  Draw an arrow head at the position (X, Y) on the canvas. The position
   --  is given in pixels, and should include zoom processing.
   --  Angle is the angle of the main axis of the arrow.

   procedure Draw_Annotation
     (Canvas : access Interactive_Canvas_Record'Class;
      Cr     : Cairo_Context;
      X, Y   : Gint;
      Link   : access Canvas_Link_Record'Class);
   --  Print an annotation on the canvas.
   --  The annotation is centered around (X, Y), in pixels. These coordinates
   --  should already include zoom processing.

   procedure Set_Scroll_Adjustments
     (Canvas : access Gtk_Widget_Record'Class;
      Args   : GValues);
   --  Change the two adjustments used for the canvas (in a callback)

   procedure Scrolled (Canvas : access Gtk_Widget_Record'Class);
   --  Called everytime the value of one of the adjustments is changed.

   procedure Get_Bounding_Box
     (Canvas : access Interactive_Canvas_Record'Class;
      X_Min, X_Max, Y_Min, Y_Max : out Gdouble);
   --  Find the smallest bounding box for all the items in the canvas.
   --  Note that this does not include links, which might thus be found
   --  outside of this box.
   --  The returned values are in world coordinates

   procedure Test_Scrolling_Box
     (Canvas : access Interactive_Canvas_Record'Class;
      Mouse_X_In_Canvas, Mouse_Y_In_Canvas : Gint;
      X_Scroll                             : out Gdouble;
      Y_Scroll                             : out Gdouble);
   --  We keep moving the selection (and scrolling the canvas) as long as the
   --  mouse remains in a surrounding box around the canvas, or even outside
   --  the canvas. This is done even if the mouse doesn't move, so at to make
   --  it easier to move items.  This subprogram tests whether the pointer is
   --  found in that box, and returns the extra scrolling that should be
   --  done. (0, 0) is returned if the mouse is not in that box.
   --  (Mouse_X_In_Canvas, Mouse_Y_In_Canvas) are the screen coordinates of the
   --  mouse in the canvas.

   function Scrolling_Timeout (Canvas : Interactive_Canvas) return Boolean;
   --  Function called repeatedly while the mouse is in the scrolling box.
   --  This provides scrolling even when the mouse doesn't move

   procedure Scroll_Canvas_To_Area
     (Canvas             : access Interactive_Canvas_Record'Class;
      X1, Y1, X2, Y2     : Gdouble;
      Canvas_X, Canvas_Y : Gdouble := 0.5;
      Ignore_If_Visible  : Boolean := True;
      Report_Adj_Changed : Boolean := True);
   --  Scroll the visible area of the canvas so that the given area
   --  (X1, Y1) .. (X2, Y2) is made visible.
   --  These are in world coordinates.
   --  If Ignore_If_Visible is true and the area is already visible, do nothing
   --  (Canvas_X, Canvas_Y) indicates at which part of the canvas the region
   --  should be centered. If these are greater than 1.0, minimal scrolling is
   --  done.

   function Move_Selection
     (Canvas : access Interactive_Canvas_Record'Class;
      New_Offset_X_World, New_Offset_Y_World : Gdouble) return Boolean;
   --  Moves all selected items by a specific amount.
   --  The move is relative to the initial position of the items, and
   --  (Delta_X_World, Delta_Y_World) are given in world coordinates.
   --  Return True if the selection was actually moved, False if for some
   --  reason nothing happened.
   --  (Mouse_X_In_Canvas, Mouse_Y_In_Canvas) are the screen coordinates of the
   --  mouse in the canvas.

   procedure Show_Item
     (Canvas             : access Interactive_Canvas_Record'Class;
      Item               : access Canvas_Item_Record'Class;
      Canvas_X, Canvas_Y : Gdouble;
      Report_Adj_Changed : Boolean := True);
   --  Like Show_Item.
   --  (Canvas_X, Canvas_Y) are the position in the canvas where the center of
   --  the item should be put. (0,0) is on the top-left, (1,1) is bottom-right.
   --
   --  Nothing is done if the item is already visible.
   --
   --  If Report_Adj_Changed is true, the "changed" signal might be sent if the
   --  adjustments are changed. However, this might result in flickering.

   procedure Draw_Dashed_Selection
     (Canvas : access Interactive_Canvas_Record'Class;
      Cr     : Cairo_Context);
   --  Draw all the selected items and links with dashed-lines.

   function Zoom_Timeout (Canvas : Interactive_Canvas) return Boolean;
   --  Timeout function used to provide smooth zooming.

   procedure Zoom_Internal
     (Canvas : access Interactive_Canvas_Record'Class; Percent : Gdouble);
   --  Internal function to implement zooming

   function Get_Background_Selection_Rectangle
     (Canvas : access Interactive_Canvas_Record'Class) return Gdk_Rectangle;
   --  Return the coordinates of the rectangle representing the background
   --  selection (when the user clicks in the background and drags the mouse).
   --  Return coordinates are in world coordinates

   procedure Emit_By_Name_Item
     (Object : System.Address;
      Name   : String;
      Param  : access Canvas_Item_Record'Class);
   --  ???

   function Compute_Line_Pos
     (Canvas : access Interactive_Canvas_Record'Class) return Gint_Array;
   --  ???

   procedure Scroll_Canvas_To_Item
     (Canvas             : access Interactive_Canvas_Record'Class;
      Item               : access Canvas_Item_Record'Class;
      Canvas_X, Canvas_Y : Gdouble := 0.5;
      Report_Adj_Changed : Boolean := True);
   --  Scroll the canvas to the item. This function tries to scroll the canvas
   --  as less as possible, typically used when the item is moving out of the
   --  window.

   function Create
     (Canvas : access Interactive_Canvas_Record'Class) return Cairo_Context;

   ------------
   -- Create --
   ------------

   function Create
     (Canvas : access Interactive_Canvas_Record'Class) return Cairo_Context
   is
      Cr             : constant Cairo_Context := Create (Get_Window (Canvas));
      X_Base, Y_Base : Gdouble;
   begin
      To_World_Coordinates
        (Canvas, 0, 0, X_Base, Y_Base);
      Cairo.Translate (Cr, -X_Base * Canvas.Zoom, -Y_Base * Canvas.Zoom);
      Cairo.Scale (Cr, Canvas.Zoom, Canvas.Zoom);
      Set_Source_Color (Cr, Get_Fg (Get_Style (Canvas), State_Normal));
      Set_Line_Width (Cr, 1.0);

      return Cr;
   end Create;

   -----------------------
   -- Emit_By_Name_Item --
   -----------------------

   procedure Emit_By_Name_Item
     (Object : System.Address;
      Name   : String;
      Param  : access Canvas_Item_Record'Class)
   is
      procedure Internal
        (Object : System.Address;
         Name   : String;
         Param  : System.Address);
      pragma Import (C, Internal, "ada_g_signal_emit_by_name_ptr");
   begin
      Internal (Object, Name, Param.all'Address);
   end Emit_By_Name_Item;

   --------------------------
   -- To_World_Coordinates --
   --------------------------

   procedure To_World_Coordinates
     (Canvas  : access Interactive_Canvas_Record'Class;
      X       : Gint;
      Y       : Gint;
      X_World : out Gdouble;
      Y_World : out Gdouble)
   is
   begin
      X_World := Canvas.World_X + Gdouble (X) / Canvas.Zoom;
      Y_World := Canvas.World_Y + Gdouble (Y) / Canvas.Zoom;
   end To_World_Coordinates;

   --------------------------
   -- To_World_Coordinates --
   --------------------------

   procedure To_World_Coordinates
     (Canvas  : access Interactive_Canvas_Record'Class;
      Event   : Gdk_Event;
      X_World : out Gdouble;
      Y_World : out Gdouble)
   is
   begin
      X_World := Canvas.World_X + Get_X (Event) / Canvas.Zoom;
      Y_World := Canvas.World_Y + Get_Y (Event) / Canvas.Zoom;
   end To_World_Coordinates;

   ---------------------------
   -- Get_World_Coordinates --
   ---------------------------

   procedure Get_World_Coordinates
     (Canvas : access Interactive_Canvas_Record'Class;
      X, Y   : out Glib.Gdouble;
      Width  : out Glib.Gdouble;
      Height : out Glib.Gdouble)
   is
   begin
      X := Get_Lower (Canvas.Hadj);
      Y := Get_Lower (Canvas.Vadj);
      Width := Get_Upper (Canvas.Hadj) - X;
      Height := Get_Lower (Canvas.Vadj) - Y;
   end Get_World_Coordinates;

   -------------
   -- Gtk_New --
   -------------

   procedure Gtk_New
     (Canvas : out Interactive_Canvas; Auto_Layout : Boolean := True)
   is
   begin
      Canvas := new Interactive_Canvas_Record;
      Gtkada.Canvas.Initialize (Canvas, Auto_Layout);
   end Gtk_New;

   ----------------
   -- Initialize --
   ----------------

   procedure Initialize
     (Canvas      : access Interactive_Canvas_Record'Class;
      Auto_Layout : Boolean := True)
   is
      Signal_Parameters : constant Signal_Parameter_Types :=
        (1 => (1 => Gdk.Event.Get_Type,      2 => GType_None),
         2 => (1 => GType_Pointer,           2 => GType_None),
         3 => (1 => GType_Uint,              2 => GType_None),
         4 => (1 => Gtk.Adjustment.Get_Type, 2 => Gtk.Adjustment.Get_Type),
         5 => (1 => GType_Pointer,           2 => GType_None),
         6 => (1 => GType_Pointer,           2 => GType_None));
      --  the parameters for the above signals.
      --  This must be defined in this function rather than at the
      --  library-level, or the value of Gdk_Event.Get_Type is not yet
      --  initialized.

      Style : Gtk_Style;

   begin
      Gtk.Drawing_Area.Initialize (Canvas);
      Canvas.Offset_X_World := 0;
      Canvas.Offset_Y_World := 0;
      Canvas.World_X := 0.0;
      Canvas.World_Y := 0.0;

      Set_Directed (Canvas.Children, True);
      Canvas.Auto_Layout := Auto_Layout;

      --  The following call is required to initialize the class record,
      --  and the new signals created for this widget.
      --  Note also that we keep Class_Record, so that the memory allocation
      --  is done only once.
      Initialize_Class_Record
        (Canvas, Signals, Class_Record,
         "GtkAdaCanvas", Signal_Parameters);
      Set_Scroll_Adjustments_Signal
        (Class_Record, "set_scroll_adjustments");

      Return_Callback.Connect
        (Canvas, "expose_event",
         Return_Callback.To_Marshaller (Expose'Access));
      Return_Callback.Connect
        (Canvas, "button_press_event",
         Return_Callback.To_Marshaller (Button_Pressed'Access));
      Return_Callback.Connect
        (Canvas, "button_release_event",
         Return_Callback.To_Marshaller (Button_Release'Access));
      Return_Callback.Connect
        (Canvas, "motion_notify_event",
         Return_Callback.To_Marshaller (Button_Motion'Access));
      Return_Callback.Connect
        (Canvas, "key_press_event",
         Return_Callback.To_Marshaller (Key_Press'Access));
      Widget_Callback.Connect
        (Canvas, "size_allocate", Size_Allocate'Access);
      Widget_Callback.Connect
        (Canvas, "set_scroll_adjustments", Set_Scroll_Adjustments'Access);
      Widget_Callback.Connect
        (Canvas, "destroy",
         Widget_Callback.To_Marshaller (Canvas_Destroyed'Access));

      Style := Get_Style (Canvas);
      Set_Bg (Style, State_Normal, Gdk_Color'(Get_White (Style)));
      Set_Style (Canvas, Style);

      Canvas.Annotation_Layout := Create_Pango_Layout (Canvas);

      --  We want to be sure to get all the mouse events, that are required
      --  for the animation.

      Add_Events
        (Canvas,
         Button_Press_Mask
           or Button_Motion_Mask
           or Button_Release_Mask
           or Key_Press_Mask
           or Key_Release_Mask);
      Set_Flags (Canvas, Can_Focus);

      --  Configure with default values
      Configure (Canvas);
      Set_Scroll_Adjustments (Canvas, null, null);
   end Initialize;

   --------------
   -- Get_Vadj --
   --------------

   function Get_Vadj
     (Canvas : access Interactive_Canvas_Record'Class) return Gtk_Adjustment is
   begin
      return Canvas.Vadj;
   end Get_Vadj;

   --------------
   -- Get_Hadj --
   --------------

   function Get_Hadj
     (Canvas : access Interactive_Canvas_Record'Class) return Gtk_Adjustment is
   begin
      return Canvas.Hadj;
   end Get_Hadj;

   ----------------------
   -- Canvas_Destroyed --
   ----------------------

   procedure Canvas_Destroyed (Canvas : access Gtk_Widget_Record'Class) is
      C : constant Interactive_Canvas := Interactive_Canvas (Canvas);
   begin
      if C.Scrolling_Timeout_Id /= 0 then
         Remove (C.Scrolling_Timeout_Id);
      end if;

      Clear (C);

      Unref (C.Annotation_Layout);

      Destroy (C.Hadj);
      Destroy (C.Vadj);
   end Canvas_Destroyed;

   ----------------------------
   -- Set_Scroll_Adjustments --
   ----------------------------

   procedure Set_Scroll_Adjustments
     (Canvas : access Gtk_Widget_Record'Class;
      Args   : GValues)
   is
      Hadj : constant System.Address := Get_Address (Nth (Args, 1));
      Vadj : constant System.Address := Get_Address (Nth (Args, 2));
      Canv : constant Interactive_Canvas := Interactive_Canvas (Canvas);
      Stub : Gtk_Adjustment_Record;

   begin
      if Canv.Hadj /= null then
         Unref (Canv.Hadj);
      end if;

      if Hadj /= System.Null_Address then
         Canv.Hadj := Gtk_Adjustment (Get_User_Data (Hadj, Stub));
      else
         Gtk_New (Canv.Hadj, 0.0, 0.0, 0.0, 1.0, 1.0);
      end if;
      Ref (Canv.Hadj);
      Sink (Canv.Hadj);

      if Canv.Vadj /= null then
         Unref (Canv.Vadj);
      end if;

      if Vadj /= System.Null_Address then
         Canv.Vadj := Gtk_Adjustment (Get_User_Data (Vadj, Stub));
      else
         Gtk_New (Canv.Vadj, 0.0, 0.0, 0.0, 1.0, 1.0);
      end if;
      Ref (Canv.Vadj);
      Sink (Canv.Vadj);

      Scrolled (Canvas);

      Widget_Callback.Object_Connect
        (Canv.Hadj, "value_changed",
         Widget_Callback.To_Marshaller (Scrolled'Access), Canv);
      Widget_Callback.Object_Connect
        (Canv.Vadj, "value_changed",
         Widget_Callback.To_Marshaller (Scrolled'Access), Canv);

      Update_Adjustments (Canv);
   end Set_Scroll_Adjustments;

   ---------------
   -- Configure --
   ---------------

   procedure Configure
     (Canvas            : access Interactive_Canvas_Record;
      Grid_Size         : Guint := Default_Grid_Size;
      Annotation_Font   : Pango.Font.Pango_Font_Description :=
        Pango.Font.From_String (Default_Annotation_Font);
      Arc_Link_Offset   : Gint := Default_Arc_Link_Offset;
      Arrow_Angle       : Gint := Default_Arrow_Angle;
      Arrow_Length      : Gint := Default_Arrow_Length;
      Motion_Threshold  : Gdouble := Default_Motion_Threshold) is
   begin
      Canvas.Grid_Size := Grid_Size;

      if Grid_Size < 2 then
         Canvas.Align_On_Grid := False;
      end if;

      Set_Font_Description (Canvas.Annotation_Layout, Annotation_Font);

      Canvas.Arc_Link_Offset := Arc_Link_Offset;
      Canvas.Arrow_Angle := Gdouble (Arrow_Angle) * Pi / 180.0;
      Canvas.Arrow_Length := Arrow_Length;
      Canvas.Motion_Threshold := Motion_Threshold;
   end Configure;

   -------------------
   -- Size_Allocate --
   -------------------

   procedure Size_Allocate
     (Canv : access Gtk_Widget_Record'Class;
      Args : Gtk_Args)
   is
      Canvas : constant Interactive_Canvas := Interactive_Canvas (Canv);
      pragma Unreferenced (Args);
   begin
      Update_Adjustments (Canvas);

      if Canvas.Show_Item /= null then
         Show_Item (Canvas, Canvas.Show_Item,
                    Canvas.Show_Canvas_X, Canvas.Show_Canvas_Y);
         Canvas.Show_Item := null;
      end if;
   end Size_Allocate;

   -------------------
   -- Align_On_Grid --
   -------------------

   procedure Align_On_Grid
     (Canvas : access Interactive_Canvas_Record;
      Align  : Boolean := True) is
   begin
      Canvas.Align_On_Grid := (Canvas.Grid_Size >= 2) and then Align;
   end Align_On_Grid;

   ----------------------
   -- Get_Bounding_Box --
   ----------------------

   procedure Get_Bounding_Box
     (Canvas                     : access Interactive_Canvas_Record'Class;
      X_Min, X_Max, Y_Min, Y_Max : out Gdouble)
   is
      Current    : Vertex_Iterator := First (Canvas.Children);
      Item       : Canvas_Item;

   begin
      if At_End (Current) then
         X_Min := 0.0;
         X_Max := 0.0;
         Y_Min := 0.0;
         Y_Max := 0.0;

      else
         X_Min := Gdouble'Last;
         X_Max := Gdouble'First;
         Y_Min := Gdouble'Last;
         Y_Max := Gdouble'First;

         while not At_End (Current) loop
            Item := Canvas_Item (Get (Current));
            if Item.Visible and then Item.Coord.X /= Gint'First then
               X_Min := Gdouble'Min
                 (X_Min, Gdouble (Item.Coord.X));
               X_Max := Gdouble'Max
                 (X_Max, Gdouble (Item.Coord.X + Item.Coord.Width));
               Y_Min := Gdouble'Min
                 (Y_Min, Gdouble (Item.Coord.Y));
               Y_Max := Gdouble'Max
                 (Y_Max, Gdouble (Item.Coord.Y + Item.Coord.Height));

               --  If the item is selected, also include its new position in
               --  the computation (while we are moving items)

               if (Canvas.Offset_X_World /= 0
                   or else Canvas.Offset_Y_World /= 0)
                 and then Item.Selected
               then
                  X_Min := Gdouble'Min
                    (X_Min, Gdouble (Item.Coord.X + Canvas.Offset_X_World));
                  X_Max := Gdouble'Max
                    (X_Max, Gdouble (Item.Coord.X + Item.Coord.Width +
                                       Canvas.Offset_X_World));
                  Y_Min := Gdouble'Min
                    (Y_Min, Gdouble (Item.Coord.Y + Canvas.Offset_Y_World));
                  Y_Max := Gdouble'Max
                    (Y_Max, Gdouble (Item.Coord.Y + Item.Coord.Height +
                                       Canvas.Offset_Y_World));
               end if;
            end if;

            Next (Current);
         end loop;
      end if;
   end Get_Bounding_Box;

   ------------------------
   -- Update_Adjustments --
   ------------------------

   procedure Update_Adjustments
     (Canvas       : access Interactive_Canvas_Record'Class;
      Min_Max      : Boolean := True;
      Page_Size    : Boolean := True;
      Clip_Value   : Boolean := True;
      Send_Changed : Boolean := True)
   is
      procedure Update_Axis
        (Adj      : access Gtk_Adjustment_Record'Class;
         Min, Max : Gdouble;
         Size     : Gdouble);
      --  Takes care of one of the axis

      -----------------
      -- Update_Axis --
      -----------------

      procedure Update_Axis
        (Adj      : access Gtk_Adjustment_Record'Class;
         Min, Max : Gdouble;
         Size     : Gdouble)
      is
         Changed_Sent : Boolean := False;
         Vals_Changed : Boolean := False;
         Tmp          : Gdouble;

      begin
         if Min_Max then
            Tmp := Min;
            if Tmp > Get_Value (Adj) then
               Tmp := Get_Value (Adj);
            end if;
            if Get_Lower (Adj) /= Tmp then
               Set_Lower          (Adj, Tmp);
               Vals_Changed := True;
            end if;
            Tmp := Max;
            if Tmp < Get_Value (Adj) + Size then
               Tmp := Get_Value (Adj) + Size - 1.0;
            end if;
            if Get_Upper (Adj) /= Tmp then
               Set_Upper          (Adj, Tmp);
               Vals_Changed := True;
            end if;
         end if;

         if Page_Size then
            if Get_Page_Size (Adj) /= Size then
               Set_Page_Size      (Adj, Size);
               Set_Step_Increment (Adj, Size / 10.0);
               Set_Page_Increment (Adj, Size / 2.0);
               Vals_Changed := True;
            end if;
         end if;

         if Clip_Value then
            if Get_Value (Adj) < Min then
               Set_Value (Adj, Min);
               --  this call emits the changed signal
               Changed_Sent := True;
            end if;

            if Get_Value (Adj) + Size > Max then
               Set_Value (Adj, Max - Size);
               --  this call emits the changed signal
               Changed_Sent := True;
            end if;
         end if;

         if Send_Changed and then Vals_Changed and then not Changed_Sent then
            --  If the changed signal was not sent, then we manually send it
            Changed (Adj);
         end if;
      end Update_Axis;

      X_Max, Y_Max, X_Min, Y_Min : Gdouble;

   begin
      --  If the canvas was properly initialized
      if Realized_Is_Set (Canvas)
        and then Get_Allocation_Width (Canvas) /= 1
      then
         Get_Bounding_Box (Canvas, X_Min, X_Max, Y_Min, Y_Max);
         --  Add some space around this bounding box
         --  ??? Use a constant
         X_Min := X_Min - 20.0;
         Y_Min := Y_Min - 20.0;
         X_Max := X_Max + 20.0;
         Y_Max := Y_Max + 20.0;

         Update_Axis
           (Canvas.Hadj, X_Min, X_Max,
            Gdouble (Get_Allocation_Width (Canvas)) / Canvas.Zoom);
         Update_Axis
           (Canvas.Vadj, Y_Min, Y_Max,
            Gdouble (Get_Allocation_Height (Canvas)) / Canvas.Zoom);
      end if;
   end Update_Adjustments;

   ------------------------------
   -- Default_Layout_Algorithm --
   ------------------------------

   procedure Default_Layout_Algorithm
     (Canvas          : access Interactive_Canvas_Record'Class;
      Graph           : Glib.Graphs.Graph;
      Force           : Boolean;
      Vertical_Layout : Boolean)
   is
      pragma Unreferenced (Force);
      Step       : Gint := Gint (Canvas.Grid_Size);
      Region     : Cairo_Region;
      Items      : Vertex_Iterator;
      Item       : Canvas_Item;
      Links      : Edge_Iterator;
      Src_Item   : Canvas_Item := null;
      X1, X3, Y1 : Gint;
      Num        : Gint;
      Coord      : aliased Cairo_Rectangle_Int;
      Status     : Cairo_Status;
      pragma Unreferenced (Status);

   begin
      if Step = 0 then
         Step := Gint (Default_Grid_Size);
      end if;

      --  First, check every item that won't be moved

      Region := Create;
      Items := First (Graph);
      while not At_End (Items) loop
         Item := Canvas_Item (Get (Items));
         if Item.Coord.X /= Gint'First
           or else Item.Coord.Y /= Gint'First
         then
            Status := Union_Rectangle (Region, Item.Coord'Access);
         end if;

         Next (Items);
      end loop;

      Items := First (Graph);
      while not At_End (Items) loop
         Item := Canvas_Item (Get (Items));
         if Item.Coord.X = Gint'First or else Item.Coord.Y = Gint'First then
            --  Check if there is any link that has for destination or source
            --  the widget we are adding.

            Links := First (Canvas.Children, Src => Vertex_Access (Item));
            if not At_End (Links) then
               Src_Item := Canvas_Item (Get_Dest (Get (Links)));
            else
               Links := First (Canvas.Children, Dest => Vertex_Access (Item));
               if not At_End (Links) then
                  Src_Item := Canvas_Item (Get_Src (Get (Links)));
               else
                  Src_Item := null;
               end if;
            end if;

            --  The rule is the following when we have a link to an existing
            --  item: We first try to put the new item below the old one, then,
            --  if that place is already occupied, to the bottom-right, then
            --  the bottom-left, then two down, ...

            if Src_Item /= null then
               Num := 0;

               if Vertical_Layout then
                  X3 := Src_Item.Coord.Y;
                  Y1 := Src_Item.Coord.X + Src_Item.Coord.Width + Step;

                  loop
                     case Num mod 3 is
                        when 0 =>
                           X1 := X3;
                        when 1 =>
                           X1 := X3 - Step - Item.Coord.Height;
                        when 2 =>
                           X1 := X3 + Step + Item.Coord.Height;
                        when others =>
                           null;
                     end case;

                     Coord := (Y1, X1, Item.Coord.Width, Item.Coord.Height);
                     exit when
                       Contains_Rectangle
                         (Region, Coord'Access) = Cairo_Region_Overlap_Out;

                     Num := Num + 1;
                     if Num mod 3 = 0 then
                        Y1 := Y1 + 2 * Step;
                     end if;
                  end loop;

                  Item.Coord.X := Y1;
                  Item.Coord.Y := X1;

               else
                  X3 := Src_Item.Coord.X;
                  Y1 := Src_Item.Coord.Y + Src_Item.Coord.Height + Step;

                  loop
                     case Num mod 3 is
                        when 0 =>
                           X1 := X3;
                        when 1 =>
                           X1 := X3 - Step - Item.Coord.Width;
                        when 2 =>
                           X1 := X3 + Step + Item.Coord.Width;
                        when others =>
                           null;
                     end case;

                     Coord := (X1, Y1, Item.Coord.Width, Item.Coord.Height);
                     exit when
                       Contains_Rectangle
                         (Region, Coord'Access) = Cairo_Region_Overlap_Out;

                     Num := Num + 1;
                     if Num mod 3 = 0 then
                        Y1 := Y1 + 2 * Step;
                     end if;
                  end loop;

                  Item.Coord.X := X1;
                  Item.Coord.Y := Y1;
               end if;

            else
               --  Else put the item in the first line, at the first possible
               --  location
               X1 := Gint (Get_Lower (Canvas.Hadj)) + Step;
               Y1 := Gint (Get_Lower (Canvas.Vadj)) + Step;

               loop
                  Coord := (X1, Y1, Item.Coord.Width, Item.Coord.Height);
                  exit when
                    Contains_Rectangle
                      (Region, Coord'Access) = Cairo_Region_Overlap_Out;

                  if Vertical_Layout then
                     Y1 := Y1 + 2 * Step;
                  else
                     X1 := X1 + 2 * Step;
                  end if;
               end loop;

               Item.Coord.X := X1;
               Item.Coord.Y := Y1;
            end if;

            Status := Union_Rectangle (Region, Item.Coord'Access);
         end if;

         Next (Items);
      end loop;

      Destroy (Region);
   end Default_Layout_Algorithm;

   ---------------------
   -- Set_Auto_Layout --
   ---------------------

   procedure Set_Auto_Layout
     (Canvas      : access Interactive_Canvas_Record;
      Auto_Layout : Boolean) is
   begin
      Canvas.Auto_Layout := Auto_Layout;
   end Set_Auto_Layout;

   ----------------------------
   -- Set_Layout_Orientation --
   ----------------------------

   procedure Set_Layout_Orientation
     (Canvas          : access Interactive_Canvas_Record;
      Vertical_Layout : Boolean := False)
   is
   begin
      Canvas.Vertical_Layout := Vertical_Layout;
   end Set_Layout_Orientation;

   ------------
   -- Layout --
   ------------

   procedure Layout
     (Canvas : access Interactive_Canvas_Record;
      Force  : Boolean := False)
   is
      Step         : constant Gint := Gint (Canvas.Grid_Size);
      Items        : Vertex_Iterator;
      Item         : Canvas_Item;
      Min_X, Min_Y : Gint := Gint'Last;
      Max_X, Max_Y : Gint := Gint'First;

   begin
      Canvas.Layout
        (Canvas, Canvas.Children,
         Force           => Force,
         Vertical_Layout => Canvas.Vertical_Layout);

      Items := First (Canvas.Children);

      while not At_End (Items) loop
         Item := Canvas_Item (Get (Items));
         Min_X := Gint'Min (Min_X, Item.Coord.X);
         Min_Y := Gint'Min (Min_Y, Item.Coord.Y);
         Max_X := Gint'Max (Max_X, Item.Coord.X + Item.Coord.Width);
         Max_Y := Gint'Max (Max_Y, Item.Coord.Y + Item.Coord.Height);

         if Force then
            Item.From_Auto_Layout := True;
         end if;

         Next (Items);
      end loop;

      Items := First (Canvas.Children);

      while not At_End (Items) loop
         Item := Canvas_Item (Get (Items));

         --  Normalize the coordinates, so that we stay within Integer'Range.
         --  Since this causes unwanted scrolling when new boxes are added, we
         --  only do it to keep a safe margin when the user moves a box around,
         --  and thus only when absolutly needed.

         if Max_X > Gint'Last - 5000
           or else Max_Y > Gint'Last - 5000
           or else Min_X < Gint'First + 5000
           or else Min_Y < Gint'First + 5000
         then
            if Traces then
               Put_Line ("Layout: Changing all items: Min="
                 & Gint'Image (Min_X) & Gint'Image (Min_Y)
                         & " Max=" & Gint'Image (Max_X) & Gint'Image (Max_Y));
            end if;

            Item.Coord.X := Item.Coord.X - Min_X;
            Item.Coord.Y := Item.Coord.Y - Min_Y;
         end if;

         if Item.From_Auto_Layout then
            if Canvas.Align_On_Grid then
               Item.Coord.X := Item.Coord.X - Item.Coord.X mod Step;
               Item.Coord.Y := Item.Coord.Y - Item.Coord.Y mod Step;
            end if;
         end if;

         Next (Items);
      end loop;

      Update_Adjustments (Canvas);
   end Layout;

   --------------------------
   -- Set_Layout_Algorithm --
   --------------------------

   procedure Set_Layout_Algorithm
     (Canvas    : access Interactive_Canvas_Record;
      Algorithm : Layout_Algorithm) is
   begin
      if Canvas.Layout /= null then
         Canvas.Layout := Algorithm;
      end if;
   end Set_Layout_Algorithm;

   -------------
   -- Move_To --
   -------------

   procedure Move_To
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class;
      X, Y   : Glib.Gint := Glib.Gint'First)
   is
      pragma Unreferenced (Canvas);
   begin
      Item.Coord.X := X;
      Item.Coord.Y := Y;
   end Move_To;

   ---------
   -- Put --
   ---------

   procedure Put
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class;
      X, Y   : Gint := Gint'First) is
   begin
      Add_Vertex (Canvas.Children, Item);
      Item.Canvas := Interactive_Canvas (Canvas);
      Move_To (Canvas, Item, X, Y);

      --  Make sure that the item will be properly moved by the layout
      --  algorithm.
      Item.From_Auto_Layout :=
        X = Gint'First and then Y = Gint'First;

      if Canvas.Auto_Layout
        and then Item.From_Auto_Layout
      then
         Layout (Canvas);
      else
         Update_Adjustments (Canvas);
      end if;

      Update_Adjustments (Canvas);
   end Put;

   ---------------
   -- Set_Items --
   ---------------

   procedure Set_Items
     (Canvas : access Interactive_Canvas_Record;
      Items  : Glib.Graphs.Graph) is
   begin
      Destroy (Canvas.Children);
      Canvas.Children := Items;
   end Set_Items;

   -------------------
   -- For_Each_Item --
   -------------------

   procedure For_Each_Item
     (Canvas            : access Interactive_Canvas_Record;
      Execute           : Item_Processor;
      Linked_From_Or_To : Canvas_Item := null)
   is
      Iter : Item_Iterator := Start (Canvas, Linked_From_Or_To);
      It   : Canvas_Item;
   begin
      loop
         It := Get (Iter);
         exit when It = null;

         Next (Iter);
         exit when not Execute (Canvas, It);
      end loop;
   end For_Each_Item;

   -----------
   -- Start --
   -----------

   function Start
     (Canvas            : access Interactive_Canvas_Record;
      Linked_From_Or_To : Canvas_Item := null;
      Selected_Only     : Boolean := False) return Item_Iterator
   is
      Iter : Item_Iterator;
   begin
      if Linked_From_Or_To = null then
         Iter := (Vertex            => First (Canvas.Children),
                  Edge              => Null_Edge_Iterator,
                  Selected_Only     => Selected_Only,
                  Linked_From_Or_To => null);
      else
         Iter := (Vertex => Null_Vertex_Iterator,
                  Edge   => First (Canvas.Children,
                    Vertex_Access (Linked_From_Or_To),
                    Directed => False),
                  Selected_Only     => Selected_Only,
                  Linked_From_Or_To => Linked_From_Or_To);
      end if;

      if Iter.Selected_Only
        and then Get (Iter) /= null
        and then not Get (Iter).Selected
      then
         Next (Iter);
      end if;

      return Iter;
   end Start;

   ----------
   -- Next --
   ----------

   procedure Next (Iter : in out Item_Iterator) is
   begin
      loop
         if Iter.Linked_From_Or_To = null then
            Next (Iter.Vertex);
         else
            Next (Iter.Edge);
         end if;

         exit when not Iter.Selected_Only
           or else Get (Iter) = null
           or else Get (Iter).Selected;
      end loop;
   end Next;

   ----------
   -- Next --
   ----------

   function Next (Iter : Item_Iterator) return Item_Iterator is
      It : Item_Iterator := Iter;
   begin
      Next (It);
      return It;
   end Next;

   --------------------
   -- Is_Linked_From --
   --------------------

   function Is_Linked_From (Iter : Item_Iterator) return Boolean is
   begin
      return Iter.Linked_From_Or_To /= null
        and then not At_End (Iter.Edge)
        and then Canvas_Item (Get_Src (Get (Iter.Edge))) /=
          Iter.Linked_From_Or_To;
   end Is_Linked_From;

   ---------
   -- Get --
   ---------

   function Get (Iter : Item_Iterator) return Canvas_Item is
      Item : Canvas_Item;
   begin
      if Iter.Linked_From_Or_To = null then
         if At_End (Iter.Vertex) then
            return null;
         else
            return Canvas_Item (Get (Iter.Vertex));
         end if;

      else
         if At_End (Iter.Edge) then
            return null;
         end if;

         Item  := Canvas_Item (Get_Src (Get (Iter.Edge)));
         if Item /= Iter.Linked_From_Or_To then
            return Item;
         end if;

         --  If Get_Src was the item, we want to return Dest (which might
         --  actually be the item itself).
         --  Else, if Get_Src wasn't the item, then Get_Dest is the item, and
         --  we do not want to return it.
         return Canvas_Item (Get_Dest (Get (Iter.Edge)));
      end if;
   end Get;

   ---------------
   -- Clip_Line --
   ---------------

   procedure Clip_Line
     (Src    : access Canvas_Item_Record;
      Canvas : access Interactive_Canvas_Record'Class;
      To_X   : Gint;
      To_Y   : Gint;
      X_Pos  : Gfloat;
      Y_Pos  : Gfloat;
      Side   : out Item_Side;
      X_Out  : out Gint;
      Y_Out  : out Gint)
   is
      Rect    : aliased Cairo_Rectangle_Int;
      Src_X   : Gint;
      Src_Y   : Gint;
      Delta_X : Gint;
      Delta_Y : Gint;
      Offset  : Gint;
   begin
      if Src.Selected then
         Rect := (Src.Coord.X + Canvas.Offset_X_World,
                  Src.Coord.Y + Canvas.Offset_Y_World,
                  Src.Coord.Width,
                  Src.Coord.Height);
      else
         Rect := Src.Coord;
      end if;

      Src_X    := Rect.X + Gint (Gfloat (Rect.Width) * X_Pos);
      Src_Y    := Rect.Y + Gint (Gfloat (Rect.Height) * Y_Pos);
      Delta_X  := To_X - Src_X;
      Delta_Y  := To_Y - Src_Y;

      --  Intersection with horizontal sides

      if Delta_Y /= 0 then
         Offset := (Src_X * To_Y - To_X * Src_Y);

         if Delta_Y < 0 then
            Side := North;
            Y_Out := Rect.Y;
         else
            Side := South;
            Y_Out := Rect.Y + Rect.Height;
         end if;

         X_Out := (Delta_X * Y_Out + Offset) / Delta_Y;

         if Rect.X <= X_Out
           and then X_Out <= Rect.X + Rect.Width
         then
            return;
         end if;
      end if;

      --  Intersection with vertical sides

      if Delta_X /= 0 then
         Offset := (To_X * Src_Y - Src_X * To_Y);

         if Delta_X < 0 then
            Side := West;
            X_Out := Rect.X;
         else
            Side := East;
            X_Out := Rect.X + Rect.Width;
         end if;

         Y_Out := (Delta_Y * X_Out + Offset) / Delta_X;

         if Rect.Y <= Y_Out
           and then Y_Out <= Rect.Y + Rect.Height
         then
            return;
         end if;
      end if;

      X_Out := 0;
      Y_Out := 0;
      Side := East;
   end Clip_Line;

   ---------------------
   -- Draw_Arrow_Head --
   ---------------------

   procedure Draw_Arrow_Head
     (Canvas : access Interactive_Canvas_Record'Class;
      Cr     : Cairo_Context;
      X, Y   : Gint;
      Angle  : Gdouble)
   is
      Length : constant Gdouble := Gdouble (Canvas.Arrow_Length);

   begin
      Move_To (Cr, Gdouble (X), Gdouble (Y));
      Line_To
        (Cr,
         Gdouble (X) + Length * Cos (Angle + Canvas.Arrow_Angle),
         Gdouble (Y) + Length * Sin (Angle + Canvas.Arrow_Angle));
      Line_To
        (Cr,
         Gdouble (X) + Length * Cos (Angle - Canvas.Arrow_Angle),
         Gdouble (Y) + Length * Sin (Angle - Canvas.Arrow_Angle));
      Close_Path (Cr);
      Cairo.Fill (Cr);
   end Draw_Arrow_Head;

   ---------------------
   -- Draw_Annotation --
   ---------------------

   procedure Draw_Annotation
     (Canvas : access Interactive_Canvas_Record'Class;
      Cr     : Cairo_Context;
      X, Y   : Gint;
      Link   : access Canvas_Link_Record'Class)
   is
      W, H : Gint;

   begin
      if Link.Descr /= null
        and then Link.Descr.all /= ""
        and then Canvas.Annotation_Layout /= null
      then
         Set_Text (Canvas.Annotation_Layout, Link.Descr.all);
         Get_Pixel_Size (Canvas.Annotation_Layout, W, H);

         Cairo.Save (Cr);
         Gdk.Cairo.Set_Source_Color
           (Cr, Get_Bg (Get_Style (Canvas), State_Normal));
         Cairo.Set_Line_Width (Cr, 1.0);
         Cairo.Rectangle
           (Cr,
            Gdouble (X) - 0.5,
            Gdouble (Y) - 0.5,
            Gdouble (W) + 1.0,
            Gdouble (H) + 1.0);
         Cairo.Fill (Cr);
         Cairo.Restore (Cr);

         Cairo.Move_To (Cr, Gdouble (X), Gdouble (Y));
         Pango.Cairo.Show_Layout  (Cr, Canvas.Annotation_Layout);

      end if;
   end Draw_Annotation;

   ----------------------
   -- Compute_Line_Pos --
   ----------------------

   function Compute_Line_Pos
     (Canvas : access Interactive_Canvas_Record'Class) return Gint_Array
   is
      type Graph_Range is record
         From, To : Gint;
      end record;

      type Range_Array is array (Positive range <>) of Graph_Range;
      type Range_Array_Access is access all Range_Array;

      procedure Free is new Unchecked_Deallocation
        (Range_Array, Range_Array_Access);

      Free_Ranges : Range_Array_Access := new Range_Array (1 .. 1000);
      Tmp         : Range_Array_Access;
      Last_Range  : Positive := Free_Ranges'First;
      Iter        : Vertex_Iterator := First (Canvas.Children);
      E           : Canvas_Item;
      Right       : Gint;
   begin
      Free_Ranges (Free_Ranges'First) := (From => Gint'First, To => Gint'Last);

      while not At_End (Iter) loop
         E := Canvas_Item (Get (Iter));
         Right := E.Coord.X + E.Coord.Width;

         for R in Free_Ranges'First .. Last_Range loop
            if Free_Ranges (R).From <= E.Coord.X
              and then Free_Ranges (R).To >= E.Coord.X
              and then Free_Ranges (R).To <= Right
            then
               Free_Ranges (R) :=
                 (From => Free_Ranges (R).From, To => E.Coord.X - 1);

            elsif Free_Ranges (R).From <= E.Coord.X
              and then Free_Ranges (R).To >= Right
            then
               if Last_Range >= Free_Ranges'Last then
                  Tmp := new Range_Array (1 .. Free_Ranges'Last * 2);
                  Tmp (1 .. Free_Ranges'Last) := Free_Ranges.all;
                  Free (Free_Ranges);
                  Free_Ranges := Tmp;
               end if;

               Free_Ranges (R + 1 .. Last_Range + 1) :=
                 Free_Ranges (R .. Last_Range);
               Free_Ranges (R + 1) :=
                 (From => Right + 1, To => Free_Ranges (R).To);
               Free_Ranges (R) :=
                 (From => Free_Ranges (R).From, To => E.Coord.X - 1);
               Last_Range := Last_Range + 1;

            elsif Free_Ranges (R).From >= E.Coord.X
              and then Free_Ranges (R).From <= Right
              and then Free_Ranges (R).To >= Right
            then
               Free_Ranges (R) :=
                 (From => Right + 1, To => Free_Ranges (R).To);
            end if;

            exit when Free_Ranges (R).From > Right;
         end loop;

         Next (Iter);
      end loop;

      declare
         Result : Gint_Array (1 .. Last_Range);
      begin
         for R in Result'Range loop
            --  ??? Should handle vertical layout and horizontal layout
            Result (R) :=
              (Free_Ranges (R).From + Free_Ranges (R).To) / 2;
         end loop;

         Free (Free_Ranges);
         return Result;
      end;
   end Compute_Line_Pos;

   ---------------------------
   -- Scroll_Canvas_To_Item --
   ----------------------------

   procedure Scroll_Canvas_To_Item
     (Canvas             : access Interactive_Canvas_Record'Class;
      Item               : access Canvas_Item_Record'Class;
      Canvas_X, Canvas_Y : Gdouble := 0.5;
      Report_Adj_Changed : Boolean := True)
   is
      X1, Y1 : Gint;
   begin
      --  If no size was allocated yet, memorize the item for later (see
      --  the callback for size_allocate)

      if Get_Allocation_Width (Canvas) = 1
        or else Get_Allocation_Height (Canvas) = 1
      then
         Canvas.Show_Item     := Canvas_Item (Item);
         Canvas.Show_Canvas_X := Canvas_X;
         Canvas.Show_Canvas_Y := Canvas_Y;
      else
         X1 := Item.Coord.X + Canvas.Offset_X_World;
         Y1 := Item.Coord.Y + Canvas.Offset_Y_World;
         Scroll_Canvas_To_Area
           (Canvas,
            Gdouble (X1),
            Gdouble (Y1),
            Gdouble (X1 + Item.Coord.Width),
            Gdouble (Y1 + Item.Coord.Height),
            Canvas_X, Canvas_Y, Report_Adj_Changed);
      end if;
   end Scroll_Canvas_To_Item;

   ---------------------------
   -- Scroll_Canvas_To_Area --
   ---------------------------

   procedure Scroll_Canvas_To_Area
     (Canvas             : access Interactive_Canvas_Record'Class;
      X1, Y1, X2, Y2     : Gdouble;
      Canvas_X, Canvas_Y : Gdouble := 0.5;
      Ignore_If_Visible  : Boolean := True;
      Report_Adj_Changed : Boolean := True)
   is
      procedure Center_On_Coordinate
        (Adj        : access Gtk_Adjustment_Record'Class;
         Min, Max   : Gdouble;
         Canvas_Pos : Gdouble);
      --  Takes care of one of the axis

      --------------------------
      -- Center_On_Coordinate --
      --------------------------

      procedure Center_On_Coordinate
        (Adj        : access Gtk_Adjustment_Record'Class;
         Min, Max   : Gdouble;
         Canvas_Pos : Gdouble)
      is
         Adj_Changed : Boolean := False;
         Val         : constant Gdouble := Get_Value (Adj);
         Size        : constant Gdouble := Get_Page_Size (Adj);
         N_Val       : Gdouble;

      begin
         if Ignore_If_Visible
           and then Min >= Val and then Max <= Val + Size
         then
            return;
         end if;

         --  Calculate the new scroll value

         if Canvas_Pos > 1.0 then
            --  Minimal scrolling is needed
            if Min < Val then
               N_Val := Min;
            elsif Max > Val + Size then
               N_Val := Max - Size;
            end if;

         else
            --  Align the center of the region with the given canvas location
            N_Val := (Min + Max) / 2.0 - Size * Canvas_Pos;
         end if;

         --  Do we need to extend the canvas to show the region ?

         if Max > Get_Upper (Adj) then
            Set_Upper (Adj, Max);
            Adj_Changed := True;
         end if;

         if N_Val + Size > Get_Upper (Adj) then
            Set_Upper (Adj, N_Val + Size - 1.0);
            Adj_Changed := True;
         end if;

         if Min < Get_Lower (Adj) then
            Set_Lower (Adj, Min);
            Adj_Changed := True;
         end if;

         if N_Val < Get_Lower (Adj) then
            Set_Lower (Adj, N_Val);
            Adj_Changed := True;
         end if;

         if Report_Adj_Changed and then Adj_Changed then
            Changed (Adj);
         end if;

         --  Now scroll appropriately
         Set_Value (Adj, N_Val);
      end Center_On_Coordinate;

   begin
      Center_On_Coordinate (Canvas.Hadj, X1, X2, Canvas_X);
      Center_On_Coordinate (Canvas.Vadj, Y1, Y2, Canvas_Y);
   end Scroll_Canvas_To_Area;

   --------------------------
   -- Draw_Orthogonal_Link --
   --------------------------

   procedure Draw_Orthogonal_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Show_Annotation : Boolean)
   is
      X1, Y1, Xp1, Yp1, X2, Y2, Xp2, Yp2, X3, Y3 : Gint;
      Xc1, Xc2, Yc1, Yc2 : Gint;
      Xarr_End, Yarr_End, Xarr_Start, Yarr_Start : Gint;
      Angle_Arr_End, Angle_Arr_Start : Gdouble;
      Src      : constant Canvas_Item := Canvas_Item (Get_Src (Link));
      Dest     : constant Canvas_Item := Canvas_Item (Get_Dest (Link));
      Line_Pos : constant Gint_Array := Compute_Line_Pos (Canvas);

   begin
      if Src.Selected then
         X1 := Src.Coord.X + Canvas.Offset_X_World;
         Y1 := Src.Coord.Y + Canvas.Offset_Y_World;
      else
         X1 := Src.Coord.X;
         Y1 := Src.Coord.Y;
      end if;

      Xp1 := X1 + Src.Coord.Width;
      Yp1 := Y1 + Src.Coord.Height;

      if Dest.Selected then
         X2 := Dest.Coord.X + Canvas.Offset_X_World;
         Y2 := Dest.Coord.Y + Canvas.Offset_Y_World;
      else
         X2 := Dest.Coord.X;
         Y2 := Dest.Coord.Y;
      end if;

      Xp2 := X2 + Dest.Coord.Width;
      Yp2 := Y2 + Dest.Coord.Height;

      Xc1 := (X1 + Xp1) / 2;

      if Canvas.Grid_Size > 0 then
         Xc1 := Xc1 - Xc1 mod Gint (Canvas.Grid_Size);
      end if;

      Xc2 := (X2 + Xp2) / 2;
      if Canvas.Grid_Size > 0 then
         Xc2 := Xc2 - Xc2 mod Gint (Canvas.Grid_Size);
      end if;

      Yc1 := (Y1 + Yp1) / 2;
      Yc2 := (Y2 + Yp2) / 2;

      --  The preferred case will be
      --     A ---
      --         |____ B
      --  The separation line should be at equal distance of the center of A
      --  and the center of B, so that multiple items lined up in a column
      --  above B all have the vertical line at the same location.
      --
      --  If the vertical line can be drawn at exact distance of the centers,
      --  then we try and display the vertical line at equal distance of the
      --  adjacent edges of A and B

      X3 := Gint'First;

      for L in Line_Pos'Range loop
         if Line_Pos (L) >= Xp1
           and then Line_Pos (L) <= X2
         then
            X3 := Line_Pos (L);
            exit;

         elsif Line_Pos (L) >= Xp2
           and then Line_Pos (L) <= X1
         then
            X3 := Line_Pos (L);
            exit;
         end if;
      end loop;

      --  X3 := (X1 + Xp1 + X2 + Xp2) / 4;
      --  X3 := X3 - X3 mod Gint (Canvas.Grid_Size);

      --  if ((X1 <= X3 and then X3 <= Xp1)
      --      or else (X2 <= X3 and then X3 <= Xp2))
      --    and then (Xp1 <= X2 or else Xp2 <= X1)
      --  then
      --     X3 := (Xp1 + X2) / 2;
      --     X3 := X3 - X3 mod Gint (Canvas.Grid_Size);
      --  end if;

      if X3 /= Gint'First then
      --  if (X3 >= Xp1 and then X3 <= X2)
      --    or else (X3 <= X1 and then X3 >= Xp2)
      --  then

         Yarr_Start := Yc1;
         Yarr_End := Yc2;

         if X3 >= Xp1 then
            Cairo.Move_To (Cr, Gdouble (Xp1), Gdouble (Yc1) + 0.5);
            Line_To (Cr, Gdouble (X3) + 0.5, Gdouble (Yc1) + 0.5);
            Line_To (Cr, Gdouble (X3) + 0.5, Gdouble (Yc2) + 0.5);
            Line_To (Cr, Gdouble (X2), Gdouble (Yc2) + 0.5);
            Cairo.Stroke (Cr);

            Xarr_Start := Xp1;
            Xarr_End := X2;
            Angle_Arr_Start := 0.0;
            Angle_Arr_End := -Ada.Numerics.Pi;
         else
            Move_To (Cr, Gdouble (X1), Gdouble (Yc1) + 0.5);
            Line_To (Cr, Gdouble (X3) + 0.5, Gdouble (Yc1) + 0.5);
            Line_To (Cr, Gdouble (X3) + 0.5, Gdouble (Yc2) + 0.5);
            Line_To (Cr, Gdouble (Xp2), Gdouble (Yc2) + 0.5);
            Cairo.Stroke (Cr);

            Xarr_Start := X1;
            Xarr_End := Xp2;
            Angle_Arr_Start := -Ada.Numerics.Pi;
            Angle_Arr_End := 0.0;
         end if;

      --  Third case is when we didn't have enough space to draw the
      --  intermediate line. In that case, the layout is similar to
      --      A ----
      --           |
      --           B
      --  with the vertical line drawn at the same location as in the first
      --  algorithm.

      --  elsif X3 >= Xp1 or else X3 <= X1 then
      --     if X3 >= Xp1 then
      --        Draw_Line (Window, GC, Xp1, Yc1, X3, Yc1);
      --        Xarr_Start := Xp1;
      --        Angle_Arr_Start := -Ada.Numerics.Pi;
      --     else
      --        Draw_Line (Window, GC, X1, Yc1, X3, Yc1);
      --        Xarr_Start := X1;
      --        Angle_Arr_Start := 0.0;
      --     end if;

      --     Yarr_Start := Yc1;
      --     Xarr_End := X3;

      --     if Y2 < Yc1 then
      --        Draw_Line (Window, GC, X3, Yc1, X3, Yp2);
      --        Yarr_End := Yp2;
      --        Angle_Arr_End := Ada.Numerics.Pi / 2.0;
      --     else
      --        Draw_Line (Window, GC, X3, Yc1, X3, Y2);
      --        Yarr_End := Y2;
      --        Angle_Arr_End := -Ada.Numerics.Pi / 2.0;
      --     end if;

      --  Second case is when one of the item is below the other one. In that
      --  case, the layout should look like
      --       AAA
      --       |_
      --         |
      --        BB
      --  ie the link connects the top side of one item and the bottom side of
      --  the other item.

      else
      --  elsif (X1 <= X2 and then X2 <= Xp1)
      --    or else (X2 <= X1 and then X1 <= Xp2)
      --  then
         Y3 := (Y1 + Yp1 + Y2 + Yp2) / 4;
         if Canvas.Grid_Size > 0 then
            Y3 := Y3 - Y3 mod Gint (Canvas.Grid_Size);
         end if;
         Xarr_Start := Xc1;
         Xarr_End := Xc2;
         X3 := (Xc1 + Xc2) / 2;

         if Y2 > Y3 then
            Move_To (Cr, Gdouble (Xc1), Gdouble (Yp1));
            Line_To (Cr, Gdouble (Xc1), Gdouble (Y3));
            Line_To (Cr, Gdouble (Xc2), Gdouble (Y3));
            Line_To (Cr, Gdouble (Xc2), Gdouble (Y2));
            Cairo.Stroke (Cr);

            Yarr_Start := Yp1;
            Yarr_End := Y2;
            Angle_Arr_End := -Ada.Numerics.Pi / 2.0;
            Angle_Arr_Start := Ada.Numerics.Pi / 2.0;

         else
            Move_To (Cr, Gdouble (Xc1), Gdouble (Y1));
            Line_To (Cr, Gdouble (Xc1), Gdouble (Y3));
            Line_To (Cr, Gdouble (Xc2), Gdouble (Y3));
            Line_To (Cr, Gdouble (Xc2), Gdouble (Yp2));
            Cairo.Stroke (Cr);

            Yarr_Start := Y1;
            Yarr_End := Yp2;
            Angle_Arr_End := Ada.Numerics.Pi / 2.0;
            Angle_Arr_Start := -Ada.Numerics.Pi / 2.0;
         end if;
      end if;

      if Link.Arrow = End_Arrow or else Link.Arrow = Both_Arrow then
         Draw_Arrow_Head (Canvas, Cr, Xarr_End, Yarr_End, Angle_Arr_End);
      end if;

      if Link.Arrow = Start_Arrow or else Link.Arrow = Both_Arrow then
         Draw_Arrow_Head (Canvas, Cr, Xarr_Start, Yarr_Start, Angle_Arr_Start);
      end if;

      --  Draw the text if any

      if Link.Descr /= null and then Show_Annotation then
         Draw_Annotation
           (Canvas, Cr, X3, (Y1 + Y2) / 2, Link);
      end if;
   end Draw_Orthogonal_Link;

   ------------------------
   -- Draw_Straight_Line --
   ------------------------

   procedure Draw_Straight_Line
     (Link      : access Canvas_Link_Record;
      Cr        : Cairo_Context;
      Src_Side  : Item_Side;
      X1, Y1    : Glib.Gdouble;
      Dest_Side : Item_Side;
      X2, Y2    : Glib.Gdouble)
   is
      pragma Unreferenced (Link, Src_Side, Dest_Side);
   begin
      Cairo.Move_To (Cr, X1, Y1);
      Cairo.Line_To (Cr, X2, Y2);
      Cairo.Stroke (Cr);
   end Draw_Straight_Line;

   ------------------------
   -- Draw_Straight_Link --
   ------------------------

   procedure Draw_Straight_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Show_Annotation : Boolean)
   is
      X1, Y1, X2, Y2, Xs, Ys, Xd, Yd : Gint;
      Src   : constant Canvas_Item := Canvas_Item (Get_Src (Link));
      Dest  : constant Canvas_Item := Canvas_Item (Get_Dest (Link));
      Src_Side, Dest_Side : Item_Side;

   begin
      if Src.Selected then
         Xs := Src.Coord.X + Canvas.Offset_X_World;
         Ys := Src.Coord.Y + Canvas.Offset_Y_World;
      else
         Xs := Src.Coord.X;
         Ys := Src.Coord.Y;
      end if;

      if Dest.Selected then
         Xd := Dest.Coord.X + Canvas.Offset_X_World;
         Yd := Dest.Coord.Y + Canvas.Offset_Y_World;
      else
         Xd := Dest.Coord.X;
         Yd := Dest.Coord.Y;
      end if;

      Clip_Line
        (Src, Canvas,
         Xd + Gint (Gfloat (Dest.Coord.Width) * Link.Dest_X_Pos),
         Yd + Gint (Gfloat (Dest.Coord.Height) * Link.Dest_Y_Pos),
         X_Pos => Link.Src_X_Pos, Y_Pos => Link.Src_Y_Pos,
         Side => Src_Side, X_Out => X1, Y_Out => Y1);
      Clip_Line
        (Dest, Canvas,
         Xs + Gint (Gfloat (Src.Coord.Width) * Link.Src_X_Pos),
         Ys + Gint (Gfloat (Src.Coord.Height) * Link.Src_Y_Pos),
         X_Pos => Link.Dest_X_Pos, Y_Pos => Link.Dest_Y_Pos,
         Side => Dest_Side, X_Out => X2, Y_Out => Y2);

      Draw_Straight_Line
        (Link, Cr, Src_Side, Gdouble (X1), Gdouble (Y1),
         Dest_Side, Gdouble (X2), Gdouble (Y2));

      --  Draw the end arrow head

      if Link.Arrow = End_Arrow or else Link.Arrow = Both_Arrow then
         if X1 /= X2 then
            Draw_Arrow_Head
              (Canvas, Cr, X2, Y2,
               Arctan (Gdouble (Y1 - Y2), Gdouble (X1 - X2)));
         elsif Y1 > Y2 then
            Draw_Arrow_Head
              (Canvas, Cr, X2, Y2, Pi / 2.0);
         else
            Draw_Arrow_Head
              (Canvas, Cr, X2, Y2, -Pi / 2.0);
         end if;
      end if;

      --  Draw the start arrow head

      if Link.Arrow = Start_Arrow or else Link.Arrow = Both_Arrow then
         if X1 /= X2 then
            Draw_Arrow_Head
              (Canvas, Cr, X1, Y1,
               Arctan (Gdouble (Y2 - Y1), Gdouble (X2 - X1)));
         elsif Y1 > Y2 then
            Draw_Arrow_Head (Canvas, Cr, X1, Y1, -Pi / 2.0);
         else
            Draw_Arrow_Head (Canvas, Cr, X1, Y1, Pi / 2.0);
         end if;
      end if;

      --  Draw the text if any

      if Link.Descr /= null and then Show_Annotation then
         Draw_Annotation (Canvas, Cr, (X1 + X2) / 2, (Y1 + Y2) / 2, Link);
      end if;
   end Draw_Straight_Link;

   --------------------
   -- Draw_Self_Link --
   --------------------

   procedure Draw_Self_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Offset          : Gint;
      Show_Annotation : Boolean)
   is
      Right_Angle : constant Gdouble := Pi / 2.0;
      Src         : constant Canvas_Item := Canvas_Item (Get_Src (Link));
      X1, Y1, X3, Y3, Xc, Yc, Radius : Gint;

   begin
      pragma Assert (Src = Canvas_Item (Get_Dest (Link)));

      Xc := Src.Coord.X + Src.Coord.Width;
      Yc := Src.Coord.Y;

      if Src.Selected then
         Xc := Xc + Canvas.Offset_X_World;
         Yc := Yc + Canvas.Offset_Y_World;
      end if;

      Radius := Canvas.Arc_Link_Offset / 2 * Offset;

      --  Location of the arrow and the annotation
      X3 := Xc - Radius;
      Y3 := Yc;
      X1 := Xc;
      Y1 := Yc + Radius;

      Cairo.Move_To (Cr, Gdouble (X3), Gdouble (Y3));
      Cairo.Arc
        (Cr,
         Gdouble (Xc), Gdouble (Yc),
         Gdouble (Radius), Pi, Pi * 0.5);
      Cairo.Stroke (Cr);

      --  Draw the arrows

      if Link.Arrow /= No_Arrow then
         Draw_Arrow_Head (Canvas, Cr, X3, Y3, -Right_Angle);
      end if;

      if Link.Arrow = Both_Arrow then
         Draw_Arrow_Head (Canvas, Cr, X1, Y1, 0.0);
      end if;

      --  Draw the annotations
      if Link.Descr /= null and then Show_Annotation then
         Draw_Annotation
           (Canvas, Cr, Xc + Radius / 2, Yc + Radius / 2, Link);
      end if;
   end Draw_Self_Link;

   -------------------
   -- Draw_Arc_Link --
   -------------------

   procedure Draw_Arc_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Cr              : Cairo_Context;
      Link            : access Canvas_Link_Record'Class;
      Offset          : Gint;
      Show_Annotation : Boolean)
   is
      Angle       : Gdouble;
      X1, Y1, X2, Y2, X3, Y3 : Gint;
      Right_Angle : constant Gdouble := Pi / 2.0;
      Arc_Offset  : constant Gdouble := Gdouble (Canvas.Arc_Link_Offset);
      Src         : constant Canvas_Item := Canvas_Item (Get_Src (Link));
      Dest        : constant Canvas_Item := Canvas_Item (Get_Dest (Link));
      Src_Side, Dest_Side : Item_Side;

   begin
      if Src.Selected then
         X1 := Src.Coord.X + Canvas.Offset_X_World;
         Y1 := Src.Coord.Y + Canvas.Offset_Y_World;
      else
         X1 := Src.Coord.X;
         Y1 := Src.Coord.Y;
      end if;

      if Dest.Selected then
         X3 := Dest.Coord.X + Canvas.Offset_X_World;
         Y3 := Dest.Coord.Y + Canvas.Offset_Y_World;
      else
         X3 := Dest.Coord.X;
         Y3 := Dest.Coord.Y;
      end if;

      --  We will first compute the extra intermediate point between the
      --  center of the two items. Once we have this intermediate point, we
      --  will be able to use the intersection point between the two items
      --  and the two lines from the centers to the middle point. This extra
      --  point is used as a control point for the Bezier curve.

      X1 := X1 + Gint (Gfloat (Src.Coord.Width) * Link.Src_X_Pos);
      Y1 := Y1 + Gint (Gfloat (Src.Coord.Height) * Link.Src_Y_Pos);
      X3 := X3 + Gint (Gfloat (Dest.Coord.Width) * Link.Dest_X_Pos);
      Y3 := Y3 + Gint (Gfloat (Dest.Coord.Height) * Link.Dest_Y_Pos);

      --  Compute the middle point for the arc, and create a dummy item for it
      --  that the user can move.

      if X1 /= X3 then
         Angle := Arctan (Gdouble (Y3 - Y1), Gdouble (X3 - X1));
      elsif Y3 > Y1 then
         Angle := Right_Angle;
      else
         Angle := -Right_Angle;
      end if;

      if Offset < 0 then
         Angle := Angle - Right_Angle;
      else
         Angle := Angle + Right_Angle;
      end if;

      X2 := (X1 + X3) / 2 + abs (Offset) * Gint (Arc_Offset * Cos (Angle));
      Y2 := (Y1 + Y3) / 2 + abs (Offset) * Gint (Arc_Offset * Sin (Angle));

      --  Clip to the border of the boxes

      Clip_Line
        (Src, Canvas,
         X2, Y2, Link.Src_X_Pos, Link.Src_Y_Pos, Src_Side, X1, Y1);
      Clip_Line
        (Dest, Canvas, X2, Y2, Link.Dest_X_Pos, Link.Dest_Y_Pos,
         Dest_Side, X3, Y3);

      Cairo.Move_To (Cr, Gdouble (X1), Gdouble (Y1));
      Cairo.Curve_To
        (Cr, Gdouble (X1), Gdouble (Y1),
         Gdouble (X2), Gdouble (Y2),
         Gdouble (X3), Gdouble (Y3));
      Cairo.Stroke (Cr);

      --  Draw the arrows

      if Link.Arrow = End_Arrow or else Link.Arrow = Both_Arrow then
         if X3 /= X2 then
            Angle := Arctan (Gdouble (Y2 - Y3), Gdouble (X2 - X3));
         elsif Y3 > Y2 then
            Angle := Right_Angle;
         else
            Angle := -Right_Angle;
         end if;

         Draw_Arrow_Head (Canvas, Cr, X3, Y3, Angle);
      end if;

      if Link.Arrow = Start_Arrow or else Link.Arrow = Both_Arrow then
         if X1 /= X2 then
            Angle := Arctan (Gdouble (Y2 - Y1), Gdouble (X2 - X1));
         elsif Y2 > Y1 then
            Angle := Right_Angle;
         else
            Angle := -Right_Angle;
         end if;

         Draw_Arrow_Head (Canvas,  Cr, X1, Y1, Angle);
      end if;

      --  Draw the annotations, if any, in the middle of the link
      if Link.Descr /= null and then Show_Annotation then
         X2 := Gint (0.25 * Float (X1) + 0.5 * Float (X2) + 0.25 * Float (X3));
         Y2 := Gint (0.25 * Float (Y1) + 0.5 * Float (Y2) + 0.25 * Float (Y3));
         Draw_Annotation (Canvas, Cr, X2, Y2, Link);
      end if;
   end Draw_Arc_Link;

   ---------------
   -- Draw_Link --
   ---------------

   procedure Draw_Link
     (Canvas          : access Interactive_Canvas_Record'Class;
      Link            : access Canvas_Link_Record;
      Cr              : Cairo_Context;
      Edge_Number     : Gint;
      Show_Annotation : Boolean := True)
   is
   begin
      --  Self-referencing links
      if Get_Src (Link) = Get_Dest (Link) then
         Draw_Self_Link
           (Canvas, Cr, Link, Edge_Number, Show_Annotation);

      elsif Edge_Number = 1 then
         --  The first link in the list is always straight
         if Canvas.Orthogonal_Links then
            Draw_Orthogonal_Link (Canvas, Cr, Link, Show_Annotation);
         else
            Draw_Straight_Link (Canvas, Cr, Link, Show_Annotation);
         end if;

      elsif Edge_Number mod 2 = 1 then
         Draw_Arc_Link
           (Canvas, Cr, Link, Edge_Number / 2, Show_Annotation);

      else
         Draw_Arc_Link
           (Canvas, Cr, Link, -(Edge_Number / 2), Show_Annotation);

      end if;
   end Draw_Link;

   ------------------
   -- Update_Links --
   ------------------

   procedure Update_Links
     (Canvas         : access Interactive_Canvas_Record;
      Cr             : Cairo_Context;
      Invert_Mode    : Boolean;
      From_Selection : Boolean)
   is
      Current : Edge_Iterator := First (Canvas.Children);
      Count   : Natural := 0;
      L       : Canvas_Link;

   begin
      while not At_End (Current) loop
         L := Canvas_Link (Get (Current));
         if Is_Visible (Canvas_Item (Get_Src (L)))
           and then Is_Visible (Canvas_Item (Get_Dest (L)))
         then
            if not From_Selection
              or else Canvas_Item (Get_Src (L)).Selected
              or else Canvas_Item (Get_Dest (L)).Selected
            then
               Set_Line_Width (Cr, 1.0);
               Draw_Link
                 (Canvas, L, Cr,
                  Gint (Repeat_Count (Current)),
                  Show_Annotation => not Invert_Mode);
            end if;

            --  To save time, we limit the number of links that are drawn
            --  while moving items.
            Count := Count + 1;
            exit when From_Selection
              and then Count > Links_Threshold_While_Moving;
         end if;

         Next (Current);
      end loop;
   end Update_Links;

   ---------------
   -- Draw_Grid --
   ---------------

   procedure Draw_Grid
     (Canvas        : access Interactive_Canvas_Record;
      Cr            : Cairo_Context)
   is
      Grid    : Gint := Gint (Canvas.Grid_Size);
      Ptrn    : Cairo_Pattern;
      Surface : Cairo_Surface;
      Tmp_Cr  : Cairo_Context;

   begin
      if Grid = 0 then
         return;
      end if;

      while Gdouble (Grid) * Canvas.Zoom < 5.0 loop
         Grid := Grid * 2;
      end loop;

      --  First create a surface that will contain the pattern to duplicate
      Surface := Cairo.Surface.Create_Similar
        (Cairo.Get_Group_Target (Cr),
         Cairo_Content_Color_Alpha,
         Grid, Grid);

      --  We create a context from the surface
      Tmp_Cr := Cairo.Create (Surface);

      --  Copy the source color
      Set_Source (Tmp_Cr, Cairo.Get_Source (Cr));
      Cairo.Set_Line_Width (Tmp_Cr, 1.0);
      Cairo.Set_Line_Cap (Tmp_Cr, Cairo_Line_Cap_Round);

      --  Let's draw a single point on the surface
      Move_To (Tmp_Cr, 0.5, 0.5);
      Line_To (Tmp_Cr, 0.5, 0.5);
      Stroke (Tmp_Cr);
      Destroy (Tmp_Cr);

      --  Now that the surface is drawn, let's create a pattern from it
      Ptrn := Cairo.Pattern.Create_For_Surface (Surface);
      Cairo.Pattern.Set_Extend (Ptrn, Cairo_Extend_Repeat);

      --  And paint the background
      Cairo.Save (Cr);
      Cairo.Set_Source (Cr, Ptrn);
      Cairo.Paint_With_Alpha (Cr, 0.5);
      Cairo.Restore (Cr);

      Destroy (Ptrn);
      Destroy (Surface);
   end Draw_Grid;

   ---------------------
   -- Draw_Background --
   ---------------------

   procedure Draw_Background
     (Canvas : access Interactive_Canvas_Record;
      Cr     : Cairo_Context)
   is
   begin
      Cairo.Save (Cr);
      Set_Source_Color (Cr, Get_Bg (Get_Style (Canvas), State_Normal));
      Paint (Cr);
      Cairo.Restore (Cr);
   end Draw_Background;

   ----------------------
   -- Get_Bounding_Box --
   ----------------------

   procedure Get_Bounding_Box
     (Canvas : access Interactive_Canvas_Record'Class;
      Width  : out Gdouble;
      Height : out Gdouble)
   is
      X_Min, X_Max, Y_Min, Y_Max : Gdouble;
   begin
      Get_Bounding_Box (Canvas, X_Min, X_Max, Y_Min, Y_Max);
      Width := X_Max - X_Min + 40.0;
      Height := Y_Max - Y_Min + 40.0;
   end Get_Bounding_Box;

   --------------
   -- Draw_All --
   --------------

   procedure Draw_All
     (Canvas : access Interactive_Canvas_Record'Class;
      Cr     : Cairo_Context)
   is
      Area : Cairo_Rectangle_Int;
      X_Min, X_Max, Y_Min, Y_Max : Gdouble;
   begin
      Get_Bounding_Box (Canvas, X_Min, X_Max, Y_Min, Y_Max);
      Area :=
        (X      => Gint (X_Min - 20.0),
         Y      => Gint (Y_Min - 20.0),
         Width  => Gint (X_Max - X_Min + 40.0),
         Height => Gint (Y_Max - Y_Min + 40.0));
      Cairo.Translate (Cr, -X_Min + 20.0, -Y_Min + 20.0);

      Draw_Area (Canvas, Area, Cr);
   end Draw_All;

   ---------------
   -- Draw_Area --
   ---------------

   procedure Draw_Area
     (Canvas : access Interactive_Canvas_Record'Class;
      Rect   : Cairo_Rectangle_Int)
   is
      Cr     : Cairo_Context;
   begin
      if not Realized_Is_Set (Canvas) then
         return;
      end if;

      Cr := Create (Canvas);
      Draw_Area (Canvas, Rect, Cr);
      Destroy (Cr);
   end Draw_Area;

   ---------------
   -- Draw_Area --
   ---------------

   procedure Draw_Area
     (Canvas : access Interactive_Canvas_Record'Class;
      Rect   : Cairo_Rectangle_Int;
      Cr     : Cairo_Context)
   is
      Item   : Canvas_Item;
      Tmp    : Vertex_Iterator := First (Canvas.Children);
      Dest   : Cairo_Rectangle_Int;
      Inters : Boolean;

   begin
      --  If the GC was not created, do not do anything

      if not Realized_Is_Set (Canvas) then
         return;
      end if;

      --  Clear the canvas

      Draw_Background (Canvas, Cr);
      Draw_Grid (Canvas, Cr);

      --  Draw the links first, so that they appear to be below the items.
      --  ??? Should redraw only the required links

      declare
         OX : constant Gint := Canvas.Offset_X_World;
         OY : constant Gint := Canvas.Offset_Y_World;
      begin
         Canvas.Offset_X_World := 0;
         Canvas.Offset_Y_World := 0;

         Update_Links
           (Canvas,
            Cr,
            Invert_Mode    => False,
            From_Selection => False);

         --  Draw each of the items.

         while not At_End (Tmp) loop
            Item := Canvas_Item (Get (Tmp));

            if Item.Visible then
               Intersect
                 (Rect,
                  (Item.Coord.X,
                   Item.Coord.Y,
                   Item.Coord.Width,
                   Item.Coord.Height),
                  Dest, Inters);

               if Inters then
                  Cairo.Save (Cr);

                  --  Translate the coordinates to the item's coordinates
                  Cairo.Translate
                    (Cr, Gdouble (Item.Coord.X), Gdouble (Item.Coord.Y));

                  --  Clip to the item's area
                  Cairo.Rectangle
                    (Cr, 0.0, 0.0,
                     Gdouble (Item.Coord.Width),
                     Gdouble (Item.Coord.Height));
                  Clip (Cr);

                  if Item.Selected then
                     Draw_Selected (Item, Cr);
                  else
                     Draw (Item, Cr);
                  end if;

                  Cairo.Restore (Cr);
               end if;
            end if;

            Next (Tmp);
         end loop;

         Canvas.Offset_X_World := OX;
         Canvas.Offset_Y_World := OY;
      end;

      if Canvas.Offset_X_World /= 0
        or else Canvas.Offset_Y_World /= 0
      then
         Draw_Dashed_Selection (Canvas, Cr);
      end if;
   end Draw_Area;

   ------------
   -- Expose --
   ------------

   function Expose
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk.Event.Gdk_Event) return Boolean
   is
      Canvas : constant Interactive_Canvas := Interactive_Canvas (Canv);
      Rect   : Cairo_Rectangle_Int renames Get_Area (Event);
      X_W, Y_W : Gdouble;
   begin
      To_World_Coordinates
        (Canvas, Rect.X, Rect.Y, X_W, Y_W);

      Draw_Area
        (Canvas,
         (X      => Gint (X_W),
          Y      => Gint (Y_W),
          Width  => Gint (Gdouble (Rect.Width) / Canvas.Zoom),
          Height => Gint (Gdouble (Rect.Height) / Canvas.Zoom)));

      return False;
   end Expose;

   ---------------------
   -- Set_Screen_Size --
   ---------------------

   procedure Set_Screen_Size
     (Item          : access Canvas_Item_Record;
      Width, Height : Gint)
   is
      Old_W, Old_H : Gint;
   begin
      Old_W := Item.Coord.Width;
      Old_H := Item.Coord.Height;

      Item.Coord.Width  := Width;
      Item.Coord.Height := Height;

      if Item.Canvas /= null
        and then (Width /= Old_W or else Height /= Old_H)
      then
         Refresh_Canvas (Item.Canvas);
      end if;
   end Set_Screen_Size;

   -------------------
   -- Draw_Selected --
   -------------------

   procedure Draw_Selected
     (Item : access Canvas_Item_Record;
      Cr   : Cairo.Cairo_Context)
   is
      Sel : constant Gdk_Color :=
              Get_Bg (Get_Style (Item.Canvas), State_Selected);
      P   : Cairo_Pattern;

   begin
      --  Use an intermediate group to allow proper compositing
      Cairo.Push_Group (Cr);

      --  Draw the item
      Cairo.Save (Cr);
      Draw (Canvas_Item (Item), Cr);
      Cairo.Restore (Cr);

      Cairo.Set_Operator (Cr, Cairo_Operator_Atop);
      Cairo.Rectangle
        (Cr, 0.0, 0.0,
         Gdouble (Item.Coord.Width),
         Gdouble (Item.Coord.Height));

      Cairo.Set_Source_Rgba
        (Cr,
         Gdouble (Red (Sel)) / 65535.0,
         Gdouble (Green (Sel)) / 65535.0,
         Gdouble (Blue (Sel)) / 65535.0,
         0.5);

      Cairo.Fill (Cr);

      P := Cairo.Pop_Group (Cr);
      Set_Source (Cr, P);
      Paint (Cr);
   end Draw_Selected;

   ---------------
   -- Key_Press --
   ---------------

   function Key_Press
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean
   is
      Canvas    : constant Interactive_Canvas := Interactive_Canvas (Canv);
      Value     : constant Gdouble := Canvas.World_Y;
      Upper     : constant Gdouble := Get_Upper (Canvas.Vadj);
      Lower     : constant Gdouble := Get_Lower (Canvas.Vadj);
      Page_Incr : constant Gdouble := Scrolling_Amount_Max;
      Page_Size : constant Gdouble := Get_Page_Size (Canvas.Vadj);
      Step_Incr : constant Gdouble := Scrolling_Amount_Min;

   begin
      --  Note: we do not need to call Changed on the adjustments below, since
      --  we are only modifying the value, not the bounds.

      case Get_Key_Val (Event) is
         when GDK_Home =>
            Set_Value (Canvas.Vadj, Lower);
            return True;

         when GDK_End =>
            Set_Value (Canvas.Vadj, Upper - Page_Size);
            return True;

         when GDK_Page_Up =>
            if Value >= Lower + Page_Incr then
               Set_Value (Canvas.Vadj, Value - Page_Incr);
            else
               Set_Value (Canvas.Vadj, Lower);
            end if;
            return True;

         when GDK_Page_Down =>
            if Value + Page_Incr + Page_Size <= Upper then
               Set_Value (Canvas.Vadj, Value + Page_Incr);
            else
               Set_Value (Canvas.Vadj, Upper - Page_Size);
            end if;
            return True;

         when GDK_Up | GDK_KP_Up =>
            if Value - Step_Incr >= Lower then
               Set_Value (Canvas.Vadj, Value - Step_Incr);
            else
               Set_Value (Canvas.Vadj, Lower);
            end if;
            Gtk.Handlers.Emit_Stop_By_Name (Canvas, "key_press_event");
            return True;

         when GDK_Down | GDK_KP_Down =>
            if Value + Step_Incr + Page_Size <= Upper then
               Set_Value (Canvas.Vadj, Value + Step_Incr);
            else
               Set_Value (Canvas.Vadj, Upper - Page_Size);
            end if;
            Gtk.Handlers.Emit_Stop_By_Name (Canvas, "key_press_event");
            return True;

         when GDK_Left | GDK_KP_Left =>
            if Canvas.World_X -
              Get_Step_Increment (Canvas.Hadj) >=
                Get_Lower (Canvas.Hadj)
            then
               Set_Value (Canvas.Hadj,
                          Canvas.World_X
                          - Get_Step_Increment (Canvas.Hadj));
            else
               Set_Value (Canvas.Hadj,
                          Get_Lower (Canvas.Hadj));
            end if;
            Gtk.Handlers.Emit_Stop_By_Name (Canvas, "key_press_event");
            return True;

         when GDK_Right | GDK_KP_Right =>
            if Canvas.World_X +
              Get_Step_Increment (Canvas.Hadj) +
              Get_Page_Size (Canvas.Hadj) <=
                Get_Upper (Canvas.Hadj)
            then
               Set_Value (Canvas.Hadj,
                          Canvas.World_X +
                            Get_Step_Increment (Canvas.Hadj));
            else
               Set_Value (Canvas.Hadj,
                          Get_Upper (Canvas.Hadj) -
                            Get_Page_Size (Canvas.Hadj));
            end if;
            Gtk.Handlers.Emit_Stop_By_Name (Canvas, "key_press_event");
            return True;

         when others =>
            null;
      end case;

      return False;

   exception
      when others =>
         return False;
   end Key_Press;

   -------------------
   -- Point_In_Item --
   -------------------

   function Point_In_Item
     (Item : access Canvas_Item_Record;
      X, Y : Gint) return Boolean is
   begin
      return X >= Item.Coord.X
        and then X <= Item.Coord.X + Item.Coord.Width
        and then Y >= Item.Coord.Y
        and then Y <= Item.Coord.Y + Item.Coord.Height;
   end Point_In_Item;

   -------------------------
   -- Item_At_Coordinates --
   -------------------------

   function Item_At_Coordinates
     (Canvas : access Interactive_Canvas_Record;
      X, Y   : Glib.Gint) return Canvas_Item
   is
      Tmp    : Vertex_Iterator := First (Canvas.Children);
      Result : Canvas_Item := null;
      Item   : Canvas_Item;
   begin
      --  Keep the last item found, since this is the one on top.
      --  ??? Not the most efficient way to search, since we have to traverse
      --  the whole list every time.

      while not At_End (Tmp) loop
         Item := Canvas_Item (Get (Tmp));

         if Item.Visible and then Point_In_Item (Item, X, Y) then
            Result := Item;
         end if;

         Next (Tmp);
      end loop;

      return Result;
   end Item_At_Coordinates;

   -------------------------
   -- Item_At_Coordinates --
   -------------------------

   function Item_At_Coordinates
     (Canvas : access Interactive_Canvas_Record; Event : Gdk_Event)
      return Canvas_Item
   is
      X_World, Y_World : Gdouble;
      Item             : Canvas_Item;

   begin
      To_World_Coordinates (Canvas, Event, X_World, Y_World);
      Item := Item_At_Coordinates (Canvas, Gint (X_World), Gint (Y_World));
      return Item;
   end Item_At_Coordinates;

   -------------------------
   -- Item_At_Coordinates --
   -------------------------

   procedure Item_At_Coordinates
     (Canvas : access Interactive_Canvas_Record;
      Event  : Gdk.Event.Gdk_Event;
      Item   : out Canvas_Item;
      X, Y   : out Glib.Gint)
   is
      X_World, Y_World : Gdouble;

   begin
      To_World_Coordinates (Canvas, Event, X_World, Y_World);
      Item := Item_At_Coordinates (Canvas, Gint (X_World), Gint (Y_World));
      if Item /= null then
         X := Gint (X_World) - Item.Coord.X;
         Y := Gint (Y_World) - Item.Coord.Y;
      end if;
   end Item_At_Coordinates;

   --------------------
   -- Button_Pressed --
   --------------------

   function Button_Pressed
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean
   is
      Canvas  : constant Interactive_Canvas := Interactive_Canvas (Canv);
      Cursor  : Gdk.Cursor.Gdk_Cursor;
      Handled : Boolean;

   begin
      if Get_Window (Event) /= Get_Window (Canvas) then
         return False;
      end if;

      Grab_Focus (Canvas);
      Set_Flags (Canvas, Has_Focus);

      To_World_Coordinates
        (Canvas, Event, Canvas.World_X_At_Click, Canvas.World_Y_At_Click);

      --  Find the selected item.

      Canvas.Item_Press := Item_At_Coordinates (Canvas, Event);

      if Traces then
         if Canvas.Item_Press /= null then
            Put_Line ("Clicked on Item at world coordinates ("
                      & Gdouble'Image (Canvas.World_X_At_Click)
                      & Gdouble'Image (Canvas.World_Y_At_Click)
                      & ") item=("
                      & Gint'Image (Canvas.Item_Press.Coord.X)
                      & Gint'Image (Canvas.Item_Press.Coord.Y)
                      & Gint'Image (Canvas.Item_Press.Coord.Width)
                      & Gint'Image (Canvas.Item_Press.Coord.Height)
                      & ") mouse=" & Gint'Image (Gint (Get_X (Event)))
                      & Gint'Image (Gint (Get_Y (Event))));
         else
            Put_Line ("Clicked outside of item at world coordinates "
                      & Gdouble'Image (Canvas.World_X_At_Click)
                      & " " & Gdouble'Image (Canvas.World_Y_At_Click));
         end if;
      end if;

      --  Button press on the background: clear the selection
      if Canvas.Item_Press = null then
         if (Get_State (Event) and Default_Modifier_Mask) = 0 then
            Clear_Selection (Canvas);
         end if;

         Widget_Callback.Emit_By_Name (Canvas, "background_click", Event);
         Canvas.Background_Press := True;

      else
         Canvas.Background_Press := False;

         if (Get_State (Event) and Default_Modifier_Mask) /= 0 then
            if Is_Selected (Canvas, Canvas.Item_Press) then
               Remove_From_Selection (Canvas, Canvas.Item_Press);
            else
               Add_To_Selection (Canvas, Canvas.Item_Press);
            end if;
         else

            Clear_Selection (Canvas);

            Set_X
              (Event,
               Canvas.World_X_At_Click - Gdouble (Canvas.Item_Press.Coord.X));
            Set_Y
              (Event,
               Canvas.World_Y_At_Click - Gdouble (Canvas.Item_Press.Coord.Y));
            Handled := On_Button_Click (Canvas.Item_Press, Event);

            if not Handled then
               --  If not handled, then make it's a selection
               Add_To_Selection (Canvas, Canvas.Item_Press);
               Canvas.Item_Press := null;
            else
               return True;
            end if;
         end if;
      end if;

      --  Change the cursor to give visual feedback

      Gdk_New (Cursor, Fleur);
      Set_Cursor (Get_Window (Canvas), Cursor);
      Unref (Cursor);

      --  Initialize the move

      Canvas.Offset_X_World      := 0;
      Canvas.Offset_Y_World      := 0;
      Canvas.Mouse_Has_Moved     := False;
      Canvas.Surround_Box_Scroll := Scrolling_Amount_Min;

      --  Make sure that no other widget steals the events while we are
      --  moving an item.

      Grab_Add (Canvas);

      return False;

   exception
      when others =>
         return False;
   end Button_Pressed;

   -------------------
   -- Button_Motion --
   -------------------

   function Button_Motion
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean
   is
      Canvas             : constant Interactive_Canvas :=
                             Interactive_Canvas (Canv);
      X_Scroll, Y_Scroll : Gdouble;
      Dead               : Boolean;
      pragma Unreferenced (Dead);

   begin
      if Get_Window (Event) /= Get_Window (Canvas) then
         return False;
      end if;

      if Canvas.Item_Press /= null then
         declare
            New_X, New_Y : Gdouble;
         begin
            To_World_Coordinates (Canvas, Event, New_X, New_Y);
            Set_X (Event, New_X - Gdouble (Canvas.Item_Press.Coord.X));
            Set_Y (Event, New_Y - Gdouble (Canvas.Item_Press.Coord.Y));
         end;

         return On_Button_Click (Canvas.Item_Press, Event);
      end if;

      --  Are we in the scrolling box ? If yes, do not move the item
      --  directly, but establish the timeout callbacks that will take care
      --  of the scrolling

      Test_Scrolling_Box
        (Canvas            => Canvas,
         Mouse_X_In_Canvas => Gint (Get_X (Event)),
         Mouse_Y_In_Canvas => Gint (Get_Y (Event)),
         X_Scroll          => X_Scroll,
         Y_Scroll          => Y_Scroll);

      if X_Scroll /= 0.0 or else Y_Scroll /= 0.0 then
         if Canvas.Scrolling_Timeout_Id = 0 then
            if Traces then
               Put_Line ("Button_Motion, within the scrolling box,"
                         & " starting timeout");
            end if;
            Canvas.Scrolling_Timeout_Id := Canvas_Timeout.Timeout_Add
              (Timeout_Between_Scrolls, Scrolling_Timeout'Access, Canvas);
         end if;
         return False;
      end if;

      if Canvas.Scrolling_Timeout_Id /= 0 then
         if Traces then
            Put_Line ("Button_Motion, cancel timeout");
         end if;
         Remove (Canvas.Scrolling_Timeout_Id);
         Canvas.Surround_Box_Scroll := Scrolling_Amount_Min;
         Canvas.Scrolling_Timeout_Id := 0;
      end if;

      --  Find the current mouse position in world coordinates, to find out
      --  where to draw the dashed outline.

      To_World_Coordinates
        (Canvas, Event, X_Scroll, Y_Scroll);

      Dead := Move_Selection
        (Canvas,
         New_Offset_X_World => X_Scroll - Canvas.World_X_At_Click,
         New_Offset_Y_World => Y_Scroll - Canvas.World_Y_At_Click);

      return False;
   end Button_Motion;

   --------------------
   -- Button_Release --
   --------------------

   function Button_Release
     (Canv  : access Gtk_Widget_Record'Class;
      Event : Gdk_Event) return Boolean
   is
      Canvas       : constant Interactive_Canvas := Interactive_Canvas (Canv);
      Rect, Coord  : Gdk_Rectangle;
      Iter         : Item_Iterator;
      Item         : Canvas_Item;
      Handled      : Boolean;

   begin
      Grab_Remove (Canvas);

      --  Restore the standard cursor
      Set_Cursor (Get_Window (Canvas), null);

      if Get_Window (Event) /= Get_Window (Canvas) then
         return False;
      end if;

      if Canvas.Scrolling_Timeout_Id /= 0 then
         Remove (Canvas.Scrolling_Timeout_Id);
         Canvas.Scrolling_Timeout_Id := 0;
         Canvas.Surround_Box_Scroll := Scrolling_Amount_Min;
      end if;

      if Canvas.Item_Press /= null then

         --  Translate the button's coordinates
         declare
            New_X, New_Y : Gdouble;
         begin
            To_World_Coordinates (Canvas, Event, New_X, New_Y);
            Set_X (Event, New_X - Gdouble (Canvas.Item_Press.Coord.X));
            Set_Y (Event, New_Y - Gdouble (Canvas.Item_Press.Coord.Y));
         end;

         Handled := On_Button_Click (Canvas.Item_Press, Event);
         Canvas.Item_Press := null;

         return Handled;

      elsif Canvas.Selected_Count = 0
        and then Canvas.Background_Press
      then
         Widget_Callback.Emit_By_Name (Canvas, "background_click", Event);

         --  Select all the items inside the rectangle

         Rect := Get_Background_Selection_Rectangle (Canvas);

         Iter := Start (Canvas, Selected_Only => False);
         while Get (Iter) /= null loop
            Coord := Get_Coord (Get (Iter));

            --  Only items fully contained in the rectangle are selected
            if Rect.X <= Coord.X
              and then Coord.X + Coord.Width <= Rect.X + Rect.Width
              and then Rect.Y <= Coord.Y
              and then Coord.Y + Coord.Height <= Rect.Y + Rect.Height
            then
               Add_To_Selection (Canvas, Get (Iter));
            end if;

            Next (Iter);
         end loop;

         Canvas.Offset_X_World := 0;
         Canvas.Offset_Y_World := 0;

         Queue_Draw (Canvas);

         return True;

      elsif Canvas.Mouse_Has_Moved then
         Iter := Start (Canvas, Selected_Only => True);
         loop
            Item := Get (Iter);
            exit when Item = null;

            Item.Coord.X := Item.Coord.X + Canvas.Offset_X_World;
            Item.Coord.Y := Item.Coord.Y + Canvas.Offset_Y_World;

            if Canvas.Align_On_Grid then
               Item.Coord.X := Item.Coord.X
                 - Item.Coord.X mod Gint (Canvas.Grid_Size);
               Item.Coord.Y := Item.Coord.Y
                 - Item.Coord.Y mod Gint (Canvas.Grid_Size);
            end if;
            Item.From_Auto_Layout := False;

            Emit_By_Name_Item
              (Get_Object (Canvas), "item_moved" & ASCII.NUL, Item);

            Next (Iter);
         end loop;

         Canvas.Offset_X_World := 0;
         Canvas.Offset_Y_World := 0;

         --  Scroll the canvas so as to show the first item from the selection
         Refresh_Canvas (Canvas);

      end if;

      Canvas.Item_Press := null;

      return False;

   exception
      when others =>
         return False;
   end Button_Release;

   ----------------------------------------
   -- Get_Background_Selection_Rectangle --
   ----------------------------------------

   function Get_Background_Selection_Rectangle
     (Canvas : access Interactive_Canvas_Record'Class) return Gdk_Rectangle
   is
      X : Gint := Gint (Canvas.World_X_At_Click);
      Y : Gint := Gint (Canvas.World_Y_At_Click);
      W : Gint := Canvas.Offset_X_World;
      H : Gint := Canvas.Offset_Y_World;

   begin
      if W < 0 then
         W := -W;
         X := X - W;
      end if;

      if H < 0 then
         H := -H;
         Y := Y - H;
      end if;

      return (X, Y, W, H);
   end Get_Background_Selection_Rectangle;

   ------------------------
   -- Test_Scrolling_Box --
   ------------------------

   procedure Test_Scrolling_Box
     (Canvas   : access Interactive_Canvas_Record'Class;
      Mouse_X_In_Canvas, Mouse_Y_In_Canvas : Gint;
      X_Scroll : out Gdouble;
      Y_Scroll : out Gdouble)
   is
   begin
      if Mouse_X_In_Canvas < Scrolling_Margin then
         X_Scroll := -Canvas.Surround_Box_Scroll / Canvas.Zoom;
      elsif Mouse_X_In_Canvas >
        Gint (Get_Allocation_Width (Canvas)) - Scrolling_Margin
      then
         X_Scroll := Canvas.Surround_Box_Scroll / Canvas.Zoom;
      else
         X_Scroll := 0.0;
      end if;

      if Mouse_Y_In_Canvas < Scrolling_Margin then
         Y_Scroll := -Canvas.Surround_Box_Scroll / Canvas.Zoom;
      elsif Mouse_Y_In_Canvas >
        Gint (Get_Allocation_Height (Canvas)) - Scrolling_Margin
      then
         Y_Scroll := Canvas.Surround_Box_Scroll / Canvas.Zoom;
      else
         Y_Scroll := 0.0;
      end if;

      if Traces then
         Put_Line ("Test_Scrolling_Box, world delta="
                   & Gdouble'Image (X_Scroll) & " "
                   & Gdouble'Image (Y_Scroll)
                   & " mouse canvas="
                   & Gint'Image (Mouse_X_In_Canvas)
                   & Gint'Image (Mouse_Y_In_Canvas));
      end if;
   end Test_Scrolling_Box;

   -----------------------
   -- Scrolling_Timeout --
   -----------------------

   function Scrolling_Timeout (Canvas : Interactive_Canvas) return Boolean is
      Mouse_X_Canvas, Mouse_Y_Canvas : Gint;
      Mask                           : Gdk_Modifier_Type;
      W                              : Gdk_Window;
      X_Scroll, Y_Scroll             : Gdouble;
   begin
      if Traces then
         Put_Line ("Scrolling timeout");
      end if;

      Get_Pointer
        (Get_Window (Canvas), Mouse_X_Canvas, Mouse_Y_Canvas, Mask, W);
      Test_Scrolling_Box
        (Canvas, Mouse_X_Canvas, Mouse_Y_Canvas, X_Scroll, Y_Scroll);

      if (X_Scroll /= 0.0 or else Y_Scroll /= 0.0)
        and then Move_Selection
          (Canvas,
           New_Offset_X_World => X_Scroll + Gdouble (Canvas.Offset_X_World),
           New_Offset_Y_World => Y_Scroll + Gdouble (Canvas.Offset_Y_World))
      then
         --  Keep increasing the speed
         if Canvas.Surround_Box_Scroll < Scrolling_Amount_Max then
            Canvas.Surround_Box_Scroll := Canvas.Surround_Box_Scroll
              * Scrolling_Amount_Increase;
         end if;

         --  Force an immediate draw, since Queue_Draw would only redraw in
         --  an idle event, and thus might not happen before the next timeout.
         --  With lots of items, this would break the scrolling.
         Draw (Canvas);
         return True;
      else
         Canvas.Surround_Box_Scroll := Scrolling_Amount_Min;
         Canvas.Scrolling_Timeout_Id := 0;
         return False;
      end if;
   end Scrolling_Timeout;

   ---------------------------
   -- Draw_Dashed_Selection --
   ---------------------------

   procedure Draw_Dashed_Selection
     (Canvas : access Interactive_Canvas_Record'Class;
      Cr     : Cairo_Context)
   is
      Iter  : Item_Iterator;
      Item  : Canvas_Item;
      X, Y  : Gint;
      Rect  : Gdk_Rectangle;
      Sel   : constant Gdk_Color :=
                Get_Bg (Get_Style (Canvas), State_Selected);

   begin
      if Canvas.Selected_Count = 0 then
         Rect := Get_Background_Selection_Rectangle (Canvas);
         Rectangle
           (Cr,
            Gdouble (Rect.X) + 0.5,
            Gdouble (Rect.Y) + 0.5,
            Gdouble (Rect.Width) - 1.0,
            Gdouble (Rect.Height) - 1.0);

         Cairo.Set_Source_Rgba
           (Cr,
            Gdouble (Red (Sel)) / 65535.0,
            Gdouble (Green (Sel)) / 65535.0,
            Gdouble (Blue (Sel)) / 65535.0,
            0.3);
         Fill_Preserve (Cr);
         Set_Source_Color (Cr, Sel);
         Stroke (Cr);

      else
         Iter := Start (Canvas, Selected_Only => True);
         Cairo.Set_Operator (Cr, Cairo_Operator_Xor);
         Set_Source_Rgba
           (Cr,
            Gdouble (Red (Sel)) / 65535.0,
            Gdouble (Green (Sel)) / 65535.0,
            Gdouble (Blue (Sel)) / 65535.0,
            0.5);

         loop
            Item := Get (Iter);
            exit when Item = null;

            if Item.Visible then
               X := Item.Coord.X + Canvas.Offset_X_World;
               Y := Item.Coord.Y + Canvas.Offset_Y_World;

               if Canvas.Align_On_Grid then
                  X := X - X mod Gint (Canvas.Grid_Size);
                  Y := Y - Y mod Gint (Canvas.Grid_Size);
               end if;

               Rectangle
                 (Cr,
                  Gdouble (X) + 0.5,
                  Gdouble (Y) + 0.5,
                  Gdouble (Item.Coord.Width),
                  Gdouble (Item.Coord.Height));
               Cairo.Fill (Cr);
            end if;
            Next (Iter);
         end loop;

         Update_Links
           (Canvas, Cr, Invert_Mode => True, From_Selection => True);
      end if;
   end Draw_Dashed_Selection;

   --------------------
   -- Move_Selection --
   --------------------

   function Move_Selection
     (Canvas : access Interactive_Canvas_Record'Class;
      New_Offset_X_World, New_Offset_Y_World : Gdouble) return Boolean
   is
      Z : Gdouble renames Canvas.Zoom;
   begin
      if not Canvas.Mouse_Has_Moved then
         --  Is this a motion, or simply a selection ?

         if abs (New_Offset_X_World) <= Canvas.Motion_Threshold / Z
           and then abs (New_Offset_Y_World) <= Canvas.Motion_Threshold / Z
         then
            return False;
         end if;
      end if;

      Canvas.Mouse_Has_Moved := True;

      if Traces then
         Put_Line ("Move_Selection, delta world="
                   & Gdouble'Image (New_Offset_X_World)
                   & " " & Gdouble'Image (New_Offset_Y_World));
      end if;

      Canvas.Offset_X_World := Gint (New_Offset_X_World);
      Canvas.Offset_Y_World := Gint (New_Offset_Y_World);

      Update_Adjustments (Canvas, Clip_Value => False);

      Scroll_Canvas_To_Area
        (Canvas,
         Canvas.World_X_At_Click +
           Gdouble (Canvas.Offset_X_World - Scrolling_Margin),
         Canvas.World_Y_At_Click +
           Gdouble (Canvas.Offset_Y_World - Scrolling_Margin),
         Canvas.World_X_At_Click +
           Gdouble (Canvas.Offset_X_World + Scrolling_Margin),
         Canvas.World_Y_At_Click +
           Gdouble (Canvas.Offset_Y_World + Scrolling_Margin),
         Canvas_X => 2.0,
         Canvas_Y => 2.0,
         Ignore_If_Visible => True,
         Report_Adj_Changed => True);

      Queue_Draw (Canvas);

      return True;
   end Move_Selection;

   ------------------
   -- Item_Updated --
   ------------------

   procedure Item_Updated
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class)
   is
   begin
      if Item.Visible then
         Queue_Draw_Area
           (Canvas,
            Item.Coord.X,
            Item.Coord.Y,
            Item.Coord.Width,
            Item.Coord.Height);
      end if;
   end Item_Updated;

   ------------
   -- Remove --
   ------------

   procedure Remove
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) is
   begin
      Remove_From_Selection (Canvas, Item);
      Remove (Canvas.Children, Item);

      --  Have to redraw everything, since there might have been some
      --  links.
      --  ??? Note very efficient when removing several items.
      Refresh_Canvas (Canvas);
   end Remove;

   -----------
   -- Clear --
   -----------

   procedure Clear (Canvas : access Interactive_Canvas_Record) is
   begin
      Clear_Selection (Canvas);
      Clear (Canvas.Children);
      Refresh_Canvas (Canvas);
   end Clear;

   ---------------------
   -- On_Button_Click --
   ---------------------

   function On_Button_Click
     (Item  : access Canvas_Item_Record;
      Event : Gdk.Event.Gdk_Event_Button) return Boolean
   is
      pragma Unreferenced (Item, Event);
   begin
      return False;
   end On_Button_Click;

   ---------------
   -- Get_Coord --
   ---------------

   function Get_Coord
     (Item : access Canvas_Item_Record) return Gdk.Rectangle.Gdk_Rectangle is
   begin
      return Item.Coord;
   end Get_Coord;

   --------------
   -- Has_Link --
   --------------

   function Has_Link
     (Canvas   : access Interactive_Canvas_Record;
      From, To : access Canvas_Item_Record'Class;
      Name     : UTF8_String := "") return Boolean
   is
      Current   : Edge_Iterator := First
        (Canvas.Children,
         Src  => Vertex_Access (From),
         Dest => Vertex_Access (To),
         Directed => False);
      E         : Canvas_Link;
      Candidate : Boolean;
   begin
      --  We need to examine both links from FROM to TO and from TO to FROM,
      --  since the layout algorithm might sometimes transparently revert links
      --  to get an acyclic graph

      while not At_End (Current) loop
         E := Canvas_Link (Get (Current));
         if Get_Arrow_Type (E) = End_Arrow then
            Candidate := Get_Src (E) = Vertex_Access (From)
              and then Get_Dest (E) = Vertex_Access (To);
         elsif Get_Arrow_Type (E) = Start_Arrow then
            Candidate := Get_Src (E) = Vertex_Access (To)
              and then Get_Dest (E) = Vertex_Access (From);
         else
            Candidate := True;
         end if;

         if Candidate
           and then
             (Name = ""
              or else (Canvas_Link (Get (Current)).Descr /= null
                       and then Canvas_Link (Get (Current)).Descr.all = Name))
         then
            return True;
         end if;
         Next (Current);
      end loop;
      return False;
   end Has_Link;

   ----------------
   -- Lower_Item --
   ----------------

   procedure Lower_Item
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) is
   begin
      Move_To_Front (Canvas.Children, Item);

      --  Redraw just the part of the canvas that is impacted.
      Item_Updated (Canvas, Item);
   end Lower_Item;

   ----------------
   -- Raise_Item --
   ----------------

   procedure Raise_Item
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) is
   begin
      Move_To_Back (Canvas.Children, Item);

      --  Redraw just the part of the canvas that is impacted.
      Item_Updated (Canvas, Item);
   end Raise_Item;

   ---------------
   -- Is_On_Top --
   ---------------

   function Is_On_Top
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) return Boolean
   is
      Iter : Vertex_Iterator := First (Canvas.Children);
      Last : Canvas_Item := null;
   begin
      while not At_End (Iter) loop
         Last := Canvas_Item (Get (Iter));
         Next (Iter);
      end loop;
      return Last = Canvas_Item (Item);
   end Is_On_Top;

   ---------------
   -- Show_Item --
   ---------------

   procedure Show_Item
     (Canvas             : access Interactive_Canvas_Record'Class;
      Item               : access Canvas_Item_Record'Class;
      Canvas_X, Canvas_Y : Gdouble;
      Report_Adj_Changed : Boolean := True)
   is
   begin
      Scroll_Canvas_To_Item
        (Canvas, Item, Canvas_X, Canvas_Y, Report_Adj_Changed);
   end Show_Item;

   ----------------
   -- Align_Item --
   ----------------

   procedure Align_Item
     (Canvas  : access Interactive_Canvas_Record;
      Item    : access Canvas_Item_Record'Class;
      X_Align : Float := 0.5;
      Y_Align : Float := 0.5) is
   begin
      Show_Item (Canvas, Item, Gdouble (X_Align), Gdouble (Y_Align));
   end Align_Item;

   ---------------
   -- Show_Item --
   ---------------

   procedure Show_Item
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) is
   begin
      Show_Item (Canvas, Item, 0.5, 0.5);
   end Show_Item;

   -----------------------
   -- Get_Align_On_Grid --
   -----------------------

   function Get_Align_On_Grid
     (Canvas : access Interactive_Canvas_Record) return Boolean is
   begin
      return Canvas.Align_On_Grid;
   end Get_Align_On_Grid;

   --------------------
   -- Set_Visibility --
   --------------------

   procedure Set_Visibility
     (Item    : access Canvas_Item_Record;
      Visible : Boolean) is
   begin
      Item.Visible := Visible;
   end Set_Visibility;

   ----------------
   -- Is_Visible --
   ----------------

   function Is_Visible (Item : access Canvas_Item_Record) return Boolean is
   begin
      return Item.Visible;
   end Is_Visible;

   --------------------
   -- Refresh_Canvas --
   --------------------

   procedure Refresh_Canvas (Canvas : access Interactive_Canvas_Record) is
   begin
      Update_Adjustments (Canvas);
      Queue_Draw (Canvas);
   end Refresh_Canvas;

   ---------------------
   -- Clear_Selection --
   ---------------------

   procedure Clear_Selection (Canvas : access Interactive_Canvas_Record) is
      Iter : Item_Iterator := Start (Canvas, Selected_Only => True);
   begin
      while Get (Iter) /= null loop
         Remove_From_Selection (Canvas, Get (Iter));
         Next (Iter);
      end loop;
   end Clear_Selection;

   ----------------------
   -- Add_To_Selection --
   ----------------------

   procedure Add_To_Selection
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class)
   is
   begin
      if not Item.Selected then
         Canvas.Selected_Count := Canvas.Selected_Count + 1;
         Item.Selected := True;
         Selected (Item, Canvas, Is_Selected => True);
         Emit_By_Name_Item
           (Get_Object (Canvas), "item_selected" & ASCII.NUL, Item);
      end if;
   end Add_To_Selection;

   ---------------------------
   -- Remove_From_Selection --
   ---------------------------

   procedure Remove_From_Selection
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class)
   is
   begin
      if Item.Selected then
         Canvas.Selected_Count := Canvas.Selected_Count - 1;
         Item.Selected := False;
         if not Gtk.Object.In_Destruction_Is_Set (Canvas) then
            Selected (Item, Canvas, Is_Selected => False);
         end if;

         Emit_By_Name_Item
           (Get_Object (Canvas), "item_unselected" & ASCII.NUL, Item);
      end if;
   end Remove_From_Selection;

   ----------------
   -- Select_All --
   ----------------

   procedure Select_All (Canvas : access Interactive_Canvas_Record) is
      Iter : Item_Iterator := Start (Canvas, Selected_Only => False);
      Item : Canvas_Item;
   begin
      loop
         Item := Get (Iter);
         exit when Item = null;
         Add_To_Selection (Canvas, Item);
         Next (Iter);
      end loop;
   end Select_All;

   ---------------
   -- Configure --
   ---------------

   procedure Configure
     (Link   : access Canvas_Link_Record;
      Arrow  : Arrow_Type := End_Arrow;
      Descr  : UTF8_String := "") is
   begin
      Link.Arrow := Arrow;
      Free (Link.Descr);
      Link.Descr := new String'(Descr);
   end Configure;

   --------------
   -- Add_Link --
   --------------

   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  : UTF8_String := "") is
   begin
      Configure (Link, Arrow, Descr);
      Add_Edge (Canvas.Children, Link, Src, Dest);
   end Add_Link;

   -----------------
   -- Remove_Link --
   -----------------

   procedure Remove_Link
     (Canvas : access Interactive_Canvas_Record;
      Link   : access Canvas_Link_Record'Class) is
   begin
      Remove (Canvas.Children, Link);
   end Remove_Link;

   -------------------
   -- For_Each_Link --
   -------------------

   procedure For_Each_Link
     (Canvas  : access Interactive_Canvas_Record;
      Execute : Link_Processor;
      From, To : Canvas_Item := null)
   is
      Iter : Edge_Iterator := First
        (Canvas.Children, Vertex_Access (From), Vertex_Access (To));
      Link : Canvas_Link;
   begin
      while not At_End (Iter) loop
         Link := Canvas_Link (Get (Iter));
         Next (Iter);
         exit when not Execute (Canvas, Link);
      end loop;
   end For_Each_Link;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Link : in out Canvas_Link_Record) is
   begin
      Free (Link.Descr);
   end Destroy;

   procedure Destroy (Item : in out Canvas_Item_Record) is
      pragma Unreferenced (Item);
   begin
      null;
   end Destroy;

   ---------------
   -- Get_Descr --
   ---------------

   function Get_Descr (Link : access Canvas_Link_Record) return UTF8_String is
   begin
      if Link.Descr = null then
         return "";
      else
         return Link.Descr.all;
      end if;
   end Get_Descr;

   -----------------
   -- Set_Src_Pos --
   -----------------

   procedure Set_Src_Pos
     (Link : access Canvas_Link_Record; X_Pos, Y_Pos : Gfloat := 0.5) is
   begin
      Link.Src_X_Pos := X_Pos;
      Link.Src_Y_Pos := Y_Pos;
   end Set_Src_Pos;

   ------------------
   -- Set_Dest_Pos --
   ------------------

   procedure Set_Dest_Pos
     (Link : access Canvas_Link_Record; X_Pos, Y_Pos : Gfloat := 0.5) is
   begin
      Link.Dest_X_Pos := X_Pos;
      Link.Dest_Y_Pos := Y_Pos;
   end Set_Dest_Pos;

   ------------------
   -- Zoom_Timeout --
   ------------------

   function Zoom_Timeout (Canvas : Interactive_Canvas) return Boolean is
      Now : constant Ada.Calendar.Time := Ada.Calendar.Clock;
      Z   : Gdouble;
      dT  : Gdouble;
      use type Ada.Calendar.Time;

   begin
      if Canvas.Zoom_Start + Canvas.Zoom_Duration < Now then
         Zoom_Internal (Canvas, Canvas.Target_Zoom);
         return False;
      else
         dT := Gdouble (Now - Canvas.Zoom_Start);
         Z  := Canvas.Initial_Zoom +
           (Canvas.Target_Zoom - Canvas.Initial_Zoom) *
             dT / Gdouble (Canvas.Zoom_Duration);
         Zoom_Internal (Canvas, Z);

         return True;
      end if;
   end Zoom_Timeout;

   -------------------
   -- Zoom_Internal --
   -------------------

   procedure Zoom_Internal
     (Canvas : access Interactive_Canvas_Record'Class; Percent : Gdouble)
   is
   begin
      --  Display the proper area in the canvas
      --  When zooming out, we want to keep the old area centered into the
      --  new one.
      --  When zooming in, we want to keep the same center as before
      --  (reverse of zoom out)

      --  Apply the zoom
      Canvas.Zoom := Percent;
      Canvas.Freeze := True;
      --  Only update the page size, other values will be updated when
      --  centering the zoom area
      Update_Adjustments
        (Canvas,
         Min_Max      => False,
         Page_Size    => True,
         Clip_Value   => False,
         Send_Changed => False);

      --  Display the proper area in the canvas
      --  When zooming out, we want to keep the old area centered into the
      --  new one.
      --  When zooming in, we want to keep the same center as before
      --  (reverse of zoom out)
      Scroll_Canvas_To_Area
        (Canvas,
         Canvas.Zoom_X, Canvas.Zoom_Y, Canvas.Zoom_X, Canvas.Zoom_Y,
         Canvas_X => 0.5, Canvas_Y => 0.5,
         Ignore_If_Visible => False,
         Report_Adj_Changed => True);
      Canvas.Freeze := False;

      Queue_Draw (Canvas);

      Widget_Callback.Emit_By_Name (Canvas, "zoomed");
   end Zoom_Internal;

   ----------
   -- Zoom --
   ----------

   procedure Zoom
     (Canvas : access Interactive_Canvas_Record;
      Percent : Gdouble  := 1.0;
      Length  : Duration := 0.0)
   is
      Id : G_Source_Id;
      pragma Unreferenced (Id);
   begin
      if Canvas.Zoom = Percent then
         return;
      end if;
      Canvas.Target_Zoom := Percent;
      Canvas.Initial_Zoom := Canvas.Zoom;
      Canvas.Zoom_X :=
        Canvas.World_X +
        Gdouble (Get_Allocation_Width (Canvas)) / Canvas.Zoom / 2.0;
      Canvas.Zoom_Y :=
        Canvas.World_Y +
          Gdouble (Get_Allocation_Height (Canvas)) / Canvas.Zoom / 2.0;
      Canvas.Zoom_Start := Ada.Calendar.Clock;

      --  Do we want smooth scrolling ?
      if Length > 0.0 then
         Canvas.Zoom_Duration := Length;

         Id := Canvas_Timeout.Idle_Add
           (Zoom_Timeout'Access, Interactive_Canvas (Canvas));

      else
         Zoom_Internal (Canvas, Percent);
      end if;
   end Zoom;

   --------------
   -- Get_Zoom --
   --------------

   function Get_Zoom
     (Canvas : access Interactive_Canvas_Record) return Glib.Gdouble is
   begin
      return Canvas.Zoom;
   end Get_Zoom;

   --------------
   -- Scrolled --
   --------------

   procedure Scrolled (Canvas : access Gtk_Widget_Record'Class) is
      C : constant Interactive_Canvas := Interactive_Canvas (Canvas);
   begin
      C.World_X := Get_Value (C.Hadj);
      C.World_Y := Get_Value (C.Vadj);
      Queue_Draw (Canvas);
   end Scrolled;

   ----------
   -- Draw --
   ----------

   procedure Draw
     (Item : access Buffered_Item_Record;
      Cr   : Cairo.Cairo_Context) is
   begin
      Cairo.Set_Source_Surface (Cr, Item.Pixmap, 0.0, 0.0);
      Cairo.Rectangle
        (Cr, 0.0, 0.0,
         Gdouble (Item.Coord.Width), Gdouble (Item.Coord.Height));
      Cairo.Fill (Cr);

      if Status (Cr) /= Cairo_Status_Success then
         Put_Line ("??? Cannot draw buffered item: " &
                     Cairo_Status'Image (Status (Cr)));
      end if;
   end Draw;

   ---------------------
   -- Set_Screen_Size --
   ---------------------

   procedure Set_Screen_Size
     (Item   : access Buffered_Item_Record;
      Width, Height  : Glib.Gint)
   is
   begin
      if Item.Pixmap /= Null_Surface then
         Cairo.Surface.Destroy (Item.Pixmap);
      end if;

      --  Always pass a drawable, so that the colormap for Item.Pixmap is
      --  set correctly. Otherwise, on setups where colormaps are used we
      --  get a crash
      Item.Pixmap := Create (Cairo_Format_ARGB32, Width, Height);

      Set_Screen_Size (Canvas_Item_Record (Item.all)'Access, Width, Height);
   end Set_Screen_Size;

   -------------
   -- Destroy --
   -------------

   procedure Destroy (Item : in out Buffered_Item_Record) is
   begin
      if Item.Pixmap /= Null_Surface then
         Destroy (Item.Pixmap);
         Item.Pixmap := Null_Surface;
      end if;

      Destroy (Canvas_Item_Record (Item));
   end Destroy;

   -------------
   -- Surface --
   -------------

   function Surface (Item : access Buffered_Item_Record)
                    return Cairo_Surface is
   begin
      return Item.Pixmap;
   end Surface;

   --------------------
   -- Get_Arrow_Type --
   --------------------

   function Get_Arrow_Type
     (Link : access Canvas_Link_Record) return Arrow_Type is
   begin
      return Link.Arrow;
   end Get_Arrow_Type;

   --------------------------
   -- Set_Orthogonal_Links --
   --------------------------

   procedure Set_Orthogonal_Links
     (Canvas : access Interactive_Canvas_Record;
      Orthogonal : Boolean) is
   begin
      Canvas.Orthogonal_Links := Orthogonal;
   end Set_Orthogonal_Links;

   --------------------------
   -- Get_Orthogonal_Links --
   --------------------------

   function Get_Orthogonal_Links
     (Canvas : access Interactive_Canvas_Record) return Boolean is
   begin
      return Canvas.Orthogonal_Links;
   end Get_Orthogonal_Links;

   -------------------------
   -- Is_From_Auto_Layout --
   -------------------------

   function Is_From_Auto_Layout
     (Item : access Canvas_Item_Record) return Boolean is
   begin
      return Item.From_Auto_Layout;
   end Is_From_Auto_Layout;

   -----------------
   -- Is_Selected --
   -----------------

   function Is_Selected
     (Canvas : access Interactive_Canvas_Record;
      Item   : access Canvas_Item_Record'Class) return Boolean
   is
      pragma Unreferenced (Canvas);
   begin
      return Item.Selected;
   end Is_Selected;

   ------------
   -- Canvas --
   ------------

   function Canvas
     (Item : access Canvas_Item_Record) return Interactive_Canvas is
   begin
      return Item.Canvas;
   end Canvas;

   --------------
   -- Selected --
   --------------

   procedure Selected
     (Item        : access Canvas_Item_Record;
      Canvas      : access Interactive_Canvas_Record'Class;
      Is_Selected : Boolean)
   is
      pragma Unreferenced (Item, Is_Selected);
   begin
      Queue_Draw (Canvas);
   end Selected;

   -----------------
   -- Get_Src_Pos --
   -----------------

   procedure Get_Src_Pos
     (Link : access Canvas_Link_Record; X, Y : out Glib.Gfloat) is
   begin
      X := Link.Src_X_Pos;
      Y := Link.Src_Y_Pos;
   end Get_Src_Pos;

   ------------------
   -- Get_Dest_Pos --
   ------------------

   procedure Get_Dest_Pos
     (Link : access Canvas_Link_Record; X, Y : out Glib.Gfloat) is
   begin
      X := Link.Dest_X_Pos;
      Y := Link.Dest_Y_Pos;
   end Get_Dest_Pos;

   ---------------------
   -- Get_Arrow_Angle --
   ---------------------

   function Get_Arrow_Angle
     (Canvas : access Interactive_Canvas_Record'Class) return Gdouble is
   begin
      return Canvas.Arrow_Angle;
   end Get_Arrow_Angle;

   ----------------------
   -- Get_Arrow_Length --
   ----------------------

   function Get_Arrow_Length
     (Canvas : access Interactive_Canvas_Record'Class) return Glib.Gint is
   begin
      return Canvas.Arrow_Length;
   end Get_Arrow_Length;

end Gtkada.Canvas;