| 1 | module platform_module |
| 2 | use iso_c_binding |
| 3 | implicit none |
| 4 | private |
| 5 | |
| 6 | public :: get_temp_dir, get_home_dir, get_path_separator, is_windows |
| 7 | public :: get_config_dir, get_cwd |
| 8 | public :: platform_copy_to_clipboard, platform_paste_from_clipboard |
| 9 | |
| 10 | interface |
| 11 | subroutine get_temp_dir_c(buffer, buffer_len, result_len) bind(C, name='get_temp_dir_f') |
| 12 | import :: c_char, c_int |
| 13 | character(kind=c_char), intent(out) :: buffer(*) |
| 14 | integer(c_int), value :: buffer_len |
| 15 | integer(c_int), intent(out) :: result_len |
| 16 | end subroutine |
| 17 | |
| 18 | subroutine get_home_dir_c(buffer, buffer_len, result_len) bind(C, name='get_home_dir_f') |
| 19 | import :: c_char, c_int |
| 20 | character(kind=c_char), intent(out) :: buffer(*) |
| 21 | integer(c_int), value :: buffer_len |
| 22 | integer(c_int), intent(out) :: result_len |
| 23 | end subroutine |
| 24 | |
| 25 | function get_path_separator_c() bind(C, name='get_path_separator_f') result(sep) |
| 26 | import :: c_char |
| 27 | character(kind=c_char) :: sep |
| 28 | end function |
| 29 | |
| 30 | function is_windows_c() bind(C, name='is_windows_f') result(res) |
| 31 | import :: c_int |
| 32 | integer(c_int) :: res |
| 33 | end function |
| 34 | |
| 35 | subroutine get_config_dir_c(buffer, buffer_len, result_len) bind(C, name='get_config_dir_f') |
| 36 | import :: c_char, c_int |
| 37 | character(kind=c_char), intent(out) :: buffer(*) |
| 38 | integer(c_int), value :: buffer_len |
| 39 | integer(c_int), intent(out) :: result_len |
| 40 | end subroutine |
| 41 | |
| 42 | subroutine get_cwd_c(buffer, buffer_len, result_len) bind(C, name='get_cwd_f') |
| 43 | import :: c_char, c_int |
| 44 | character(kind=c_char), intent(out) :: buffer(*) |
| 45 | integer(c_int), value :: buffer_len |
| 46 | integer(c_int), intent(out) :: result_len |
| 47 | end subroutine |
| 48 | |
| 49 | function copy_to_clipboard_c(text, text_len) bind(C, name='copy_to_clipboard_f') result(res) |
| 50 | import :: c_char, c_int |
| 51 | character(kind=c_char), intent(in) :: text(*) |
| 52 | integer(c_int), value :: text_len |
| 53 | integer(c_int) :: res |
| 54 | end function |
| 55 | |
| 56 | function paste_from_clipboard_c(buffer, buffer_len, result_len) bind(C, name='paste_from_clipboard_f') result(res) |
| 57 | import :: c_char, c_int |
| 58 | character(kind=c_char), intent(out) :: buffer(*) |
| 59 | integer(c_int), value :: buffer_len |
| 60 | integer(c_int), intent(out) :: result_len |
| 61 | integer(c_int) :: res |
| 62 | end function |
| 63 | end interface |
| 64 | |
| 65 | contains |
| 66 | |
| 67 | function get_temp_dir() result(path) |
| 68 | character(len=:), allocatable :: path |
| 69 | character(len=512) :: buffer |
| 70 | integer(c_int) :: result_len |
| 71 | |
| 72 | call get_temp_dir_c(buffer, 512_c_int, result_len) |
| 73 | path = trim(buffer(1:result_len)) |
| 74 | end function |
| 75 | |
| 76 | function get_home_dir() result(path) |
| 77 | character(len=:), allocatable :: path |
| 78 | character(len=512) :: buffer |
| 79 | integer(c_int) :: result_len |
| 80 | |
| 81 | call get_home_dir_c(buffer, 512_c_int, result_len) |
| 82 | path = trim(buffer(1:result_len)) |
| 83 | end function |
| 84 | |
| 85 | function get_path_separator() result(sep) |
| 86 | character(len=1) :: sep |
| 87 | sep = get_path_separator_c() |
| 88 | end function |
| 89 | |
| 90 | function is_windows() result(res) |
| 91 | logical :: res |
| 92 | res = (is_windows_c() /= 0) |
| 93 | end function |
| 94 | |
| 95 | function get_config_dir() result(path) |
| 96 | character(len=:), allocatable :: path |
| 97 | character(len=512) :: buffer |
| 98 | integer(c_int) :: result_len |
| 99 | |
| 100 | call get_config_dir_c(buffer, 512_c_int, result_len) |
| 101 | path = trim(buffer(1:result_len)) |
| 102 | end function |
| 103 | |
| 104 | function get_cwd() result(path) |
| 105 | character(len=:), allocatable :: path |
| 106 | character(len=1024) :: buffer |
| 107 | integer(c_int) :: result_len |
| 108 | |
| 109 | call get_cwd_c(buffer, 1024_c_int, result_len) |
| 110 | path = trim(buffer(1:result_len)) |
| 111 | end function |
| 112 | |
| 113 | function platform_copy_to_clipboard(text) result(success) |
| 114 | character(len=*), intent(in) :: text |
| 115 | logical :: success |
| 116 | integer(c_int) :: res |
| 117 | |
| 118 | res = copy_to_clipboard_c(text, int(len_trim(text), c_int)) |
| 119 | success = (res /= 0) |
| 120 | end function |
| 121 | |
| 122 | function platform_paste_from_clipboard() result(text) |
| 123 | character(len=:), allocatable :: text |
| 124 | character(len=100000), save :: buffer ! save prevents stack overflow warning |
| 125 | integer(c_int) :: result_len, res |
| 126 | |
| 127 | res = paste_from_clipboard_c(buffer, 100000_c_int, result_len) |
| 128 | if (res /= 0 .and. result_len > 0) then |
| 129 | text = trim(buffer(1:result_len)) |
| 130 | else |
| 131 | text = '' |
| 132 | end if |
| 133 | end function |
| 134 | |
| 135 | end module platform_module |
| 136 |