source: trunk/design/ui/source/wui-widgets-windows.adb

Last change on this file was 5682, checked in by vadim.godunko, 11 months ago

Rename root package.

  • Property svn:keywords set to Author Date Revision
File size: 10.3 KB
Line 
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------------------------------------------------------------------------------
44with WebAPI.DOM.Documents;
45with WebAPI.DOM.Elements;
46
47package body WUI.Widgets.Windows 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 Window'Class;
61        Element : not null WebAPI.HTML.Elements.HTML_Element_Access) is
62      begin
63         Self.Enclosing_Div :=
64           WebAPI.HTML.Elements.HTML_Element_Access (Element);
65
66         WUI.Widgets.Constructors.Initialize (Self, Element);
67      end Initialize;
68
69      ----------------
70      -- Initialize --
71      ----------------
72
73      procedure Initialize
74       (Self    : in out Window'Class;
75        Parent  : not null access WUI.Widgets.Abstract_Widget'Class;
76        Title   : League.Strings.Universal_String)
77      is
78         Document  : constant WebAPI.DOM.Documents.Document_Access
79           := Parent.Element.Get_Owner_Document;
80         Enclosing : constant not null WebAPI.DOM.Elements.Element_Access
81           := Document.Create_Element (+"div");
82         Head      : constant not null WebAPI.DOM.Elements.Element_Access
83           := Document.Create_Element (+"div");
84         Corner    : constant not null WebAPI.DOM.Elements.Element_Access
85           := Document.Create_Element (+"div");
86         Content   : constant not null WebAPI.DOM.Elements.Element_Access
87           := Document.Create_Element (+"div");
88
89      begin
90         Self.Enclosing_Div :=
91           WebAPI.HTML.Elements.HTML_Element_Access (Enclosing);
92
93         Head.Set_Text_Content (Title);
94         Head.Set_Class_Name (+"window-title");
95         Enclosing.Set_Class_Name (+"window");
96         Enclosing.Append_Child (Head);
97         Content.Set_Class_Name (+"window-body");
98         Enclosing.Append_Child (Content);
99         Corner.Set_Class_Name (+"window-corner");
100         Enclosing.Append_Child (Corner);
101
102         WUI.Widgets.Constructors.Initialize
103          (Self, WebAPI.HTML.Elements.HTML_Element_Access (Content));
104         WUI.Widgets.Constructors.Initialize
105          (Self.Slider,
106           WebAPI.HTML.Elements.HTML_Element_Access (Head));
107         WUI.Widgets.Constructors.Initialize
108          (Self.Resizer,
109           WebAPI.HTML.Elements.HTML_Element_Access (Corner));
110
111         Parent.Element.Append_Child (Enclosing);
112      end Initialize;
113
114   end Constructors;
115
116   -------------
117   -- Sliders --
118   -------------
119
120   package body Sliders is
121
122      ----------------------
123      -- Mouse_Move_Event --
124      ----------------------
125
126      overriding procedure Mouse_Move_Event
127       (Self  : in out Slider;
128        Event : in out WUI.Events.Mouse.Move.Mouse_Move_Event'Class) is
129      begin
130         if Self.Active then
131            Self.Win_X := Self.Win_X + Integer (Event.X - Self.Prev_X);
132            Self.Win_Y := Self.Win_Y + Integer (Event.Y - Self.Prev_Y);
133            Self.Parent.Set_Position (Self.Win_Y, Self.Win_X);
134            Self.Prev_X := Event.X;
135            Self.Prev_Y := Event.Y;
136         end if;
137      end Mouse_Move_Event;
138
139      ----------------------
140      -- Mouse_Move_Event --
141      ----------------------
142
143      overriding procedure Mouse_Move_Event
144       (Self  : in out Resizer;
145        Event : in out WUI.Events.Mouse.Move.Mouse_Move_Event'Class) is
146      begin
147         if Self.Active then
148            Self.Win_X := Self.Win_X + Integer (Event.X - Self.Prev_X);
149            Self.Win_Y := Self.Win_Y + Integer (Event.Y - Self.Prev_Y);
150            Self.Parent.Set_Size (Self.Win_Y, Self.Win_X);
151            Self.Prev_X := Event.X;
152            Self.Prev_Y := Event.Y;
153         end if;
154      end Mouse_Move_Event;
155
156      -----------------------
157      -- Mouse_Press_Event --
158      -----------------------
159
160      overriding procedure Mouse_Press_Event
161       (Self  : in out Slider;
162        Event : in out WUI.Events.Mouse.Button.Mouse_Button_Event'Class) is
163      begin
164         Self.Active := True;
165         Self.Prev_X := Event.X;
166         Self.Prev_Y := Event.Y;
167         Self.Win_X := Self.Parent.Left;
168         Self.Win_Y := Self.Parent.Top;
169      end Mouse_Press_Event;
170
171      -----------------------
172      -- Mouse_Press_Event --
173      -----------------------
174
175      overriding procedure Mouse_Press_Event
176       (Self  : in out Resizer;
177        Event : in out WUI.Events.Mouse.Button.Mouse_Button_Event'Class) is
178      begin
179         Self.Active := True;
180         Self.Prev_X := Event.X;
181         Self.Prev_Y := Event.Y;
182         Self.Win_X := Self.Parent.Width;
183         Self.Win_Y := Self.Parent.Height;
184      end Mouse_Press_Event;
185
186      -------------------------
187      -- Mouse_Release_Event --
188      -------------------------
189
190      overriding procedure Mouse_Release_Event
191       (Self  : in out Slider;
192        Event : in out WUI.Events.Mouse.Button.Mouse_Button_Event'Class) is
193      begin
194         Self.Active := False;
195      end Mouse_Release_Event;
196
197   end Sliders;
198
199   ------------
200   -- Height --
201   ------------
202
203   not overriding function Height (Self : Window) return Integer is
204   begin
205      return Integer (Self.Enclosing_Div.Get_Offset_Height);
206   end Height;
207
208   ----------
209   -- Left --
210   ----------
211
212   not overriding function Left (Self : Window) return Integer is
213   begin
214      return Integer (Self.Enclosing_Div.Get_Offset_Left);
215   end Left;
216
217   -----------
218   -- Width --
219   -----------
220
221   not overriding function Width (Self : Window) return Integer is
222   begin
223      return Integer (Self.Enclosing_Div.Get_Offset_Width);
224   end Width;
225
226   ------------------
227   -- Set_Position --
228   ------------------
229
230   not overriding procedure Set_Position
231    (Self : in out Window;
232     Top  : Integer;
233     Left : Integer) is
234   begin
235      Self.Set_Style (Top, Left, Self.Height, Self.Width);
236   end Set_Position;
237
238   --------------
239   -- Set_Size --
240   --------------
241
242   not overriding procedure Set_Size
243    (Self   : in out Window;
244     Height : Integer;
245     Width  : Integer) is
246   begin
247      Self.Set_Style (Self.Top, Self.Left, Height, Width);
248   end Set_Size;
249
250   ---------------
251   -- Set_Style --
252   ---------------
253
254   not overriding procedure Set_Style
255     (Self   : in out Window;
256      Top    : Integer;
257      Left   : Integer;
258      Height : Integer;
259      Width  : Integer)
260   is
261      use type League.Strings.Universal_String;
262
263      Top_Image : constant Wide_Wide_String :=
264        Integer'Wide_Wide_Image (Top);
265      Left_Image : constant Wide_Wide_String :=
266        Integer'Wide_Wide_Image (Left);
267      Height_Image : constant Wide_Wide_String :=
268        Integer'Wide_Wide_Image (Height);
269      Width_Image : constant Wide_Wide_String :=
270        Integer'Wide_Wide_Image (Width);
271      Style : League.Strings.Universal_String := +"top:";
272   begin
273      Style := Style & Top_Image & "px; left:" & Left_Image & "px;"
274        & "height:" & Height_Image & "px; width:" & Width_Image & "px;";
275
276      Self.Enclosing_Div.Set_Attribute (+"style", Style);
277   end Set_Style;
278
279   ---------
280   -- Top --
281   ---------
282
283   not overriding function Top (Self : Window) return Integer is
284   begin
285      return Integer (Self.Enclosing_Div.Get_Offset_Top);
286   end Top;
287
288end WUI.Widgets.Windows;
Note: See TracBrowser for help on using the repository browser.