------------------------------------------------------------------------------
--                  GtkAda - Ada95 binding for Gtk+/Gnome                   --
--                                                                          --
--      Copyright (C) 1998-2000 E. Briot, J. Brobecker and A. Charlet       --
--                     Copyright (C) 1998-2022, AdaCore                     --
--                                                                          --
-- This library is free software;  you can redistribute it and/or modify it --
-- under terms of the  GNU General Public License  as published by the Free --
-- Software  Foundation;  either version 3,  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 MERCHAN- --
-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
--                                                                          --
-- As a special exception under Section 7 of GPL version 3, you are granted --
-- additional permissions described in the GCC Runtime Library Exception,   --
-- version 3.1, as published by the Free Software Foundation.               --
--                                                                          --
-- You should have received a copy of the GNU General Public License and    --
-- a copy of the GCC Runtime Library Exception along with this program;     --
-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
-- <http://www.gnu.org/licenses/>.                                          --
--                                                                          --
------------------------------------------------------------------------------

with Ada.Numerics;                       use Ada.Numerics;
with Ada.Numerics.Generic_Elementary_Functions;
with System;
with Ada.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 Gdk;                                use Gdk;
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.RGBA;                           use Gdk.RGBA;
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.Enums;                          use Gtk.Enums;
with Gtk.Handlers;
with Gtk.Main;
with Gtk.Widget;                         use Gtk.Widget;

with Gtkada.Bindings;                    use Gtkada.Bindings;
with Gtkada.Handlers;                    use Gtkada.Handlers;
with Interfaces.C.Strings;               use Interfaces.C.Strings;

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 System.Address;

   Traces : constant Boolean := False;

   Class_Record : Ada_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 Interfaces.C.Strings.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

   type Bounds_Modification_Mode is (Grow_Only, Clamp, Do_Not_Change);
   --  Grow_Only : the bounds of the canvas may grow but should not shrink
   --  Clamp : the bounds get adjusted to the current item requisitions
   --  Do_Not_Change: no modification is made to the bounds of the canvas

   -----------------
   -- 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 Ada.Unchecked_Deallocation (String, String_Access);

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

   function On_Draw
     (Canv  : access Gtk_Widget_Record'Class;
      Cr    : Cairo_Context) return Boolean;
   --  Handle the "draw" 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.

   function Canvas_To_World_Length
     (Self     : not null access Interactive_Canvas_Record'Class;
      Length_Canvas : Gdouble) return Gdouble;
   function Canvas_To_World_X
     (Self     : not null access Interactive_Canvas_Record'Class;
      X_Canvas : Gdouble) return Gdouble;
   function Canvas_To_World_Y
     (Self     : not null access Interactive_Canvas_Record'Class;
      Y_Canvas : Gdouble) return Gdouble;
   --  Convert from canvas coordinates to world coordinates.

   function World_To_Canvas_X
     (Self    : not null access Interactive_Canvas_Record'Class;
      X_World : Gdouble) return Gdouble;
   function World_To_Canvas_Length
     (Self    : not null access Interactive_Canvas_Record'Class;
      Length_World : Gdouble) return Gdouble;
   function World_To_Canvas_Y
     (Self    : not null access Interactive_Canvas_Record'Class;
      Y_World : Gdouble) return Gdouble;
   --  Converts from world coordinates to canvas coordinates

   procedure Mouse_To_World
     (Canvas  : access Interactive_Canvas_Record'Class;
      Event   : Gdk_Event;
      X_World : out Gdouble;
      Y_World : out Gdouble);
   --  Convert from mouse coordinates to world coordinates.

   function Get_Actual_Coordinates
     (Self : not null access Interactive_Canvas_Record'Class;
      Item : not null access Canvas_Item_Record'Class)
      return Cairo_Rectangle_Int;
   --  Return the actual world coordinate for an item (including an extra
   --  offset to add when we are dragging that item).

   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;
      Behavior     : Bounds_Modification_Mode := Clamp);
   --  Update the adjustments of the canvas.
   --  The bounds for the adjustments are automatically computed, given the
   --  list of items in it.

   procedure Draw_Arrow_Head
     (Canvas   : access Interactive_Canvas_Record'Class;
      Cr       : Cairo_Context;
      X_Canvas : Gdouble;
      Y_Canvas : Gdouble;
      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_Canvas : Gdouble;
      Y_Canvas : Gdouble;
      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);
   --  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 : Gdouble;
      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);
   --  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;
      Behavior : Bounds_Modification_Mode) 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);
   --  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.

   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);
   --  Scroll the canvas to the item. This function tries to scroll the canvas
   --  as little as possible, typically used when the item is moving out of the
   --  window.

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

   procedure Get_Visible_World
     (Canvas         : access Interactive_Canvas_Record'Class;
      X1, Y1, X2, Y2 : out Gdouble);
   --  Return the world area currently visible in the canvas

   procedure Set_Transform
     (Self    : not null access Interactive_Canvas_Record'Class;
      Cr      : Cairo_Context;
      X_World : Gdouble := Gdouble'First;
      Y_World : Gdouble := Gdouble'First);
   --  Set the transformation matrix for the current settings.
   --  If x and y are specified, all drawing coordinates from now on become
   --  relative to that position (convenient for drawing the same thing in
   --  various locations for instance: pass the location to Set_Transform).

   ----------------------------
   -- World_To_Canvas_Length --
   ----------------------------

   function World_To_Canvas_Length
     (Self    : not null access Interactive_Canvas_Record'Class;
      Length_World : Gdouble) return Gdouble is
   begin
      return Length_World * Self.Zoom;
   end World_To_Canvas_Length;

   ----------------------------
   -- Canvas_To_World_Length --
   ----------------------------

   function Canvas_To_World_Length
     (Self     : not null access Interactive_Canvas_Record'Class;
      Length_Canvas : Gdouble) return Gdouble is
   begin
      return Length_Canvas / Self.Zoom;
   end Canvas_To_World_Length;

   -----------------------
   -- World_To_Canvas_X --
   -----------------------

   function World_To_Canvas_X
     (Self    : not null access Interactive_Canvas_Record'Class;
      X_World : Gdouble) return Gdouble is
   begin
      return (X_World - Self.World_X) * Self.Zoom;
   end World_To_Canvas_X;

   -----------------------
   -- World_To_Canvas_Y --
   -----------------------

   function World_To_Canvas_Y
     (Self    : not null access Interactive_Canvas_Record'Class;
      Y_World : Gdouble) return Gdouble is
   begin
      return (Y_World - Self.World_Y) * Self.Zoom;
   end World_To_Canvas_Y;

   -----------------------
   -- Canvas_To_World_X --
   -----------------------

   function Canvas_To_World_X
     (Self     : not null access Interactive_Canvas_Record'Class;
      X_Canvas : Gdouble) return Gdouble is
   begin
      return X_Canvas / Self.Zoom + Self.World_X;
   end Canvas_To_World_X;

   -----------------------
   -- Canvas_To_World_Y --
   -----------------------

   function Canvas_To_World_Y
     (Self     : not null access Interactive_Canvas_Record'Class;
      Y_Canvas : Gdouble) return Gdouble is
   begin
      return Y_Canvas / Self.Zoom + Self.World_Y;
   end Canvas_To_World_Y;

   -------------------
   -- Set_Transform --
   -------------------

   procedure Set_Transform
     (Self    : not null access Interactive_Canvas_Record'Class;
      Cr      : Cairo_Context;
      X_World : Gdouble := Gdouble'First;
      Y_World : Gdouble := Gdouble'First)
   is
      M : aliased  Cairo_Matrix;
   begin
      M.Xx := Self.Zoom;
      M.Xy := 0.0;

      if X_World /= Gdouble'First then
         M.X0 := Self.World_To_Canvas_X (X_World);
      else
         M.X0 := -Self.Zoom * Self.World_X;
      end if;

      M.Yx := 0.0;
      M.Yy := Self.Zoom;

      if Y_World /= Gdouble'First then
         M.Y0 := Self.World_To_Canvas_Y (Y_World);
      else
         M.Y0 := -Self.Zoom * Self.World_Y;
      end if;

      Set_Matrix (Cr, M'Access);
   end Set_Transform;

   -----------------------
   -- Get_Visible_World --
   -----------------------

   procedure Get_Visible_World
     (Canvas         : access Interactive_Canvas_Record'Class;
      X1, Y1, X2, Y2 : out Gdouble)
   is
      X_Ignored, Y_Ignored : Gint;

      Hadj : constant Gtk_Adjustment := Canvas.Get_Hadjustment;
      Vadj : constant Gtk_Adjustment := Canvas.Get_Vadjustment;

      Window_Width, Window_Height : Gint;
      Canvas_Width, Canvas_Height : Guint;

      X_Ratio : Gdouble;
      Y_Ratio : Gdouble;

      Dest_X, Dest_Y : Gint;
      Result : Boolean;
   begin
      Translate_Coordinates
        (Canvas,
         Get_Parent (Canvas),
         0, 0, Dest_X, Dest_Y, Result);

      Get_Geometry
        (Canvas.Get_Window,
         X_Ignored, Y_Ignored,
         Window_Width, Window_Height);

      Canvas.Get_Size (Canvas_Width, Canvas_Height);

      X_Ratio := ((Hadj.Get_Upper - Hadj.Get_Page_Size) - Hadj.Get_Lower);

      if X_Ratio < 0.001 then
         X1 := Canvas.World_X;
      else
         X1 := Canvas.World_X +
           (Gdouble (Canvas_Width) - Gdouble (Window_Width))
           * Hadj.Get_Value / (X_Ratio * Canvas.Zoom);
      end if;

      Y_Ratio := ((Vadj.Get_Upper - Vadj.Get_Page_Size) - Vadj.Get_Lower);

      if Y_Ratio < 0.001 then
         Y1 := Canvas.World_Y;
      else
         Y1 := Canvas.World_Y
           + (Gdouble (Canvas_Height) - Gdouble (Window_Height))
              * Vadj.Get_Value / (Y_Ratio * Canvas.Zoom);
      end if;

      X2 := X1 + Gdouble (Window_Width) / Canvas.Zoom;
      Y2 := Y1 + Gdouble (Window_Height) / Canvas.Zoom;
   end Get_Visible_World;

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

   function Create
     (Canvas : access Interactive_Canvas_Record'Class) return Cairo_Context
   is
      Cr             : constant Cairo_Context := Create
        (Get_Bin_Window (Canvas));
   begin
      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;

   --------------------
   -- Mouse_To_World --
   --------------------

   procedure Mouse_To_World
     (Canvas  : access Interactive_Canvas_Record'Class;
      Event   : Gdk_Event;
      X_World : out Gdouble;
      Y_World : out Gdouble)
   is
      X, Y : Gdouble;
   begin
      Get_Coords (Event, X, Y);
      X_World := Canvas_To_World_X (Canvas, X);
      Y_World := Canvas_To_World_Y (Canvas, Y);
   end Mouse_To_World;

   ---------------------------
   -- 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
      Layout_Width, Layout_Height : Guint;
   begin
      X := Canvas.World_X;
      Y := Canvas.World_Y;
      Get_Size (Canvas, Layout_Width, Layout_Height);
      Width := Gdouble (Layout_Width) / Canvas.Zoom;
      Height := Gdouble (Layout_Height) / Canvas.Zoom;
   end Get_World_Coordinates;

   --------------
   -- Get_Type --
   --------------

   function Get_Type return Glib.GType 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.
   begin
      Initialize_Class_Record
        (Gtk.Layout.Get_Type, Class_Record,
         "GtkAdaCanvas", Signals, Signal_Parameters);
      return Class_Record.The_Type;
   end Get_Type;

   -------------
   -- 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
   begin
      G_New (Canvas, Gtkada.Canvas.Get_Type);

      Canvas.Offset_X_World := 0.0;
      Canvas.Offset_Y_World := 0.0;
      Canvas.World_X := 0.0;
      Canvas.World_Y := 0.0;
      Set_Directed (Canvas.Children, True);
      Canvas.Auto_Layout := Auto_Layout;

      Return_Callback.Connect
        (Canvas, Signal_Draw,
         Return_Callback.To_Marshaller (On_Draw'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, "destroy",
         Widget_Callback.To_Marshaller (Canvas_Destroyed'Access));

      Widget_Callback.Connect
        (Canvas, "notify::hadjustment", Set_Scroll_Adjustments'Access);

      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);
      Canvas.Set_Can_Focus (True);

      --  Configure with default values
      Configure (Canvas);
   end Initialize;

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

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

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

   function Get_Hadj
     (Canvas : access Interactive_Canvas_Record'Class) return Gtk_Adjustment is
   begin
      return Canvas.Get_Hadjustment;
   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);
   end Canvas_Destroyed;

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

   procedure Set_Scroll_Adjustments
     (Canvas : access Gtk_Widget_Record'Class)
   is
      Canv : constant Interactive_Canvas := Interactive_Canvas (Canvas);

   begin
      Scrolled (Canvas);

      Widget_Callback.Object_Connect
        (Canv.Get_Hadjustment, "value_changed",
         Widget_Callback.To_Marshaller (Scrolled'Access), Canv);
      Widget_Callback.Object_Connect
        (Canv.Get_Vadjustment, "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;
      Background       : Gdk.RGBA.Gdk_RGBA := Gdk.RGBA.White_RGBA) 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;
      Canvas.Background_Color := Background;
   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.0
                   or else Canvas.Offset_Y_World /= 0.0)
                 and then Item.Selected
               then
                  X_Min := Gdouble'Min
                    (X_Min, Gdouble (Item.Coord.X + Item.Coord.Width) +
                         Canvas.Offset_X_World);
                  X_Max := Gdouble'Max
                    (X_Max, Gdouble (Item.Coord.X) + Canvas.Offset_X_World);
                  Y_Min := Gdouble'Min
                    (Y_Min, Gdouble (Item.Coord.Y + Item.Coord.Height) +
                         Canvas.Offset_Y_World);
                  Y_Max := Gdouble'Max
                    (Y_Max, Gdouble (Item.Coord.Y) + Canvas.Offset_Y_World);
               end if;
            end if;

            Next (Current);
         end loop;

         if X_Min = Gdouble'Last then
            --  This can happen if there is no visible item:
            --  in this case, return a box of size 0.
            X_Min := 0.0;
            X_Max := 0.0;
            Y_Min := 0.0;
            Y_Max := 0.0;
         end if;

      end if;
   end Get_Bounding_Box;

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

   procedure Update_Adjustments
     (Canvas   : access Interactive_Canvas_Record'Class;
      Behavior : Bounds_Modification_Mode := Clamp)
   is
      X_Max, Y_Max, X_Min, Y_Min : Gdouble;

   begin
      --  If the canvas was properly initialized
      if Get_Realized (Canvas)
        and then Get_Allocated_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;

         case Behavior is
            when Do_Not_Change =>
               null;

            when Grow_Only =>
               Canvas.World_X := Gdouble'Min (Canvas.World_X, X_Min);
               Canvas.World_Y := Gdouble'Min (Canvas.World_Y, Y_Min);

               declare
                  Width, Height : Guint;
               begin
                  Canvas.Get_Size (Width, Height);
                  Canvas.Set_Size
                    (Guint'Max
                       (Guint ((X_Max - X_Min) * Canvas.Zoom),
                        Width),
                     Guint'Max
                       (Guint ((Y_Max - Y_Min) * Canvas.Zoom),
                        Height));
               end;

            when Clamp =>
               Canvas.World_X := X_Min;
               Canvas.World_Y := Y_Min;

               Canvas.Set_Size
                 (Guint ((X_Max - X_Min) * Canvas.Zoom),
                  Guint ((Y_Max - Y_Min) * Canvas.Zoom));
         end case;
      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, Y3 : 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));
            while not At_End (Links) loop
               Src_Item := Canvas_Item (Get_Dest (Get (Links)));
               exit when Src_Item /= Item;
               Src_Item := null;
               Next (Links);
            end loop;

            if Src_Item = null then
               Links := First (Canvas.Children, Dest => Vertex_Access (Item));
               while not At_End (Links) loop
                  Src_Item := Canvas_Item (Get_Src (Get (Links)));
                  exit when Src_Item /= Item;
                  Src_Item := null;
                  Next (Links);
               end loop;
            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
                  X1 := Src_Item.Coord.X + Src_Item.Coord.Width + Step;
                  Y3 := Src_Item.Coord.Y;

                  loop
                     case Num mod 3 is
                        when 0 =>
                           Y1 := Y3;
                        when 1 =>
                           Y1 := Y3 - Step - Item.Coord.Height;
                        when 2 =>
                           Y1 := Y3 + Step + Item.Coord.Height;
                        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
                        X1 := X1 + 2 * Step;
                     end if;
                  end loop;

               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;
               end if;

            else
               --  Else put the item in the first line, at the first possible
               --  location
               X1 := Gint (Get_Lower (Canvas.Get_Hadjustment)) + Step;
               Y1 := Gint (Get_Lower (Canvas.Get_Vadjustment)) + 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;
            end if;

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

            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 Algorithm /= 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;
   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;

   ----------------------------
   -- Get_Actual_Coordinates --
   ----------------------------

   function Get_Actual_Coordinates
     (Self : not null access Interactive_Canvas_Record'Class;
      Item : not null access Canvas_Item_Record'Class)
      return Cairo_Rectangle_Int
   is
      C : Cairo_Rectangle_Int;
   begin
      --  During a move, the items that are moved must be moved by the extra
      --  offset moved by the mouse. This extra offset is set to 0 when not
      --  moving items, so it is safe to add.
      if Item.Selected then
         C := (Item.Coord.X + Gint (Self.Offset_X_World),
               Item.Coord.Y + Gint (Self.Offset_Y_World),
               Item.Coord.Width,
               Item.Coord.Height);

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

         return C;
      else
         return Item.Coord;
      end if;
   end Get_Actual_Coordinates;

   ---------------
   -- 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    : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Src);
      Src_X   : Gint;
      Src_Y   : Gint;
      Delta_X : Gint;
      Delta_Y : Gint;
      Offset  : Gint;
   begin
      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_Canvas : Gdouble;
      Y_Canvas : Gdouble;
      Angle    : Gdouble)
   is
      Length : constant Gdouble := Gdouble (Canvas.Arrow_Length);
   begin
      Move_To (Cr, X_Canvas, Y_Canvas);
      Line_To
        (Cr,
         X_Canvas + Length * Cos (Angle + Canvas.Arrow_Angle),
         Y_Canvas + Length * Sin (Angle + Canvas.Arrow_Angle));
      Line_To
        (Cr,
         X_Canvas + Length * Cos (Angle - Canvas.Arrow_Angle),
         Y_Canvas + 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_Canvas : Gdouble;
      Y_Canvas : Gdouble;
      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_RGBA (Cr, (0.0, 0.0, 0.0, 0.0));
         Cairo.Set_Line_Width (Cr, 1.0);
         Cairo.Rectangle
           (Cr,
            X_Canvas - 0.5,
            Y_Canvas - 0.5,
            Gdouble (W) + 1.0,
            Gdouble (H) + 1.0);
         Cairo.Fill (Cr);
         Cairo.Restore (Cr);

         Cairo.Move_To (Cr, X_Canvas, Y_Canvas);
         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 Ada.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)
   is
      World : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Item);
   begin
      --  If no size was allocated yet, memorize the item for later (see
      --  the callback for size_allocate)

      if Get_Allocated_Width (Canvas) = 1
        or else Get_Allocated_Height (Canvas) = 1
      then
         Canvas.Show_Item     := Canvas_Item (Item);
         Canvas.Show_Canvas_X := Canvas_X;
         Canvas.Show_Canvas_Y := Canvas_Y;
      else
         Scroll_Canvas_To_Area
           (Canvas,
            Gdouble (World.X),
            Gdouble (World.Y),
            Gdouble (World.X + World.Width),
            Gdouble (World.Y + World.Height));
      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)
   is
      pragma Unreferenced (Canvas_Y, Canvas_X);
      X_Ignored, Y_Ignored : Gint;
      Window_Width, Window_Height : Gint;

      Canvas_Width, Canvas_Height : Guint;
      Percent_X, Percent_Y        : Gdouble;

      Hadj : constant Gtk_Adjustment := Canvas.Get_Hadjustment;
      Vadj : constant Gtk_Adjustment := Canvas.Get_Vadjustment;

      X1_Visible, Y1_Visible, X2_Visible, Y2_Visible : Gdouble;

      Target_X, Target_Y : Gdouble;
   begin
      Canvas.Get_Visible_World
        (X1_Visible, Y1_Visible, X2_Visible, Y2_Visible);

      Get_Geometry
        (Canvas.Get_Window,
         X_Ignored, Y_Ignored,
         Window_Width, Window_Height);

      Canvas.Get_Size (Canvas_Width, Canvas_Height);

      if X1 < X1_Visible
        or else X2 > X2_Visible
      then
         if X1 < X1_Visible then
            Target_X := X1;
         else
            Target_X := X1_Visible + X2 - X2_Visible;
         end if;

         Percent_X := (Target_X - Canvas.World_X) /
           (Gdouble (Gint (Canvas_Width)) - Gdouble (Window_Width));

         Set_Value
           (Hadj,
            ((Hadj.Get_Upper - Hadj.Get_Page_Size) - Hadj.Get_Lower)
            * Percent_X * Canvas.Zoom);
      end if;

      if Y1 < Y1_Visible
        or else Y2 > Y2_Visible
      then
         if Y1 < Y1_Visible then
            Target_Y := Y1;
         else
            Target_Y := Y1_Visible + Y2 - Y2_Visible;
         end if;

         Percent_Y := (Target_Y - Canvas.World_Y) /
           (Gdouble (Gint (Canvas_Height)) - Gdouble (Window_Height));

         Set_Value
           (Vadj,
            ((Vadj.Get_Upper - Vadj.Get_Page_Size) - Vadj.Get_Lower)
            * Percent_Y * Canvas.Zoom);
      end if;
   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;
      X1_Canvas, Xc1_Canvas, Xc2_Canvas : Gdouble;
      X3_Canvas, Yp1_Canvas : Gdouble;
      Xp1_Canvas, Y2_Canvas, Y3_Canvas, Y1_Canvas : Gdouble;
      Yc1_Canvas, Yc2_Canvas, Yp2_Canvas : Gdouble;
      X2_Canvas, Xp2_Canvas : Gdouble;
      Xc1, Xc2, Yc1, Yc2 : Gint;
      Xarr_End, Yarr_End, Xarr_Start, Yarr_Start : Gdouble;
      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);

      Src_World : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Src);
      Dest_World : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Dest);

   begin
      X1 := Src_World.X;
      Y1 := Src_World.Y;
      X2 := Dest_World.X;
      Y2 := Dest_World.Y;

      Xp1 := X1 + Src.Coord.Width;
      Yp1 := Y1 + Src.Coord.Height;
      Xp2 := X2 + Dest_World.Width;
      Yp2 := Y2 + Dest_World.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;

      X1_Canvas := World_To_Canvas_X (Canvas, Gdouble (X1));
      X2_Canvas := World_To_Canvas_X (Canvas, Gdouble (X2));
      Xc1_Canvas := World_To_Canvas_X (Canvas, Gdouble (Xc1));
      Xp1_Canvas := World_To_Canvas_X (Canvas, Gdouble (Xp1));
      Xc2_Canvas := World_To_Canvas_X (Canvas, Gdouble (Xc2));
      Xp2_Canvas := World_To_Canvas_X (Canvas, Gdouble (Xp2));

      Y1_Canvas  := World_To_Canvas_Y (Canvas, Gdouble (Y1));
      Y2_Canvas  := World_To_Canvas_Y (Canvas, Gdouble (Y2));
      Yp1_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Yp1));
      Yp2_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Yp2));
      Yc1_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Yc1));
      Yc2_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Yc2));

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

         Yarr_Start := Yc1_Canvas;
         Yarr_End := Yc2_Canvas;

         X3_Canvas := World_To_Canvas_X (Canvas, Gdouble (X3));

         if X3 >= Xp1 then
            Cairo.Move_To (Cr, Xp1_Canvas, Yc1_Canvas + 0.5);
            Line_To (Cr, X3_Canvas + 0.5,  Yc1_Canvas + 0.5);
            Line_To (Cr, X3_Canvas + 0.5,  Yc2_Canvas + 0.5);
            Line_To (Cr, X2_Canvas,        Yc2_Canvas + 0.5);
            Cairo.Stroke (Cr);

            Xarr_Start := Xp1_Canvas;
            Xarr_End := X2_Canvas;
            Angle_Arr_Start := 0.0;
            Angle_Arr_End := -Ada.Numerics.Pi;
         else
            Move_To (Cr, X1_Canvas,       Yc1_Canvas + 0.5);
            Line_To (Cr, X3_Canvas + 0.5, Yc1_Canvas + 0.5);
            Line_To (Cr, X3_Canvas + 0.5, Yc2_Canvas + 0.5);
            Line_To (Cr, Xp2_Canvas,      Yc2_Canvas + 0.5);
            Cairo.Stroke (Cr);

            Xarr_Start := X1_Canvas;
            Xarr_End := Xp2_Canvas;
            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;

         Y3_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Y3));

         Xarr_Start := Xc1_Canvas;
         Xarr_End := Xc2_Canvas;
         X3_Canvas := (Xc1_Canvas + Xc2_Canvas) / 2.0;

         if Y2 > Y3 then
            Move_To (Cr, Xc1_Canvas, Yp1_Canvas);
            Line_To (Cr, Xc1_Canvas, Y3_Canvas);
            Line_To (Cr, Xc2_Canvas, Y3_Canvas);
            Line_To (Cr, Xc2_Canvas, Y2_Canvas);
            Cairo.Stroke (Cr);

            Yarr_Start := Yp1_Canvas;
            Yarr_End := Y2_Canvas;
            Angle_Arr_End := -Ada.Numerics.Pi / 2.0;
            Angle_Arr_Start := Ada.Numerics.Pi / 2.0;

         else
            Move_To (Cr, Xc1_Canvas, Y1_Canvas);
            Line_To (Cr, Xc1_Canvas, Y3_Canvas);
            Line_To (Cr, Xc2_Canvas, Y3_Canvas);
            Line_To (Cr, Xc2_Canvas, Yp2_Canvas);
            Cairo.Stroke (Cr);

            Yarr_Start := Y1_Canvas;
            Yarr_End := Yp2_Canvas;
            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_Canvas, (Y1_Canvas + Y2_Canvas) / 2.0, 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;
      X1_Canvas, Y1_Canvas, X2_Canvas, Y2_Canvas : Gdouble;
      Src   : constant Canvas_Item := Canvas_Item (Get_Src (Link));
      Dest  : constant Canvas_Item := Canvas_Item (Get_Dest (Link));
      Src_Side, Dest_Side : Item_Side;

      Src_Coord : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Src);
      Dest_Coord : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Dest);

   begin
      Xs := Src_Coord.X;
      Ys := Src_Coord.Y;
      Xd := Dest_Coord.X;
      Yd := Dest_Coord.Y;

      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);

      X1_Canvas := World_To_Canvas_X (Canvas, Gdouble (X1));
      Y1_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Y1));
      X2_Canvas := World_To_Canvas_X (Canvas, Gdouble (X2));
      Y2_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Y2));

      Draw_Straight_Line
        (Link, Cr, Src_Side,
         X1_Canvas, Y1_Canvas,
         Dest_Side,
         X2_Canvas, Y2_Canvas);

      --  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_Canvas, Y2_Canvas,
               Arctan (Y1_Canvas - Y2_Canvas, X1_Canvas - X2_Canvas));
         elsif Y1 > Y2 then
            Draw_Arrow_Head
              (Canvas, Cr, X2_Canvas, Y2_Canvas, Pi / 2.0);
         else
            Draw_Arrow_Head
              (Canvas, Cr, X2_Canvas, Y2_Canvas, -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_Canvas, Y1_Canvas,
               Arctan (Y2_Canvas - Y1_Canvas, X2_Canvas - X1_Canvas));
         elsif Y1 > Y2 then
            Draw_Arrow_Head (Canvas, Cr, X1_Canvas, Y1_Canvas, -Pi / 2.0);
         else
            Draw_Arrow_Head (Canvas, Cr, X1_Canvas, Y1_Canvas, 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_Canvas + X2_Canvas) / 2.0,
            (Y1_Canvas + Y2_Canvas) / 2.0, 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));
      Xc, Yc : Gdouble;
      X1, Y1, X3, Y3, Xc_Canvas, Yc_Canvas, Radius : Gdouble;
      Src_World : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Src);

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

      Xc := Gdouble (Src_World.X + Src_World.Width);
      Yc := Gdouble (Src_World.Y);

      Radius := World_To_Canvas_Length
        (Canvas, Gdouble (Canvas.Arc_Link_Offset / 2 * Offset));

      --  Location of the arrow and the annotation
      Xc_Canvas := World_To_Canvas_X (Canvas, Xc);
      Yc_Canvas := World_To_Canvas_Y (Canvas, Yc);
      X3 := Xc_Canvas - Radius;
      Y3 := Yc_Canvas;
      X1 := Xc_Canvas;
      Y1 := Yc_Canvas + Radius;

      Cairo.Move_To (Cr, X3, Y3);
      Cairo.Arc (Cr, Xc_Canvas, Yc_Canvas, 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_Canvas + Radius / 2.0, Yc_Canvas + Radius / 2.0, 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;
      X1_Canvas, Y1_Canvas, X2_Canvas, Y2_Canvas : Gdouble;
      X3_Canvas, Y3_Canvas : Gdouble;
      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;

      Src_World : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Src);
      Dest_World : constant Cairo_Rectangle_Int :=
        Get_Actual_Coordinates (Canvas, Dest);

   begin
      X1 := Src_World.X;
      Y1 := Src_World.Y;
      X3 := Dest_World.X;
      Y3 := Dest_World.Y;

      --  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);

      X1_Canvas := World_To_Canvas_X (Canvas, Gdouble (X1));
      Y1_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Y1));
      X2_Canvas := World_To_Canvas_X (Canvas, Gdouble (X2));
      Y2_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Y2));
      X3_Canvas := World_To_Canvas_X (Canvas, Gdouble (X3));
      Y3_Canvas := World_To_Canvas_Y (Canvas, Gdouble (Y3));

      Cairo.Move_To (Cr, X1_Canvas, Y1_Canvas);
      Cairo.Curve_To
        (Cr, X1_Canvas, Y1_Canvas,
         X2_Canvas, Y2_Canvas,
         X3_Canvas, Y3_Canvas);
      Cairo.Stroke (Cr);

      --  Draw the arrows

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

         Draw_Arrow_Head (Canvas, Cr, X3_Canvas, Y3_Canvas, Angle);
      end if;

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

         Draw_Arrow_Head (Canvas,  Cr, X1_Canvas, Y1_Canvas, Angle);
      end if;

      --  Draw the annotations, if any, in the middle of the link
      if Link.Descr /= null and then Show_Annotation then
         X2_Canvas := 0.25 * X1_Canvas + 0.5 * X2_Canvas + 0.25 * X3_Canvas;
         Y2_Canvas := 0.25 * Y1_Canvas + 0.5 * Y2_Canvas + 0.25 * Y3_Canvas;
         Draw_Annotation (Canvas, Cr, X2_Canvas, Y2_Canvas, 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
      Set_Line_Width (Cr, 1.0);

      --  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));

         --  We need to draw all links, since they might traverse the visible
         --  area, even though both end items are not visible in this area.

         if Canvas_Item (Get_Src (L)).Visible
            and then Canvas_Item (Get_Dest (L)).Visible
            and then
               (not From_Selection
                or else Canvas_Item (Get_Src (L)).Selected
                or else Canvas_Item (Get_Dest (L)).Selected)
         then
            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;

         Next (Current);
      end loop;
   end Update_Links;

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

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

   begin
      if Grid < 1.0 then
         return;
      end if;

      --  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,
         Gint (Grid), Gint (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_RGBA (Cr, Canvas.Background_Color);
      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));
      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 Get_Realized (Canvas) then
         return;
      end if;

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

   -------------
   -- Refresh --
   -------------

   procedure Refresh
     (Self : not null access Interactive_Canvas_Record;
      Item : access Canvas_Item_Record'Class := null)
   is
      Cr : Cairo_Context;
   begin
      if Item = null then
         Refresh_Canvas (Self);
      else
         if Item.Visible then
            Cr := Create (Self);

            begin
               Set_Transform
                 (Self, 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;

            exception
               when E : others =>
                  Gtkada.Bindings.Process_Exception (E);
            end;

            Destroy (Cr);
         end if;
      end if;
   end Refresh;

   ---------------
   -- 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
      --  Clear the canvas

      Cairo.Save (Cr);
      Cairo.Rectangle
        (Cr,
         World_To_Canvas_X (Canvas, Gdouble (Rect.X)),
         World_To_Canvas_Y (Canvas, Gdouble (Rect.Y)),
         World_To_Canvas_Length (Canvas, Gdouble (Rect.Width)),
         World_To_Canvas_Length (Canvas, Gdouble (Rect.Height)));
      Clip (Cr);
      Draw_Background (Canvas, Cr);
      Draw_Grid (Canvas, Cr);
      Cairo.Restore (Cr);

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

      declare
         OX : constant Gdouble := Canvas.Offset_X_World;
         OY : constant Gdouble := Canvas.Offset_Y_World;
      begin
         Canvas.Offset_X_World := 0.0;
         Canvas.Offset_Y_World := 0.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);

                  begin
                     Set_Transform
                       (Canvas, 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;

                  exception
                     when E : others =>
                        Gtkada.Bindings.Process_Exception (E);
                  end;

                  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.0
        or else Canvas.Offset_Y_World /= 0.0
      then
         Draw_Dashed_Selection (Canvas, Cr);
      end if;
   end Draw_Area;

   -------------
   -- On_Draw --
   -------------

   function On_Draw
     (Canv  : access Gtk_Widget_Record'Class;
      Cr    : Cairo_Context) return Boolean
   is
      pragma Unreferenced (Cr);
      Canvas : constant Interactive_Canvas := Interactive_Canvas (Canv);
      X1, X2, Y1, Y2 : Gdouble;
   begin
      Get_Visible_World (Canvas, X1, Y1, X2, Y2);

      if X1 >= Gdouble (Gint'First)
        and then X1 <= Gdouble (Gint'Last)
        and then Y1 >= Gdouble (Gint'First)
        and then Y1 <= Gdouble (Gint'Last)
      then
         Draw_Area
           (Canvas,
            (X      => Gint (X1),
             Y      => Gint (Y1),
             Width  => Gint (X2 - X1),
             Height => Gint (Y2 - Y1)));
      end if;

      return False;
   end On_Draw;

   ---------------------
   -- 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_RGBA := (0.0, 0.0, 0.0, 0.0);
      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));

      Set_Source_RGBA (Cr, Sel);

      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.Get_Vadjustment);
      Lower     : constant Gdouble := Get_Lower (Canvas.Get_Vadjustment);
      Page_Incr : constant Gdouble := Scrolling_Amount_Max;
      Page_Size : constant Gdouble := Get_Page_Size (Canvas.Get_Vadjustment);
      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.Get_Vadjustment, Lower);
            return True;

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

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

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

         when GDK_Up | GDK_KP_Up =>
            if Value - Step_Incr >= Lower then
               Set_Value (Canvas.Get_Vadjustment, Value - Step_Incr);
            else
               Set_Value (Canvas.Get_Vadjustment, 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.Get_Vadjustment, Value + Step_Incr);
            else
               Set_Value (Canvas.Get_Vadjustment, 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.Get_Hadjustment) >=
                Get_Lower (Canvas.Get_Hadjustment)
            then
               Set_Value (Canvas.Get_Hadjustment,
                          Canvas.World_X
                          - Get_Step_Increment (Canvas.Get_Hadjustment));
            else
               Set_Value (Canvas.Get_Hadjustment,
                          Get_Lower (Canvas.Get_Hadjustment));
            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.Get_Hadjustment) +
              Get_Page_Size (Canvas.Get_Hadjustment) <=
                Get_Upper (Canvas.Get_Hadjustment)
            then
               Set_Value (Canvas.Get_Hadjustment,
                          Canvas.World_X +
                            Get_Step_Increment (Canvas.Get_Hadjustment));
            else
               Set_Value (Canvas.Get_Hadjustment,
                          Get_Upper (Canvas.Get_Hadjustment) -
                            Get_Page_Size (Canvas.Get_Hadjustment));
            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
      Mouse_To_World (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
      Mouse_To_World (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.Gdk_Cursor;
      Handled : Boolean;
      X, Y    : Gdouble;

   begin
      if Event.Button.Window /= Get_Bin_Window (Canvas) then
         return False;
      end if;

      Grab_Focus (Canvas);

      Mouse_To_World
        (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
            Get_Coords (Event, X, Y);
            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 (X))
                      & Gint'Image (Gint (Y)));
         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 Primary_Mod_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 Primary_Mod_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
            Event.Button.X :=
              Canvas.World_X_At_Click - Gdouble (Canvas.Item_Press.Coord.X);
            Event.Button.Y :=
               Canvas.World_Y_At_Click - Gdouble (Canvas.Item_Press.Coord.Y);
            Handled := On_Button_Click (Canvas.Item_Press, Event.Button);

            if not Handled then
               --  If not handled, then:
               --  if the iter was part of a selection, do nothing,
               --  if the iter was not part of a selection, clear the selection
               --  and select this iter.

               if not Canvas.Item_Press.Selected then
                  Clear_Selection (Canvas);

                  Add_To_Selection (Canvas, Canvas.Item_Press);
               end if;

               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_Bin_Window (Canvas), Cursor);
      Unref (Cursor);

      --  Initialize the move

      Canvas.Offset_X_World      := 0.0;
      Canvas.Offset_Y_World      := 0.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.

      Canvas.Grab_Add;

      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;
      X, Y               : Gdouble;
      Dead               : Boolean;
      pragma Unreferenced (Dead);

      Mouse_X_Canvas, Mouse_Y_Canvas : Gdouble;
   begin
      if Event.Button.Window /= Get_Bin_Window (Canvas) then
         return False;
      end if;

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

         return On_Button_Click (Canvas.Item_Press, Event.Button);
      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

      Get_Coords (Event, X, Y);
      Mouse_X_Canvas := X - Canvas.Get_Hadjustment.Get_Value;
      Mouse_Y_Canvas := Y - Canvas.Get_Vadjustment.Get_Value;

      Test_Scrolling_Box
        (Canvas            => Canvas,
         Mouse_X_In_Canvas => Mouse_X_Canvas,
         Mouse_Y_In_Canvas => Mouse_Y_Canvas,
         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_Device := Gtk.Main.Get_Current_Event_Device;
            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.

      Mouse_To_World (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,
         Behavior => Do_Not_Change);

      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
      Canvas.Grab_Remove;

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

      if Event.Button.Window /= Get_Bin_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
            Mouse_To_World (Canvas, Event, New_X, New_Y);
            Event.Button.X := New_X - Gdouble (Canvas.Item_Press.Coord.X);
            Event.Button.Y := New_Y - Gdouble (Canvas.Item_Press.Coord.Y);
         end;

         Handled := On_Button_Click (Canvas.Item_Press, Event.Button);
         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.0;
         Canvas.Offset_Y_World := 0.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 := Get_Actual_Coordinates (Canvas, Item);
            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.0;
         Canvas.Offset_Y_World := 0.0;

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

      else
         --  If we are reaching this point, this means that there wasn't an
         --  item being pressed, and we didn't perform a button pressed move.
         --  So if there is an item under the cursor, if this item wasn't
         --  already selected, clear the selection.
         Item := Item_At_Coordinates (Canvas, Event);
         if not Item.Selected then
            Clear_Selection (Canvas);
         end if;
      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 := Gint (Canvas.Offset_X_World);
      H : Gint := 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 : Gdouble;
      X_Scroll : out Gdouble;
      Y_Scroll : out Gdouble)
   is
      X_Ignored, Y_Ignored : Gint;
      Width, Height : Gint;
      Margin : constant Gdouble :=
        World_To_Canvas_Length (Canvas, Gdouble (Scrolling_Margin));
   begin
      Get_Geometry
        (Canvas.Get_Window,
         X_Ignored, Y_Ignored,
         Width, Height);

      if Mouse_X_In_Canvas < Margin then
         X_Scroll := Canvas_To_World_Length
           (Canvas, -Canvas.Surround_Box_Scroll);
      elsif Mouse_X_In_Canvas > Gdouble (Width) - Margin then
         X_Scroll := Canvas_To_World_Length
           (Canvas, Canvas.Surround_Box_Scroll);
      else
         X_Scroll := 0.0;
      end if;

      if Mouse_Y_In_Canvas < Margin then
         Y_Scroll := Canvas_To_World_Length
           (Canvas, -Canvas.Surround_Box_Scroll);
      elsif Mouse_Y_In_Canvas > Gdouble (Height) - Margin then
         Y_Scroll := Canvas_To_World_Length
           (Canvas, Canvas.Surround_Box_Scroll);
      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="
                   & Gdouble'Image (Mouse_X_In_Canvas)
                   & Gdouble'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;
      Cr                             : Cairo_Context;

   begin
      if Traces then
         Put_Line ("Scrolling timeout");
      end if;

      W := Get_Window (Canvas);

      Get_Device_Position
        (Get_Window (Canvas), Canvas.Scrolling_Device,
         Mouse_X_Canvas, Mouse_Y_Canvas, Mask, W);

      Test_Scrolling_Box
        (Canvas, Gdouble (Mouse_X_Canvas),
         Gdouble (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 + Canvas.Offset_X_World,
           New_Offset_Y_World => Y_Scroll + Canvas.Offset_Y_World,
          Behavior => Clamp)
      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.

         Cr := Create (Canvas);
         Draw_All (Canvas, Cr);
         Destroy (Cr);
         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;
      Rect  : Gdk_Rectangle;
      Sel   : Gdk_RGBA := (0.0, 0.0, 0.0, 1.0);

   begin
      if Canvas.Selected_Count = 0 then
         Rect := Get_Background_Selection_Rectangle (Canvas);

         Cairo.Save (Cr);
         Set_Transform
           (Canvas, Cr, Gdouble (Rect.X), Gdouble (Rect.Y));
         Cairo.Rectangle
           (Cr,
            0.5,
            0.5,
            Gdouble (Rect.Width) - 1.0,
            Gdouble (Rect.Height) - 1.0);

         Sel.Alpha := 0.3;
         Set_Source_RGBA (Cr, Sel);
         Fill_Preserve (Cr);

         Sel.Alpha := 1.0;
         Set_Source_RGBA (Cr, Sel);
         Stroke (Cr);

         Cairo.Restore (Cr);

      else
         Iter := Start (Canvas, Selected_Only => True);
         Set_Source_RGBA (Cr, (0.0, 0.0, 0.0, 0.3));

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

            if Item.Visible then
               Cairo.Save (Cr);

               declare
                  C : constant Cairo_Rectangle_Int :=
                    Get_Actual_Coordinates (Canvas, Item);
               begin
                  Set_Transform (Canvas, Cr, Gdouble (C.X), Gdouble (C.Y));
                  Cairo.Rectangle
                    (Cr, 0.0, 0.0, Gdouble (C.Width), Gdouble (C.Height));
                  Cairo.Fill (Cr);

               exception
                  when E : others =>
                     Gtkada.Bindings.Process_Exception (E);
               end;

               Cairo.Restore (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;
      Behavior : Bounds_Modification_Mode) 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 := New_Offset_X_World;
      Canvas.Offset_Y_World := New_Offset_Y_World;

      Update_Adjustments (Canvas, Behavior);

      Scroll_Canvas_To_Area
        (Canvas,
         Canvas.World_X_At_Click +
           Canvas.Offset_X_World - Gdouble (Scrolling_Margin),
         Canvas.World_Y_At_Click +
           Canvas.Offset_Y_World - Gdouble (Scrolling_Margin),
         Canvas.World_X_At_Click +
           Canvas.Offset_X_World + Gdouble (Scrolling_Margin),
         Canvas.World_Y_At_Click +
           Canvas.Offset_Y_World + Gdouble (Scrolling_Margin));

      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)
   is
   begin
      Scroll_Canvas_To_Item
        (Canvas, Item, Canvas_X, Canvas_Y);
   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 Canvas.In_Destruction 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);

      --  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);
      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_Allocated_Width (Canvas)) / Canvas.Zoom / 2.0;
      Canvas.Zoom_Y :=
        Canvas.World_Y +
          Gdouble (Get_Allocated_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
   begin
      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;
