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
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349 | -- An Ada-oriented GUI library
-- Implementation derived from Gnoga
--
-- Copyright (C) 2022 by PragmAda Software Engineering
--
-- Released under the terms of the 3-Clause BSD License. See https://opensource.org/licenses/BSD-3-Clause
with Ada.Containers.Indefinite_Ordered_Sets;
with Ada.Directories;
separate (Ada_GUI)
package body Dialogs is
procedure Set_Up
(Background : out Gnoga.Gui.View.View_Type; Frame : out Gnoga.Gui.View.View_Type; View : out Gnoga.Gui.View.View_Type);
-- Sets up Background, Frame, and View for a dialog
-- Background should be passed to Clean_Up before the dialog returns
-- View is where the dialog sets up its widgets
procedure Center (Background : in out Gnoga.Gui.View.View_Type; Frame : in out Gnoga.Gui.View.View_Type);
-- After adding widgets to the View from Set_Up, pass the Background and Frame to center the frame in the window
procedure Clean_Up (Background : in out Gnoga.Gui.View.View_Type; Dialog_Exists : in Boolean);
-- Cleans up a dialog before returning
-- Background should have been set up as the Background parameter to Set_Up
-- Dialog_Exists should be False if the user has closed the window; True otherwise
-- Empties the event queue
-- Allows other dialogs or Next_Event to proceed
-- If Dialog_Exists, removes Background, else adds a window-closed event to the queue
function Selected_File (Initial_Directory : in String := ".") return File_Result_Info is
Directory_Tag : constant String := " (directory)";
procedure Fill_List (Directory : in String; List : in out Gnoga.Gui.Element.Form.Selection_Type);
-- Clears List, then adds the files in Directory to it, directories first, in alphabetical order
procedure File_Selected;
-- User clicked on a file in the file list
package Name_Lists is new Ada.Containers.Indefinite_Ordered_Sets (Element_Type => String);
use Ada.Strings.Unbounded;
procedure Fill_List (Directory : in String; List : in out Gnoga.Gui.Element.Form.Selection_Type) is
procedure Add_Dir (Position : in Name_Lists.Cursor);
-- Adds the Name at Position to List with Directory_Tag added to the end
procedure Add_File (Position : in Name_Lists.Cursor);
-- Adds the name at Position to List
procedure Add_Dir (Position : in Name_Lists.Cursor) is
Name : constant String := Name_Lists.Element (Position) & Directory_Tag;
begin -- Add_Dir
List.Add_Option (Value => Name, Text => Name);
end Add_Dir;
procedure Add_File (Position : in Name_Lists.Cursor) is
Name : constant String := Name_Lists.Element (Position);
begin -- Add_File
List.Add_Option (Value => Name, Text => Name);
end Add_File;
Search_Info : Ada.Directories.Search_Type;
File_Info : Ada.Directories.Directory_Entry_Type;
Dir_List : Name_Lists.Set;
File_List : Name_Lists.Set;
Index : Natural;
begin -- Fill_List
Ada.Directories.Start_Search (Search => Search_Info,
Directory => Directory,
Pattern => "*",
Filter => (Ada.Directories.Special_File => False, others => True) );
All_Entries : loop
exit All_Entries when not Ada.Directories.More_Entries (Search_Info);
Ada.Directories.Get_Next_Entry (Search => Search_Info, Directory_Entry => File_Info);
case Ada.Directories.Kind (File_Info) is
when Ada.Directories.Directory =>
Get_Name : declare
Name : constant String := Ada.Directories.Simple_Name (File_Info);
begin -- Get_Name
if Name /= "." and Name /= ".." then
Dir_List.Insert (New_Item => Name);
end if;
end Get_Name;
when Ada.Directories.Ordinary_File =>
File_List.Insert (New_Item => Ada.Directories.Simple_Name (File_Info) );
when Ada.Directories.Special_File =>
null;
end case;
end loop All_Entries;
Index := List.Selected_Index;
List.Visible (Value => False);
List.Empty_Options;
Dir_List.Iterate (Process => Add_Dir'Access);
File_List.Iterate (Process => Add_File'Access);
if Index /= 0 then
List.Selected (Index => Index);
end if;
List.Visible (Value => True);
end Fill_List;
Result : File_Result_Info;
Current_Dir : Unbounded_String := To_Unbounded_String (Ada.Directories.Full_Name (Initial_Directory) );
File_List : Gnoga.Gui.Element.Form.Selection_Type;
File_Input : Gnoga.Gui.Element.Form.Text_Type;
procedure File_Selected is
Index : constant Natural := File_List.Selected_Index;
begin -- File_Selected
if Index = 0 then
return;
end if;
Get_Name : declare
Name : constant String := File_List.Value (Index);
begin -- Get_Name
if Name'Length <= Directory_Tag'Length or else Name (Name'Last - Directory_Tag'Length + 1 .. Name'Last) /= Directory_Tag
then -- Normal file
File_Input.Value (Value => Name);
else -- Directory
Current_Dir :=
To_Unbounded_String (Ada.Directories.Compose (To_String (Current_Dir),
Name (Name'First .. Name'Last - Directory_Tag'Length) ) );
File_Input.Value (Value => "");
end if;
end Get_Name;
end File_Selected;
Background : Gnoga.Gui.View.View_Type;
Frame : Gnoga.Gui.View.View_Type;
View : Gnoga.Gui.View.View_Type;
Form : Gnoga.Gui.Element.Form.Form_Type;
Dir_Line : Gnoga.Gui.Element.Form.Text_Type;
Up : Gnoga.Gui.Element.Common.Button_Type;
Cancel : Gnoga.Gui.Element.Common.Button_Type;
OK : Gnoga.Gui.Element.Common.Button_Type;
Event : Gnoga.Gui.Event_Info;
Exists : Boolean := False;
begin -- Selected_File
if Dialog_Control.Ongoing then
return (Picked => False);
end if;
Dialog_Control.Set_Ongoing (Value => True);
Set_Up (Background => Background, Frame => Frame, View => View);
Exists := True;
Form.Create (Parent => View);
Dir_Line.Create (Form => Form, Size => 100);
Dir_Line.Read_Only;
Up.Create (Parent => Form, Content => "Up");
Form.New_Line;
File_List.Create (Form => Form, Visible_Lines => 20);
Form.New_Line;
File_Input.Create (Form => Form, Size => 50);
Cancel.Create (Parent => Form, Content => "Cancel");
OK.Create (Parent => Form, Content => "OK");
Center (Background => Background, Frame => Frame);
All_Events : loop
Dir_Line.Value (Value => To_String (Current_Dir) );
Fill_List (Directory => To_String (Current_Dir), List => File_List);
Gnoga.Gui.Event_Queue.Dequeue (Element => Event);
if Event.Event = Closed_Text then
Result := (Picked => False);
Exists := False;
exit All_Events;
elsif Event.Event = "click" then
if Event.Object.Unique_ID = Up.Unique_ID then
Current_Dir := To_Unbounded_String (Ada.Directories.Containing_Directory (To_String (Current_Dir) ) );
elsif Event.Object.Unique_ID = File_List.Unique_ID then
File_Selected;
elsif Event.Object.Unique_ID = Cancel.Unique_ID then
Result := (Picked => False);
exit All_Events;
elsif Event.Object.Unique_ID = OK.Unique_ID then
Get_Name : declare
Name : constant String := File_Input.Value;
begin -- Get_Name
if Name /= "" then
Result :=
(Picked => True, Value => To_Unbounded_String (Ada.Directories.Compose (To_String (Current_Dir), Name) ) );
exit All_Events;
end if;
end Get_Name;
else
null;
end if;
else
null;
end if;
end loop All_Events;
Clean_Up (Background => Background, Dialog_Exists => Exists);
return Result;
exception -- Selected_File
when E : others =>
Gnoga.Log (Message => "Dialogs.Selected_File: " & Ada.Exceptions.Exception_Information (E) );
Clean_Up (Background => Background, Dialog_Exists => Exists);
return (Picked => False);
end Selected_File;
function Selected_Button (Title : in String; Text : in String; Button : in Text_List) return String is
type Button_List is array (Button'Range) of Gnoga.Gui.Element.Common.Button_Type;
Background : Gnoga.Gui.View.View_Type;
Frame : Gnoga.Gui.View.View_Type;
View : Gnoga.Gui.View.View_Type;
Title_View : Gnoga.Gui.View.View_Type;
Text_View : Gnoga.Gui.View.View_Type;
Button_View : Gnoga.Gui.View.View_Type;
Control : Button_List;
Exists : Boolean := False;
Event : Gnoga.Gui.Event_Info;
Result : Unbounded_String;
begin -- Selected_Button
if Dialog_Control.Ongoing then
return "";
end if;
Dialog_Control.Set_Ongoing (Value => True);
Set_Up (Background => Background, Frame => Frame, View => View);
Exists := True;
Title_View.Create (Parent => View);
Title_View.Text_Alignment (Value => Gnoga.Gui.Element.Center);
Title_View.Background_Color (Enum => Gnoga.Colors.Light_Blue);
Title_View.Put (Message => Title);
View.New_Line;
Text_View.Create (Parent => View);
Text_View.Text_Alignment (Value => Gnoga.Gui.Element.Left);
Text_View.Put (Message => Text);
View.New_Line;
Button_View.Create (Parent => View);
Button_View.Text_Alignment (Value => Gnoga.Gui.Element.Right);
Button_View.Background_Color (Enum => Gnoga.Colors.Light_Blue);
Create_Buttons : for I in Control'Range loop
Control (I).Create (Parent => Button_View, Content => To_String (Button (I) ) );
end loop Create_Buttons;
Center (Background => Background, Frame => Frame);
All_Events : loop
Gnoga.Gui.Event_Queue.Dequeue (Element => Event);
if Event.Event = Closed_Text then
Result := Null_Unbounded_String;
Exists := False;
exit All_Events;
elsif Event.Event = "click" then
Find_Button : for I in Control'Range loop
if Event.Object.Unique_ID = Control (I).Unique_ID then
Result := Button (I);
exit All_Events;
end if;
end loop Find_Button;
else
null;
end if;
end loop All_Events;
Clean_Up (Background => Background, Dialog_Exists => Exists);
return To_String (Result);
exception -- Selected_Button
when E : others =>
Gnoga.Log (Message => "Dialogs.Selected_Button: " & Ada.Exceptions.Exception_Information (E) );
Clean_Up (Background => Background, Dialog_Exists => Exists);
return "";
end Selected_Button;
procedure Set_Up
(Background : out Gnoga.Gui.View.View_Type; Frame : out Gnoga.Gui.View.View_Type; View : out Gnoga.Gui.View.View_Type)
is
Old_View : constant Gnoga.Gui.Pointer_To_Base_Class := Window.Get_View;
use type Gnoga.Gui.Pointer_To_Base_Class;
begin -- Set_Up
-- Create the Dialog Background view
Background.Create (Parent => Window);
-- Creating a view using Window as the parent sets the view as Window's main view. This sets it back to the original.
if Old_View /= null then
Window.Set_View (Object => Old_View.all);
end if;
-- Configure the Modal Background
Background.Fill_Parent;
Background.Background_Color (Value => "Grey");
Background.Opacity (Alpha => 1.0);
Background.Z_Index (Value => Integer'Last);
-- Create the containing view of the dialog
Frame.Create (Parent => Background);
Frame.Position (Value => Gnoga.Gui.Element.Fixed);
View.Create (Parent => Frame);
View.Background_Color (Value => "White");
exception -- Set_Up
when E : others =>
Gnoga.Log (Message => "Dialogs.Set_Up: " & Ada.Exceptions.Exception_Information (E) );
end Set_Up;
procedure Center (Background : in out Gnoga.Gui.View.View_Type; Frame : in out Gnoga.Gui.View.View_Type) is
Top_Offset : Integer := Integer'Max (Background.Height / 2 - Frame.Height / 2, 0);
Left_Offset : Integer := Integer'Max (Background.Width / 2 - Frame.Width / 2, 0);
begin -- Center
Frame.Top (Value => Background.Offset_From_Top + Top_Offset);
Frame.Left (Value => Background.Offset_From_Left + Left_Offset);
exception -- Center
when E : others =>
Gnoga.Log (Message => "Dialogs.Center: " & Ada.Exceptions.Exception_Information (E) );
end Center;
procedure Clean_Up (Background : in out Gnoga.Gui.View.View_Type; Dialog_Exists : in Boolean) is
Event : Gnoga.Gui.Event_Info;
use type Ada.Containers.Count_Type;
begin -- Clean_Up
Empty : loop
exit Empty when Gnoga.Gui.Event_Queue.Current_Use = 0;
Gnoga.Gui.Event_Queue.Dequeue (Element => Event);
end loop Empty;
Dialog_Control.Set_Ongoing (Value => False);
if Dialog_Exists then
Background.Remove;
else
Gnoga.Gui.Event_Queue.Enqueue (New_Item => (Event => To_Unbounded_String (Closed_Text), others => <>) );
end if;
exception -- Clean_Up
when E : others =>
Gnoga.Log (Message => "Dialogs.Clean_Up: " & Ada.Exceptions.Exception_Information (E) );
end Clean_Up;
end Dialogs;
|