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