1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
|
------------------------------------------------------------------------------
-- GtkAda - Ada95 binding for the Gimp Toolkit --
-- --
-- Copyright (C) 2014-2018, 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. --
-- --
-- --
-- --
-- --
-- --
-- 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 Glib; use Glib;
with Glib.Object; use Glib.Object;
with Gdk.RGBA; use Gdk.RGBA;
with Gdk.Types; use Gdk.Types;
with Gtk.Box; use Gtk.Box;
with Gtk.Enums; use Gtk.Enums;
with Gtk.Label; use Gtk.Label;
with Gtk.Scrolled_Window; use Gtk.Scrolled_Window;
with Gtk.Widget; use Gtk.Widget;
with Gtkada.Canvas_View; use Gtkada.Canvas_View;
with Gtkada.Canvas_View.Views; use Gtkada.Canvas_View.Views;
with Gtkada.Style; use Gtkada.Style;
package body Create_Canvas_View_Animate is
Width : constant Gdouble := 30.0;
Height : constant Gdouble := 30.0;
type My_View_Record is new Canvas_View_Record with record
Item1 : access Abstract_Item_Record'Class;
Item2 : access Abstract_Item_Record'Class;
end record;
type My_View is access all My_View_Record'Class;
function On_Item_Event
(View : not null access GObject_Record'Class;
Event : Event_Details_Access)
return Boolean;
-- Called when the canvas reports an event
function On_Item_Event_Zoom is new On_Item_Event_Zoom_Generic
(Modifier => Mod1_Mask,
Factor => 2.0,
Duration => 0.4,
Easing => Easing_Linear'Access);
----------
-- Help --
----------
function Help return String is
begin
return "The @bCanvas_View@B widget provides an animation framework"
& " which can be used when moving or resizing items, scaling the"
& " view, changing styles,..." & ASCII.LF
& "In this demo, click with left or right mouse button to move items"
& " with animation, or alt-wheel to zoom the canvas with animation.";
end Help;
-------------------
-- On_Item_Event --
-------------------
function On_Item_Event
(View : not null access GObject_Record'Class;
Event : Event_Details_Access)
return Boolean
is
Self : constant My_View := My_View (View);
It : Abstract_Item;
begin
if Event.Event_Type = Button_Press then
if Event.Button = 1 then
It := Abstract_Item (Self.Item1);
else
It := Abstract_Item (Self.Item2);
end if;
Animate_Position
(It,
(Event.M_Point.X - Width / 2.0,
Event.M_Point.Y - Height / 2.0),
Duration => 1.6,
Easing => Easing_Out_Elastic'Access).Start (Self);
end if;
return False; -- fallback to other handlers
end On_Item_Event;
---------
-- Run --
---------
procedure Run (Frame : access Gtk.Frame.Gtk_Frame_Record'Class) is
Box : Gtk_Box;
Canvas : constant My_View := new My_View_Record;
Model : List_Canvas_Model;
Link : Canvas_Link;
Scrolled : Gtk_Scrolled_Window;
Label : Gtk_Label;
begin
Gtk_New (Model);
Gtkada.Canvas_View.Initialize (Canvas);
Canvas.On_Item_Event (On_Item_Event'Access);
Canvas.On_Item_Event (On_Item_Event_Zoom'Access);
Canvas.Item1 := Gtk_New_Rect
(Gtk_New (Stroke => Black_RGBA), Width => Width, Height => Height);
Canvas.Item1.Set_Position ((0.0, 0.0));
Model.Add (Canvas.Item1);
Canvas.Item2 := Gtk_New_Rect
(Gtk_New (Stroke => (0.4, 0.4, 0.4, 1.0)),
Width => Width, Height => Height);
Canvas.Item2.Set_Position ((300.0, 300.0));
Model.Add (Canvas.Item2);
Link := Gtk_New
(Canvas.Item1, Canvas.Item2, Gtk_New (Stroke => Black_RGBA));
Model.Add (Link);
Gtk_New_Vbox (Box, Homogeneous => False);
Frame.Add (Box);
Gtk_New
(Label,
"Click (left or right) in canvas to move the item, with animation");
Box.Pack_Start (Label, Expand => False, Fill => False);
Gtk_New (Scrolled);
Scrolled.Set_Policy (Policy_Always, Policy_Always);
Box.Pack_Start (Scrolled, Expand => True, Fill => True);
Canvas.Set_Model (Model);
Unref (Model);
Scrolled.Add (Canvas);
Frame.Show_All;
end Run;
end Create_Canvas_View_Animate;
|
