1 | ------------------------------------------------------------------------------ |
---|
2 | -- -- |
---|
3 | -- Matreshka Project -- |
---|
4 | -- -- |
---|
5 | -- Web Framework -- |
---|
6 | -- -- |
---|
7 | -- Runtime Library Component -- |
---|
8 | -- -- |
---|
9 | ------------------------------------------------------------------------------ |
---|
10 | -- -- |
---|
11 | -- Copyright © 2016-2017, Vadim Godunko <vgodunko@gmail.com> -- |
---|
12 | -- All rights reserved. -- |
---|
13 | -- -- |
---|
14 | -- Redistribution and use in source and binary forms, with or without -- |
---|
15 | -- modification, are permitted provided that the following conditions -- |
---|
16 | -- are met: -- |
---|
17 | -- -- |
---|
18 | -- * Redistributions of source code must retain the above copyright -- |
---|
19 | -- notice, this list of conditions and the following disclaimer. -- |
---|
20 | -- -- |
---|
21 | -- * Redistributions in binary form must reproduce the above copyright -- |
---|
22 | -- notice, this list of conditions and the following disclaimer in the -- |
---|
23 | -- documentation and/or other materials provided with the distribution. -- |
---|
24 | -- -- |
---|
25 | -- * Neither the name of the Vadim Godunko, IE nor the names of its -- |
---|
26 | -- contributors may be used to endorse or promote products derived from -- |
---|
27 | -- this software without specific prior written permission. -- |
---|
28 | -- -- |
---|
29 | -- THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS -- |
---|
30 | -- "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT -- |
---|
31 | -- LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR -- |
---|
32 | -- A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT -- |
---|
33 | -- HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, -- |
---|
34 | -- SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED -- |
---|
35 | -- TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR -- |
---|
36 | -- PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF -- |
---|
37 | -- LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING -- |
---|
38 | -- NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS -- |
---|
39 | -- SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -- |
---|
40 | -- -- |
---|
41 | ------------------------------------------------------------------------------ |
---|
42 | -- $Revision: 5682 $ $Date: 2017-01-10 21:55:53 +0000 (Tue, 10 Jan 2017) $ |
---|
43 | ------------------------------------------------------------------------------ |
---|
44 | with WebAPI.DOM.Elements; |
---|
45 | with WebAPI.DOM.Rects; |
---|
46 | |
---|
47 | package body WUI.Events.Mouse is |
---|
48 | |
---|
49 | ------------------ |
---|
50 | -- Constructors -- |
---|
51 | ------------------ |
---|
52 | |
---|
53 | package body Constructors is |
---|
54 | |
---|
55 | ---------------- |
---|
56 | -- Initialize -- |
---|
57 | ---------------- |
---|
58 | |
---|
59 | procedure Initialize |
---|
60 | (Self : in out Abstract_Mouse_Event'Class; |
---|
61 | Event : not null access WebAPI.UI_Events.Mouse.Mouse_Event'Class) is |
---|
62 | begin |
---|
63 | WUI.Events.Constructors.Initialize (Self, Event); |
---|
64 | end Initialize; |
---|
65 | |
---|
66 | end Constructors; |
---|
67 | |
---|
68 | ------------- |
---|
69 | -- Buttons -- |
---|
70 | ------------- |
---|
71 | |
---|
72 | function Buttons |
---|
73 | (Self : Abstract_Mouse_Event'Class) return Mouse_Buttons |
---|
74 | is |
---|
75 | use type WebAPI.DOM_Unsigned_Short; |
---|
76 | |
---|
77 | Buttons : constant WebAPI.DOM_Unsigned_Short |
---|
78 | := WebAPI.UI_Events.Mouse.Mouse_Event'Class |
---|
79 | (Self.Event.all).Get_Buttons; |
---|
80 | Result : Mouse_Buttons := (others => False); |
---|
81 | |
---|
82 | begin |
---|
83 | if (Buttons and 2#0001#) /= 0 then |
---|
84 | Result (Button_1) := True; |
---|
85 | end if; |
---|
86 | |
---|
87 | if (Buttons and 2#0010#) /= 0 then |
---|
88 | Result (Button_2) := True; |
---|
89 | end if; |
---|
90 | |
---|
91 | if (Buttons and 2#0100#) /= 0 then |
---|
92 | Result (Button_3) := True; |
---|
93 | end if; |
---|
94 | |
---|
95 | return Result; |
---|
96 | end Buttons; |
---|
97 | |
---|
98 | ------- |
---|
99 | -- X -- |
---|
100 | ------- |
---|
101 | |
---|
102 | function X (Self : Abstract_Mouse_Event'Class) return Long_Float is |
---|
103 | E : WebAPI.UI_Events.Mouse.Mouse_Event'Class |
---|
104 | renames WebAPI.UI_Events.Mouse.Mouse_Event'Class (Self.Event.all); |
---|
105 | R : constant WebAPI.DOM.Rects.DOM_Rect_Access |
---|
106 | := WebAPI.DOM.Elements.Element'Class |
---|
107 | (E.Get_Target.all).Get_Bounding_Client_Rect; |
---|
108 | |
---|
109 | begin |
---|
110 | return Long_Float (E.Get_Client_X) - Long_Float (R.Get_Left); |
---|
111 | end X; |
---|
112 | |
---|
113 | ------- |
---|
114 | -- Y -- |
---|
115 | ------- |
---|
116 | |
---|
117 | function Y (Self : Abstract_Mouse_Event'Class) return Long_Float is |
---|
118 | E : WebAPI.UI_Events.Mouse.Mouse_Event'Class |
---|
119 | renames WebAPI.UI_Events.Mouse.Mouse_Event'Class (Self.Event.all); |
---|
120 | R : constant WebAPI.DOM.Rects.DOM_Rect_Access |
---|
121 | := WebAPI.DOM.Elements.Element'Class |
---|
122 | (E.Get_Target.all).Get_Bounding_Client_Rect; |
---|
123 | |
---|
124 | begin |
---|
125 | return Long_Float (E.Get_Client_Y) - Long_Float (R.Get_Top); |
---|
126 | end Y; |
---|
127 | |
---|
128 | end WUI.Events.Mouse; |
---|