source: trunk/design/ui/source/wui-widgets-spin_boxes-generic_floats.adb

Last change on this file was 5733, checked in by vadim.godunko, 8 months ago

Add control over invalid values.

  • Property svn:keywords set to Author Date Revision
File size: 9.0 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: 5733 $ $Date: 2017-01-28 11:53:14 +0000 (Sat, 28 Jan 2017) $
43------------------------------------------------------------------------------
44with WebAPI.HTML.Globals;
45
46package body WUI.Widgets.Spin_Boxes.Generic_Floats is
47
48   procedure Internal_Set_Value
49    (Self   : in out Float_Spin_Box'Class;
50     To     : Data_Type;
51     Update : Boolean);
52   --  Sets value, emit signal when value was modified, and update value of
53   --  input element when Update is True.
54
55   ------------------
56   -- Change_Event --
57   ------------------
58
59   overriding procedure Change_Event (Self : in out Float_Spin_Box) is
60      Input : constant WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
61        := WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
62            (Self.Element);
63
64   begin
65      if not Input.Get_Validity.Get_Valid then
66         if Input.Get_Validity.Get_Bad_Input then
67            Self.Internal_Set_Value
68             (Data_Type'Wide_Wide_Value
69               (League.Strings.To_Wide_Wide_String (Input.Get_Min)), True);
70
71         elsif Input.Get_Validity.Get_Range_Overflow then
72            Self.Internal_Set_Value
73             (Data_Type'Wide_Wide_Value
74               (League.Strings.To_Wide_Wide_String (Input.Get_Max)), True);
75
76         elsif Input.Get_Validity.Get_Range_Underflow then
77            Self.Internal_Set_Value
78             (Data_Type'Wide_Wide_Value
79               (League.Strings.To_Wide_Wide_String (Input.Get_Min)), True);
80
81         elsif Input.Get_Validity.Get_Value_Missing then
82            Self.Internal_Set_Value
83             (Data_Type'Wide_Wide_Value
84               (League.Strings.To_Wide_Wide_String (Input.Get_Min)), True);
85         end if;
86      end if;
87
88      Self.Editing_Finished.Emit;
89   end Change_Event;
90
91   ------------------
92   -- Constructors --
93   ------------------
94
95   package body Constructors is
96
97      type Float_Spin_Box_Internal_Access is access all Float_Spin_Box'Class;
98
99      ------------
100      -- Create --
101      ------------
102
103      function Create
104       (Element :
105          not null WebAPI.HTML.Input_Elements.HTML_Input_Element_Access)
106            return not null Float_Spin_Box_Access
107      is
108         Result : constant not null Float_Spin_Box_Internal_Access
109           := new Float_Spin_Box;
110
111      begin
112         Initialize (Result.all, Element);
113
114         return Float_Spin_Box_Access (Result);
115      end Create;
116
117      ------------
118      -- Create --
119      ------------
120
121      function Create
122       (Id : League.Strings.Universal_String)
123          return not null Float_Spin_Box_Access is
124      begin
125         return
126           Create
127            (WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
128              (WebAPI.HTML.Globals.Window.Get_Document.Get_Element_By_Id
129                (Id)));
130      end Create;
131
132      ----------------
133      -- Initialize --
134      ----------------
135
136      procedure Initialize
137       (Self    : in out Float_Spin_Box'Class;
138        Element :
139          not null WebAPI.HTML.Input_Elements.HTML_Input_Element_Access) is
140      begin
141         WUI.Widgets.Spin_Boxes.Constructors.Initialize (Self, Element);
142
143         --  Extract properties value from HTML element.
144
145         Self.Last_Value :=
146           Data_Type'Wide_Wide_Value
147            (League.Strings.To_Wide_Wide_String (Element.Get_Value));
148      end Initialize;
149
150   end Constructors;
151
152   -----------------
153   -- Input_Event --
154   -----------------
155
156   overriding procedure Input_Event (Self  : in out Float_Spin_Box) is
157      Input : constant WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
158        := WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
159            (Self.Element);
160
161   begin
162      if Input.Get_Validity.Get_Valid then
163         Self.Last_Value := 
164           Data_Type'Wide_Wide_Value
165            (League.Strings.To_Wide_Wide_String
166              (WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
167                (Self.Element).Get_Value));
168         Self.Value_Changed.Emit (Self.Last_Value);
169      end if;
170   end Input_Event;
171
172   ------------------------
173   -- Internal_Set_Value --
174   ------------------------
175
176   procedure Internal_Set_Value
177    (Self   : in out Float_Spin_Box'Class;
178     To     : Data_Type;
179     Update : Boolean)
180   is
181      Input : constant WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
182        := WebAPI.HTML.Input_Elements.HTML_Input_Element_Access
183            (Self.Element);
184
185   begin
186      if Self.Last_Value /= To then
187         Self.Last_Value := To;
188         Input.Set_Value
189          (League.Strings.To_Universal_String
190            (Data_Type'Wide_Wide_Image (To)));
191         Self.Value_Changed.Emit (To);
192         --  'input' event is not send when value is changed programmatically.
193
194      elsif Update then
195         Input.Set_Value
196          (League.Strings.To_Universal_String
197            (Data_Type'Wide_Wide_Image (To)));
198      end if;
199   end Internal_Set_Value;
200
201   ---------------
202   -- Set_Value --
203   ---------------
204
205   not overriding procedure Set_Value
206    (Self : in out Float_Spin_Box;
207     To   : Data_Type) is
208   begin
209      Self.Internal_Set_Value (To, False);
210   end Set_Value;
211
212   ---------------
213   -- Step_Down --
214   ---------------
215
216   overriding procedure Step_Down (Self : in out Float_Spin_Box) is
217   begin
218      raise Program_Error;
219   end Step_Down;
220
221   -------------
222   -- Step_Up --
223   -------------
224
225   overriding procedure Step_Up (Self : in out Float_Spin_Box) is
226   begin
227      raise Program_Error;
228   end Step_Up;
229
230   -----------
231   -- Value --
232   -----------
233
234   not overriding function Value (Self : Float_Spin_Box) return Data_Type is
235   begin
236      return Self.Last_Value;
237   end Value;
238
239   --------------------------
240   -- Value_Changed_Signal --
241   --------------------------
242
243   not overriding function Value_Changed_Signal
244    (Self : in out Float_Spin_Box)
245       return not null access Float_Slots.Signal'Class is
246   begin
247      return Self.Value_Changed'Unchecked_Access;
248   end Value_Changed_Signal;
249
250end WUI.Widgets.Spin_Boxes.Generic_Floats;
Note: See TracBrowser for help on using the repository browser.