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 Cairo; use Cairo; 25with Glib; use Glib; 26with Glib.Object; use Glib.Object; 27with Gdk.Types; use Gdk.Types; 28with Gtk.Frame; use Gtk.Frame; 29with Gtk.Paned; use Gtk.Paned; 30with Gtk.Enums; use Gtk.Enums; 31with Gtk.Scrolled_Window; use Gtk.Scrolled_Window; 32with Gtk.Widget; use Gtk.Widget; 33with Gtkada.Canvas_View; use Gtkada.Canvas_View; 34with Gtkada.Canvas_View.Views; use Gtkada.Canvas_View.Views; 35with Gtkada.Style; use Gtkada.Style; 36 37package body Create_Canvas_View_Minimap is 38 39 function On_Item_Event_Zoom is new On_Item_Event_Zoom_Generic 40 (Modifier => Mod1_Mask); 41 42 ---------- 43 -- Help -- 44 ---------- 45 46 function Help return String is 47 begin 48 return ""; 49 end Help; 50 51 --------- 52 -- Run -- 53 --------- 54 55 procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is 56 S : constant Gdouble := 0.86602540378443864676; -- sqrt(3) / 2 57 Canvas : Canvas_View; 58 Model : List_Canvas_Model; 59 Scrolled : Gtk_Scrolled_Window; 60 Black : Drawing_Style; 61 Paned : Gtk_Paned; 62 Minimap : Minimap_View; 63 Minimap_Frame : Gtk_Frame; 64 65 L1, L2, L3 : Canvas_Link; 66 It1, It3 : Rect_Item; 67 It2 : Polyline_Item; 68 69 L : Gdouble; 70 begin 71 Gtk_New (Model); 72 73 Canvas := new Canvas_View_Record; 74 Gtkada.Canvas_View.Initialize (Canvas); 75 Canvas.Set_Grid_Size (30.0); 76 Canvas.Set_Snap (Snap_To_Grid => True, 77 Snap_To_Guides => True); 78 79 -- Order is irrelevant here. 80 Canvas.On_Item_Event (On_Item_Event_Select'Access); 81 Canvas.On_Item_Event (On_Item_Event_Move_Item'Access); 82 Canvas.On_Item_Event (On_Item_Event_Scroll_Background'Access); 83 Canvas.On_Item_Event (On_Item_Event_Zoom'Access); 84 85 Black := Gtk_New (Fill => Create_Rgba_Pattern ((1.0, 0.0, 0.0, 0.5))); 86 It1 := Gtk_New_Rect (Black, 80.0, 80.0); 87 It1.Set_Position ((50.0, 50.0)); 88 Model.Add (It1); 89 90 L := 30.0; 91 It2 := Gtk_New_Polyline 92 (Black, 93 ((2.0 * L, L * S), 94 (1.5 * L, L * S * 2.0), 95 (0.5 * L, L * S * 2.0), 96 (0.0, L * S), 97 (0.5 * L, 0.0), 98 (1.5 * L, 0.0)), 99 Close => True); 100 It2.Set_Position ((250.0, 250.0)); 101 Model.Add (It2); 102 103 It3 := Gtk_New_Rect (Black, 50.0, 80.0); 104 It3.Set_Position ((50.0, 220.0)); 105 Model.Add (It3); 106 107 L1 := Gtk_New (From => It1, To => It2, Style => Gtk_New, 108 Routing => Straight); 109 Model.Add (L1); 110 111 L2 := Gtk_New (From => It2, To => It3, Style => Gtk_New, 112 Routing => Straight); 113 Model.Add (L2); 114 115 L3 := Gtk_New (From => L1, To => L2, 116 Style => Gtk_New (Dashes => (4.0, 4.0)), 117 Routing => Straight); 118 Model.Add (L3); 119 120 It3 := Gtk_New_Rect (Black, 50.0, 80.0); 121 It3.Set_Position ((650.0, 400.0)); 122 Model.Add (It3); 123 124 -- Create the view once the model is populated, to avoid a refresh 125 -- every time a new item is added. 126 127 Gtk_New (Paned, Orientation_Vertical); 128 Paned.Set_Position (100); 129 Frame.Add (Paned); 130 131 Gtk_New (Minimap_Frame); 132 Paned.Add1 (Minimap_Frame); 133 134 Gtk_New (Minimap); 135 Minimap.Monitor (Canvas); 136 Minimap_Frame.Add (Minimap); 137 138 Gtk_New (Scrolled); 139 Scrolled.Set_Policy (Policy_Always, Policy_Always); 140 Paned.Add2 (Scrolled); 141 142 Canvas.Set_Model (Model); 143 Unref (Model); 144 Scrolled.Add (Canvas); 145 146 Frame.Show_All; 147 end Run; 148 149end Create_Canvas_View_Minimap; 150