This repository has been archived by the owner on Nov 7, 2023. It is now read-only.
-
Notifications
You must be signed in to change notification settings - Fork 1
/
ui_dialogs.f90
502 lines (456 loc) · 21.2 KB
/
ui_dialogs.f90
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
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
! ui_dialogs.f90
!> @brief This module provides means for displaying GUI type dialogs.
module ui_dialogs
use iso_c_binding
use iso_fortran_env
use strings
implicit none
private
public :: DIALOG_RESULT_CANCEL
public :: DIALOG_RESULT_OK
public :: DIALOG_RESULT_YES
public :: DIALOG_RESULT_NO
public :: DIALOG_RESULT_RETRY
public :: DIALOG_RESULT_ABORT
public :: DIALOG_RESULT_IGNORE
public :: DIALOG_RESULT_CONTINUE
public :: MSGBX_NO_ICON
public :: MSGBX_NO_BUTTON
public :: MSGBX_ICON_ERROR
public :: MSGBX_ICON_WARNING
public :: MSGBX_ICON_QUESTION
public :: MSGBX_ICON_INFORMATION
public :: MSGBX_BTN_OK
public :: MSGBX_BTN_OK_CANCEL
public :: MSGBX_BTN_YES_NO
public :: MSGBX_BTN_YES_NO_CANCEL
public :: MSGBX_BTN_RETRY_CANCEL
public :: MSGBX_BTN_ABORT_RETRY_IGNORE
public :: MSGBX_BTN_CANCEL_RETRY_CONTINUE
public :: dialog_result
public :: text_output_dialog_result
public :: file_filter
public :: initialize_ui_environment
public :: clean_up_ui_environment
public :: show_open_file_dialog
public :: show_open_multifile_dialog
public :: show_save_file_dialog
public :: show_browse_folder_dialog
public :: show_message_box
! TO DO: Message-Box type dialog & associated icons, buttons, etc.
! ------------------------------------------------------------------------------
!> @brief The dialog result is a cancel button press.
integer(int32), parameter :: DIALOG_RESULT_CANCEL = 0
!> @brief The dialog result is an OK button press.
integer(int32), parameter :: DIALOG_RESULT_OK = 1
!> @brief The dialog result is a yes button press.
integer(int32), parameter :: DIALOG_RESULT_YES = 2
!> @brief The dialog result is a no button press.
integer(int32), parameter :: DIALOG_RESULT_NO = 3
!> @brief The dialog result is a retry button press.
integer(int32), parameter :: DIALOG_RESULT_RETRY = 4
!> @brief The dialog result is an abort button press.
integer(int32), parameter :: DIALOG_RESULT_ABORT = 5
!> @brief The dialog result is an ignore button press.
integer(int32), parameter :: DIALOG_RESULT_IGNORE = 6
!> @brief The dialog result is a continue button press.
integer(int32), parameter :: DIALOG_RESULT_CONTINUE = 7
!> @brief Indicates that no icon should be used for the dialog.
integer(int32), parameter :: MSGBX_NO_ICON = 0
!> @brief Indicates that no button should be used for the dialog.
integer(int32), parameter :: MSGBX_NO_BUTTON = 0
!> @brief Indicates that an error icon should be used for the dialog.
integer(int32), parameter :: MSGBX_ICON_ERROR = 1000
!> @brief Indicates that a warning icon should be used for the dialog.
integer(int32), parameter :: MSGBX_ICON_WARNING = 1001
!> @brief Indicates that a question icon should be used for the dialog.
integer(int32), parameter :: MSGBX_ICON_QUESTION = 1002
!> @brief Indicates that an information icon should be used for the dialog.
integer(int32), parameter :: MSGBX_ICON_INFORMATION = 1003
!> @brief Indicates that an OK button should be used.
integer(int32), parameter :: MSGBX_BTN_OK = 1004
!> @brief Indicates that an OK-Cancel button pair should be used.
integer(int32), parameter :: MSGBX_BTN_OK_CANCEL = 1005
!> @brief Indicates that a Yes-No button pair should be used.
integer(int32), parameter :: MSGBX_BTN_YES_NO = 1006
!> @brief Indicates that a Yes-No-Cancel button set should be used.
integer(int32), parameter :: MSGBX_BTN_YES_NO_CANCEL = 1007
!> @brief Indicates that a Retry-Cancel button set should be used.
integer(int32), parameter :: MSGBX_BTN_RETRY_CANCEL = 1008
!> @brief Indicates that an Abory-Retry-Ignore button set should be used.
integer(int32), parameter :: MSGBX_BTN_ABORT_RETRY_IGNORE = 1009
!> @brief Indicates that a Cancel-Retry-Continue button set should be used.
integer(int32), parameter :: MSGBX_BTN_CANCEL_RETRY_CONTINUE = 1010
! ------------------------------------------------------------------------------
!> @brief A type containing results from the dialog interaction.
type dialog_result
!> @brief The result flag.
integer(int32) :: result
end type
! ------------------------------------------------------------------------------
!> @brief A type containing results from a dialog that returns text such
!! as an open-file dialog.
type, extends(dialog_result) :: text_output_dialog_result
!> @brief A list of text returned by the dialog
type(string), allocatable, dimension(:) :: string_list
end type
! ------------------------------------------------------------------------------
!> @brief Defines a file-type filter.
type file_filter
!> @brief The filter name.
character(len = :), allocatable :: name
!> @brief The filter pattern.
character(len = :), allocatable :: pattern
end type
! ------------------------------------------------------------------------------
interface
!> @brief Initializes the UI environment thereby allowing utilization
!! of the dialogs. This call must be made prior to calling and dialog
!! routine.
!!
!! @return Returns true if the initialization was successful; else,
!! false.
function init_ui_env_c() bind(C, name = "init_ui_env_c") result(rst)
use iso_c_binding
logical(c_bool) :: rst
end function
!> @brief Cleans up and finalizes the UI environment. This should be
!! called after all UI interactions are complete.
subroutine clean_up_ui_environment() bind(C, name = "clean_up_ui_env_c")
! No arguments
end subroutine
!> @brief Shows the user an Open-File dialog. Notice, the UI
!! environment must be initialized prior to calling this routine.
!!
!! @param[out] nameBuffer A buffer to which the user-selected
!! filename will be written.
!! @param[in] bufferSize The size of @p nameBuffer.
!! @param[out] numChars The number of characters actually written
!! to @p nameBuffer. Notice, if the user presses cancel, or does
!! not select any file this value will be 0.
!! @param[in] nfilters The number of filter strings.
!! @param[in] filterName An array containing the filter names.
!! @param[in] filterPattern An array containing the filter pattern.
subroutine show_open_file_dialog_c(nameBuffer, bufferSize, numChars, &
nfilters, filterName, filterPattern) &
bind(C, name = "show_open_file_dialog_c")
use iso_c_binding
character(kind = c_char), intent(out) :: nameBuffer(*)
integer(c_int), intent(in), value :: bufferSize, nfilters
integer(c_int), intent(out) :: numChars
type(c_ptr), intent(in) :: filterName(nfilters), &
filterPattern(nfilters)
end subroutine
!> @brief Shows the user an Open-File dialog capable of returning
!! multiple files. Notice, the UI environment must be initialized prior
!! to calling this routine.
!!
!! @param[out] nameBuffers An array of string buffers where the !!
!! filenames will be written.
!! @param[in] numBuffers The number of buffers available.
!! @param[in] bufferSize The size of each buffer.
!! @param[out] numNames The number of names actually written.
!! @param[out] numChars An array containing the number of characters
!! written in each buffer.
!! @param[in] nfilters The number of filter strings.
!! @param[in] filterName An array containing the filter names.
!! @param[in] filterPattern An array containing the filter pattern.
subroutine show_multi_file_open_file_dialog_c(nameBuffers, numBuffers, &
bufferSize, numNames, numChars, nfilters, filterName, &
filterPattern) &
bind(C, name = "show_multi_file_open_file_dialog_c")
use iso_c_binding
integer(c_int), intent(in), value :: numBuffers, bufferSize, &
nfilters
type(c_ptr), intent(out) :: nameBuffers(numBuffers)
integer(c_int), intent(out) :: numNames, numChars(numBuffers)
type(c_ptr), intent(in) :: filterName(nfilters), &
filterPattern(nfilters)
end subroutine
!> @brief Shows the user a Save-File dialog. Notice, the UI environment
!! must be initialized prior to calling this routine.
!!
!! @param[in] defaultExt The default file extension to append.
!! @param[in] nfilters The number of filter strings.
!! @param[in] filterName An array containing the filter names.
!! @param[in] filterPattern An array containing the filter pattern.
!! @param[out] name The user-defined filename.
!! @param[in] bufferSize the available size of @p name.
!! @param[out] numChars The actual number of characters written to
!! @p name.
subroutine show_save_file_dialog_c(defaultExt, nfilters, filterName, &
filterPattern, name, bufferSize, numChars) &
bind(C, name = "show_save_file_dialog_c")
use iso_c_binding
character(kind = c_char), intent(in) :: defaultExt(*)
integer(c_int), intent(in), value :: nfilters, bufferSize
type(c_ptr), intent(in) :: filterName(nfilters), &
filterPattern(nfilters)
character(kind = c_char), intent(out) :: name(*)
integer(c_int), intent(out) :: numChars
end subroutine
!> @brief Shows the user a Browse-Folder dialog. Notice, the UI
!! environment must be initialized prior to calling this routine.
!!
!! @param[out] buffer A buffer to which the output will be written.
!! @param[in] bufferSize The available size of @p buffer.
!! @param[out] numChars The actual number of characters written to
!! @p buffer.
subroutine show_browse_folder_dialog_c(buffer, bufferSize, numChars) &
bind(C, name = "show_browse_folder_dialog_c")
use iso_c_binding
character(kind = c_char), intent(out) :: buffer(*)
integer(c_int), intent(in), value :: bufferSize
integer(c_int), intent(out) :: numChars
end subroutine
!> @brief Shows the user a message box.
!!
!! @param[in] parent A pointer to the parent window. This can be null
!! in the event there isn't a parent window.
!! @param[in] txt The message box text.
!! @param[in] title The title of the message box.
!! @param[in] buttons
!! @param[in] icon
!!
!! @return The dialog result.
function show_message_box_c(parent, txt, title, buttons, icon) &
result(rst) bind(C, name = "show_message_box_c")
use iso_c_binding
type(c_ptr), intent(in), value :: parent
character(kind = c_char), intent(in) :: txt(*), title(*)
integer(c_int), intent(in), value :: buttons, icon
integer(c_int) :: rst
end function
end interface
! ------------------------------------------------------------------------------
contains
! ------------------------------------------------------------------------------
!> @brief Initializes the UI environment thereby allowing utilization
!! of the dialogs. This call must be made prior to calling and dialog
!! routine.
!!
!! @return Returns true if the initialization was successful; else,
!! false.
function initialize_ui_environment() result(rst)
! Arguments
logical :: rst
! Process
rst = logical(init_ui_env_c())
end function
! ------------------------------------------------------------------------------
!> @brief Shows the user an Open-File dialog capable of single-file
!! selection.
!!
!! @param[in] filters An optional array containing file filter information.
!!
!! @return The results from the dialog.
function show_open_file_dialog(filters) result(rst)
! Arguments
class(file_filter), intent(in), dimension(:), optional :: filters
type(text_output_dialog_result) :: rst
! Parameters
integer(c_int), parameter :: bufferSize = 2048
integer(c_int), parameter :: maxFilters = 100
! Local Variables
integer(c_int) :: i, nChars, nfilters
character(kind = c_char, len = bufferSize) :: buffer
type(c_ptr) :: nullarray(1), namePtrs(maxFilters), &
patternPtrs(maxFilters)
character(len = 1024), dimension(maxFilters), target :: nameList, &
patternList
! Initialization
nullarray = c_null_ptr
! Show the user the dialog
if (present(filters)) then
nfilters = min(size(filters), maxFilters)
do i = 1, nfilters
nameList(i) = filters(i)%name // C_NULL_CHAR
patternList(i) = filters(i)%pattern // C_NULL_CHAR
namePtrs(i) = c_loc(nameList(i))
patternPtrs(i) = c_loc(patternList(i))
end do
call show_open_file_dialog_c(buffer, bufferSize, nChars, nfilters, &
namePtrs(1:nfilters), patternPtrs(1:nfilters))
else
call show_open_file_dialog_c(buffer, bufferSize, nChars, 0, &
nullarray, nullarray)
end if
! Copy the buffer back to a Fortran-friendly string
if (nChars > 0) then
rst%result = DIALOG_RESULT_OK
allocate(rst%string_list(1))
rst%string_list(1)%str = to_fortran_string(buffer, nChars)
else
rst%result = DIALOG_RESULT_CANCEL
allocate(rst%string_list(0))
end if
end function
! ------------------------------------------------------------------------------
!> @brief Shows the user an Open-File dialog capable of multiple-file
!! selection.
!!
!! @param[in] filters An optional array containing file filter information.
!!
!! @return The results from the dialog.
function show_open_multifile_dialog(filters) result(rst)
! Arguments
! Arguments
class(file_filter), intent(in), dimension(:), optional :: filters
type(text_output_dialog_result) :: rst
! Parameters
integer(c_int), parameter :: numBuffers = 1000
integer(c_int), parameter :: bufferSize = 2048
integer(c_int), parameter :: maxFilters = 100
! Local Variables
integer(c_int) :: i, nFilters, nNames, nChars(numBuffers)
character(len = bufferSize), dimension(numBuffers), target :: buffer
type(c_ptr) :: nullarray(1), namePtrs(maxFilters), &
patternPtrs(maxFilters), bufferPtrs(numBuffers)
character(len = 1024), dimension(maxFilters), target :: nameList, &
patternList
! Initialization
nullarray = C_NULL_PTR
do i = 1, numBuffers
bufferPtrs(i) = c_loc(buffer(i))
end do
! Show the user the dialog
if (present(filters)) then
nFilters = min(size(filters), maxFilters)
do i = 1, nFilters
nameList(i) = filters(i)%name // C_NULL_CHAR
patternList(i) = filters(i)%pattern // C_NULL_CHAR
namePtrs(i) = c_loc(nameList(i))
patternPtrs(i) = c_loc(patternList(i))
end do
call show_multi_file_open_file_dialog_c(bufferPtrs, numBuffers, &
bufferSize, nNames, nChars, nFilters, namePtrs(1:nFilters), &
patternPtrs(1:nFilters))
else
call show_multi_file_open_file_dialog_c(bufferPtrs, numBuffers, &
bufferSize, nNames, nChars, 0, nullarray, nullarray)
end if
! Collect the output from the buffer
if (nNames > 0) then
rst%result = DIALOG_RESULT_OK
allocate(rst%string_list(nNames))
do i = 1, nNames
rst%string_list(i)%str = to_fortran_string(buffer(i), nChars(i))
end do
else
rst%result = DIALOG_RESULT_CANCEL
allocate(rst%string_list(0))
end if
end function
! ------------------------------------------------------------------------------
!> @brief Shows the user a Save-File dialog.
!!
!! @param[in] defaultExt The default extension to append to the filename in
!! the event the user does not specify an extension (e.g. "txt").
!! @param[in] filters An array containing file filter information.
!!
!! @return The results from the dialog.
function show_save_file_dialog(defaultExt, filters) result(rst)
! Arguments
character(len = *), intent(in) :: defaultExt
class(file_filter), intent(in), dimension(:), optional :: filters
type(text_output_dialog_result) :: rst
! Parameters
integer(c_int), parameter :: bufferSize = 2048
integer(c_int), parameter :: maxFilters = 100
! Local Variables
integer(c_int) :: i, nchars, nfilters
character(kind = c_char, len = bufferSize) :: buffer
type(c_ptr) :: nullarray(1), namePtrs(maxFilters), &
patternPtrs(maxFilters)
character(len = 1024), dimension(maxFilters), target :: nameList, &
patternList
character(kind = c_char, len = :), allocatable :: ext
! Initialization
nullarray = C_NULL_PTR
ext = defaultExt // C_NULL_CHAR
! Show the user the dialog
if (present(filters)) then
nfilters = min(size(filters), maxFilters)
do i = 1, nfilters
nameList(i) = filters(i)%name // C_NULL_CHAR
patternList(i) = filters(i)%pattern // C_NULL_CHAR
namePtrs(i) = c_loc(nameList(i))
patternPtrs(i) = c_loc(patternList(i))
end do
call show_save_file_dialog_c(ext, nfilters, namePtrs(1:nfilters), &
patternPtrs(1:nfilters), buffer, bufferSize, nchars)
else
call show_save_file_dialog_c(ext, 0, nullarray, nullarray, buffer, &
bufferSize, nchars)
end if
! Collect the output from the buffer
if (nchars > 0) then
rst%result = DIALOG_RESULT_OK
allocate(rst%string_list(1))
rst%string_list(1)%str = to_fortran_string(buffer, nchars)
else
rst%result = DIALOG_RESULT_CANCEL
allocate(rst%string_list(0))
end if
end function
! ------------------------------------------------------------------------------
!> @brief Shows the user a dialog allowing them to browse to a folder.
!!
!! @return The results from the dialog.
function show_browse_folder_dialog() result(rst)
! Arguments
type(text_output_dialog_result) :: rst
! Parameters
integer(c_int), parameter :: bufferSize = 2048
! Local Variables
integer(c_int) :: nchars
character(kind = c_char, len = bufferSize) :: buffer
! Process
call show_browse_folder_dialog_c(buffer, bufferSize, nchars)
if (nchars > 0) then
rst%result = DIALOG_RESULT_OK
allocate(rst%string_list(1))
rst%string_list(1)%str = to_fortran_string(buffer, nchars)
else
rst%result = DIALOG_RESULT_CANCEL
allocate(Rst%string_list(0))
end if
end function
! ------------------------------------------------------------------------------
!> @brief Shows the user a message box dialog.
!!
!! @param[in] txt The text to display in the message box.
!! @param[in] title The title to display in the header of the message box.
!! @param[in] buttons Defines what button group to display. The following
!! choices are acceptable: MSGBX_BTN_OK, MSGBX_BTN_OK_CANCEL,
!! MSGBX_BTN_YES_NO, MSGBX_BTN_YES_NO_CANCEL, MSGBX_BTN_RETRY_CANCEL,
!! MSGBX_BTN_ABORT_RETRY_IGNORE, MSGBX_BTN_CANCEL_RETRY_CONTINUE.
!! @param[in] icon Defines what icons to display. The following choices
!! are acceptable: MSGBX_NO_ICON, MSGBX_NO_BUTTON, MSGBX_ICON_ERROR,
!! MSGBX_ICON_WARNING, MSGBX_ICON_QUESTION, MSGBX_ICON_INFORMATION.
!! @param[in] parent An optional argument defining a pointer to the parent
!! window. If not supplied, no parent is assumed.
!!
!! @return The results from the dialog.
function show_message_box(txt, title, buttons, icon, parent) result(rst)
! Arguments
character(len = *), intent(in) :: txt, title
integer(int32), intent(in) :: buttons, icon
type(c_ptr), optional :: parent
type(dialog_result) :: rst
! Local Variables
character(kind = c_char, len = :), allocatable :: ctxt, ctitle
type(c_ptr) :: parentPtr
! Initialization
ctxt = txt // C_NULL_CHAR
ctitle = title // C_NULL_CHAR
if (present(parent)) then
parentPtr = parent
else
parentPtr = c_null_ptr
end if
! Process
rst%result = show_message_box_c(parentPtr, ctxt, ctitle, buttons, icon)
end function
! ------------------------------------------------------------------------------
end module