1------------------------------------------------------------------------------
2--               GtkAda - Ada95 binding for the Gimp Toolkit                --
3--                                                                          --
4--                     Copyright (C) 2014-2015, AdaCore                     --
5--                                                                          --
6-- This library is free software;  you can redistribute it and/or modify it --
7-- under terms of the  GNU General Public License  as published by the Free --
8-- Software  Foundation;  either version 3,  or (at your  option) any later --
9-- version. This library is distributed in the hope that it will be useful, --
10-- but WITHOUT ANY WARRANTY;  without even the implied warranty of MERCHAN- --
11-- TABILITY or FITNESS FOR A PARTICULAR PURPOSE.                            --
12--                                                                          --
13-- As a special exception under Section 7 of GPL version 3, you are granted --
14-- additional permissions described in the GCC Runtime Library Exception,   --
15-- version 3.1, as published by the Free Software Foundation.               --
16--                                                                          --
17-- You should have received a copy of the GNU General Public License and    --
18-- a copy of the GCC Runtime Library Exception along with this program;     --
19-- see the files COPYING3 and COPYING.RUNTIME respectively.  If not, see    --
20-- <http://www.gnu.org/licenses/>.                                          --
21--                                                                          --
22------------------------------------------------------------------------------
23
24with Gdk.RGBA;                  use Gdk.RGBA;
25with Gdk.Types;                 use Gdk.Types;
26with Glib;                      use Glib;
27with Gtk.Enums;                 use Gtk.Enums;
28with Gtk.Frame;                 use Gtk.Frame;
29with Gtk.Scrolled_Window;       use Gtk.Scrolled_Window;
30with Gtkada.Canvas_View;        use Gtkada.Canvas_View;
31with Gtkada.Canvas_View.Models; use Gtkada.Canvas_View.Models;
32with Gtkada.Canvas_View.Views;  use Gtkada.Canvas_View.Views;
33with Gtkada.Style;              use Gtkada.Style;
34
35package body Create_Canvas_View_Rtrees is
36
37   function On_Item_Event_Zoom is new On_Item_Event_Zoom_Generic
38      (Modifier => Mod1_Mask);
39
40   package List_Rtrees is new Rtree_Models (List_Canvas_Model_Record);
41   use List_Rtrees;
42   --  Rtree models based on list models
43
44   Items_Count : constant := 30_000;
45   Per_Row     : constant := 400;
46   Rows        : constant := Items_Count / Per_Row + 1;
47
48   ----------
49   -- Help --
50   ----------
51
52   function Help return String is
53   begin
54      return "Multiple data models can be used to store the items that must"
55        & " be displayed in a canvas." & ASCII.LF
56        & "The simplest model is a @bList_Canvas_Model@B which provides a"
57        & " very simple implementation, which is reasonably for small graphs"
58        & " and can be extended easily without having to override all its"
59        & " primitives." & ASCII.LF
60        & "But if you needs to show thousands of items (this demo"
61        & " displays@b" & Integer'Image (Items_Count) & "@B items and@b"
62        & Integer'Image (2 * Items_Count - Per_Row - Rows) & "@B links)"
63        & " you will need to wrap that simple model with a @bRtree_Model@B,"
64        & " which provides a much more efficient implementation for some of"
65        & " the queries, like finding the list of items in a given region of"
66        & " the screen.";
67   end Help;
68
69   ---------
70   -- Run --
71   ---------
72
73   procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
74      Size          : constant Gdouble := 20.0;
75      Margin        : constant Gdouble := 20.0;
76
77      Items         : array (0 .. Per_Row - 1, 0 .. Rows) of Rect_Item;
78      X, Y          : Integer;
79
80      Canvas        : Canvas_View;
81      Model         : List_Rtrees.Rtree_Model;
82      --  Model         : List_Canvas_Model;
83      Scrolled      : Gtk_Scrolled_Window;
84      Filled        : Drawing_Style;
85      Rect          : Rect_Item;
86      Link          : Canvas_Link;
87      Link_Style    : Drawing_Style;
88
89   begin
90      Gtk_New (Model);
91      Model.Set_Selection_Mode (Selection_Single);
92
93      Canvas := new Canvas_View_Record;
94      Gtkada.Canvas_View.Initialize (Canvas);
95      Canvas.On_Item_Event (On_Item_Event_Select'Access);
96      Canvas.On_Item_Event (On_Item_Event_Move_Item'Access);
97      Canvas.On_Item_Event (On_Item_Event_Scroll_Background'Access);
98      Canvas.On_Item_Event (On_Item_Event_Zoom'Access);
99
100      Link_Style := Gtk_New (Stroke => Black_RGBA);
101
102      for Num in 0 .. Items_Count loop
103         X := Num mod Per_Row;
104         Y := Num / Per_Row;
105
106         --  Creating one style per item is not very efficient, it is
107         --  better to share styles whenever possible.
108
109         Filled := Gtk_New
110           (Stroke => Black_RGBA,
111            Fill => Create_Rgba_Pattern
112               ((0.0,
113                 1.0 / Gdouble (Per_Row) * Gdouble (X),
114                 1.0 / Gdouble (Rows) * Gdouble (Y),
115                 0.8)));
116
117         Rect := Gtk_New_Rect (Filled, Size, Size);
118         Rect.Set_Position
119            (((Size + Margin) * Gdouble (X),
120              (Size + Margin) * Gdouble (Y)));
121         Model.Add (Rect);
122
123         Items (X, Y) := Rect;
124         if X > 0 then
125            Link := Gtk_New (Items (X - 1, Y), Rect, Link_Style,
126                             Routing => Curve);
127            Model.Add (Link);
128         end if;
129         if Y > 0 then
130            Link := Gtk_New (Items (X, Y - 1), Rect, Link_Style,
131                             Routing => Curve);
132            Model.Add (Link);
133         end if;
134      end loop;
135
136      Gtk_New (Scrolled);
137      Scrolled.Set_Policy (Policy_Automatic, Policy_Automatic);
138      Frame.Add (Scrolled);
139
140      Canvas.Set_Model (Model);
141      Unref (Model);
142      Scrolled.Add (Canvas);
143
144      Frame.Show_All;
145   end Run;
146
147end Create_Canvas_View_Rtrees;
148