| 1 | program fortress_clean |
| 2 | use iso_fortran_env, only: output_unit, error_unit |
| 3 | implicit none |
| 4 | |
| 5 | ! Constants |
| 6 | integer, parameter :: MAX_PATH = 512 |
| 7 | integer, parameter :: MAX_FILES = 500 |
| 8 | character(len=*), parameter :: ESC = char(27) |
| 9 | character(len=*), parameter :: CLEAR = ESC // "[2J" // ESC // "[H" |
| 10 | character(len=*), parameter :: BOLD = ESC // "[1m" |
| 11 | character(len=*), parameter :: DIM = ESC // "[2m" |
| 12 | character(len=*), parameter :: REVERSE = ESC // "[7m" |
| 13 | character(len=*), parameter :: RESET = ESC // "[0m" |
| 14 | |
| 15 | ! Variables |
| 16 | character(len=MAX_PATH) :: current_dir, parent_dir, temp_dir |
| 17 | character(len=MAX_PATH), dimension(MAX_FILES) :: current_files, parent_files |
| 18 | logical, dimension(MAX_FILES) :: current_is_dir, parent_is_dir |
| 19 | integer :: current_count, parent_count |
| 20 | integer :: selected = 1 |
| 21 | integer :: parent_selected = -1 |
| 22 | character(len=1) :: key |
| 23 | logical :: running = .true. |
| 24 | integer :: i, rows, cols |
| 25 | |
| 26 | ! Initialize |
| 27 | current_dir = get_pwd() |
| 28 | parent_dir = get_parent_path(current_dir) |
| 29 | |
| 30 | ! Setup terminal |
| 31 | call execute_command_line("stty -icanon -echo min 1 time 0 2>/dev/null") |
| 32 | |
| 33 | ! Main loop |
| 34 | do while (running) |
| 35 | ! Get files |
| 36 | call get_file_list(current_dir, current_files, current_is_dir, current_count) |
| 37 | call get_file_list(parent_dir, parent_files, parent_is_dir, parent_count) |
| 38 | |
| 39 | ! Find current dir in parent |
| 40 | parent_selected = find_in_parent(current_dir, parent_files, parent_count) |
| 41 | |
| 42 | ! Get terminal size |
| 43 | call get_term_size(rows, cols) |
| 44 | |
| 45 | ! Draw interface |
| 46 | write(output_unit, '(a)', advance='no') CLEAR |
| 47 | call draw_interface(rows, cols) |
| 48 | |
| 49 | ! Get input |
| 50 | read(*, '(a1)', advance='no') key |
| 51 | |
| 52 | ! Handle input |
| 53 | select case(ichar(key)) |
| 54 | case(27) ! ESC sequence |
| 55 | call read_arrow_key(key) |
| 56 | select case(key) |
| 57 | case('A') ! Up |
| 58 | if (selected > 1) selected = selected - 1 |
| 59 | case('B') ! Down |
| 60 | if (selected < current_count) selected = selected + 1 |
| 61 | case('C') ! Right - enter |
| 62 | if (current_is_dir(selected)) then |
| 63 | if (trim(current_files(selected)) == "..") then |
| 64 | temp_dir = current_dir |
| 65 | current_dir = parent_dir |
| 66 | parent_dir = get_parent_path(current_dir) |
| 67 | selected = max(1, find_in_parent(temp_dir, current_files, MAX_FILES)) |
| 68 | else if (trim(current_files(selected)) /= ".") then |
| 69 | parent_dir = current_dir |
| 70 | current_dir = join_path(current_dir, current_files(selected)) |
| 71 | selected = 1 |
| 72 | end if |
| 73 | end if |
| 74 | case('D') ! Left - back |
| 75 | if (current_dir /= "/") then |
| 76 | temp_dir = current_dir |
| 77 | current_dir = parent_dir |
| 78 | parent_dir = get_parent_path(current_dir) |
| 79 | selected = max(1, find_in_parent(temp_dir, current_files, MAX_FILES)) |
| 80 | end if |
| 81 | end select |
| 82 | case(113, 81) ! 'q' or 'Q' |
| 83 | running = .false. |
| 84 | end select |
| 85 | end do |
| 86 | |
| 87 | ! Cleanup |
| 88 | call execute_command_line("stty icanon echo 2>/dev/null") |
| 89 | write(output_unit, '(a)', advance='no') CLEAR |
| 90 | write(output_unit, '(a)') "Thanks for using FORTRESS!" |
| 91 | |
| 92 | contains |
| 93 | |
| 94 | function get_pwd() result(path) |
| 95 | character(len=MAX_PATH) :: path |
| 96 | integer :: unit, ios |
| 97 | |
| 98 | call execute_command_line("pwd > .fortress_pwd 2>/dev/null", wait=.true.) |
| 99 | open(newunit=unit, file=".fortress_pwd", status='old', iostat=ios) |
| 100 | if (ios == 0) then |
| 101 | read(unit, '(a)') path |
| 102 | close(unit) |
| 103 | else |
| 104 | path = "." |
| 105 | end if |
| 106 | call execute_command_line("rm -f .fortress_pwd 2>/dev/null") |
| 107 | end function get_pwd |
| 108 | |
| 109 | function get_parent_path(path) result(parent) |
| 110 | character(len=*), intent(in) :: path |
| 111 | character(len=MAX_PATH) :: parent |
| 112 | integer :: pos |
| 113 | |
| 114 | pos = index(path, "/", back=.true.) |
| 115 | if (pos > 1) then |
| 116 | parent = path(1:pos-1) |
| 117 | else if (pos == 1) then |
| 118 | parent = "/" |
| 119 | else |
| 120 | parent = "." |
| 121 | end if |
| 122 | end function get_parent_path |
| 123 | |
| 124 | function join_path(base, name) result(full) |
| 125 | character(len=*), intent(in) :: base, name |
| 126 | character(len=MAX_PATH) :: full |
| 127 | |
| 128 | if (base == "/") then |
| 129 | full = "/" // trim(name) |
| 130 | else |
| 131 | full = trim(base) // "/" // trim(name) |
| 132 | end if |
| 133 | end function join_path |
| 134 | |
| 135 | function find_in_parent(dir, files, count) result(idx) |
| 136 | character(len=*), intent(in) :: dir |
| 137 | character(len=*), dimension(*), intent(in) :: files |
| 138 | integer, intent(in) :: count |
| 139 | integer :: idx, pos |
| 140 | character(len=256) :: basename |
| 141 | |
| 142 | pos = index(dir, "/", back=.true.) |
| 143 | if (pos > 0) then |
| 144 | basename = dir(pos+1:) |
| 145 | else |
| 146 | basename = dir |
| 147 | end if |
| 148 | |
| 149 | do idx = 1, count |
| 150 | if (trim(files(idx)) == trim(basename)) return |
| 151 | end do |
| 152 | idx = 1 |
| 153 | end function find_in_parent |
| 154 | |
| 155 | subroutine get_file_list(dir, files, is_dir, count) |
| 156 | character(len=*), intent(in) :: dir |
| 157 | character(len=*), dimension(*), intent(out) :: files |
| 158 | logical, dimension(*), intent(out) :: is_dir |
| 159 | integer, intent(out) :: count |
| 160 | integer :: unit, ios, stat |
| 161 | character(len=MAX_PATH) :: fullpath |
| 162 | |
| 163 | call execute_command_line("ls -1a '" // trim(dir) // "' > .fortress_ls 2>/dev/null", wait=.true.) |
| 164 | |
| 165 | open(newunit=unit, file=".fortress_ls", status='old', iostat=ios) |
| 166 | if (ios /= 0) then |
| 167 | count = 0 |
| 168 | return |
| 169 | end if |
| 170 | |
| 171 | count = 0 |
| 172 | do |
| 173 | count = count + 1 |
| 174 | if (count > MAX_FILES) exit |
| 175 | read(unit, '(a)', iostat=ios) files(count) |
| 176 | if (ios /= 0) then |
| 177 | count = count - 1 |
| 178 | exit |
| 179 | end if |
| 180 | |
| 181 | fullpath = join_path(dir, files(count)) |
| 182 | call execute_command_line("test -d '" // trim(fullpath) // "'", exitstat=stat, wait=.true.) |
| 183 | is_dir(count) = (stat == 0) |
| 184 | end do |
| 185 | |
| 186 | close(unit) |
| 187 | call execute_command_line("rm -f .fortress_ls 2>/dev/null") |
| 188 | end subroutine get_file_list |
| 189 | |
| 190 | subroutine get_term_size(r, c) |
| 191 | integer, intent(out) :: r, c |
| 192 | integer :: unit, ios |
| 193 | |
| 194 | call execute_command_line("tput lines > .fortress_size 2>/dev/null", wait=.true.) |
| 195 | open(newunit=unit, file=".fortress_size", status='old', iostat=ios) |
| 196 | if (ios == 0) then |
| 197 | read(unit, *) r |
| 198 | close(unit) |
| 199 | else |
| 200 | r = 24 |
| 201 | end if |
| 202 | |
| 203 | call execute_command_line("tput cols > .fortress_size 2>/dev/null", wait=.true.) |
| 204 | open(newunit=unit, file=".fortress_size", status='old', iostat=ios) |
| 205 | if (ios == 0) then |
| 206 | read(unit, *) c |
| 207 | close(unit) |
| 208 | else |
| 209 | c = 80 |
| 210 | end if |
| 211 | |
| 212 | call execute_command_line("rm -f .fortress_size 2>/dev/null") |
| 213 | end subroutine get_term_size |
| 214 | |
| 215 | subroutine draw_interface(r, c) |
| 216 | integer, intent(in) :: r, c |
| 217 | integer :: left_w, i |
| 218 | character(len=256) :: fname |
| 219 | |
| 220 | left_w = c * 3 / 10 |
| 221 | |
| 222 | ! Header |
| 223 | write(output_unit, '(a)') BOLD // "FORTRESS" // RESET // " - " // trim(current_dir) |
| 224 | |
| 225 | ! Files |
| 226 | do i = 1, min(r-3, max(parent_count, current_count)) |
| 227 | ! Parent pane |
| 228 | if (i <= parent_count) then |
| 229 | fname = parent_files(i) |
| 230 | if (parent_is_dir(i) .and. fname /= "." .and. fname /= "..") then |
| 231 | fname = trim(fname) // "/" |
| 232 | end if |
| 233 | if (i == parent_selected) then |
| 234 | write(output_unit, '(a)', advance='no') DIM // BOLD // fname(1:min(len_trim(fname),left_w)) // RESET |
| 235 | else |
| 236 | write(output_unit, '(a)', advance='no') DIM // fname(1:min(len_trim(fname),left_w)) // RESET |
| 237 | end if |
| 238 | write(output_unit, '(a)', advance='no') repeat(" ", max(0, left_w - len_trim(fname))) |
| 239 | else |
| 240 | write(output_unit, '(a)', advance='no') repeat(" ", left_w) |
| 241 | end if |
| 242 | |
| 243 | ! Separator |
| 244 | write(output_unit, '(a)', advance='no') " │ " |
| 245 | |
| 246 | ! Current pane |
| 247 | if (i <= current_count) then |
| 248 | fname = current_files(i) |
| 249 | if (current_is_dir(i) .and. fname /= "." .and. fname /= "..") then |
| 250 | fname = trim(fname) // "/" |
| 251 | end if |
| 252 | if (i == selected) then |
| 253 | write(output_unit, '(a)') REVERSE // trim(fname) // RESET |
| 254 | else |
| 255 | write(output_unit, '(a)') trim(fname) |
| 256 | end if |
| 257 | else |
| 258 | write(output_unit, *) |
| 259 | end if |
| 260 | end do |
| 261 | |
| 262 | ! Footer |
| 263 | write(output_unit, '(a,i0,a)') DIM // "↑↓:nav →:enter ←:back q:quit [", selected, "/" // trim(adjustl(char(current_count))) // "]" // RESET |
| 264 | end subroutine draw_interface |
| 265 | |
| 266 | subroutine read_arrow_key(k) |
| 267 | character(len=1), intent(out) :: k |
| 268 | character(len=1) :: ch |
| 269 | |
| 270 | read(*, '(a1)', advance='no') ch |
| 271 | if (ch == '[') then |
| 272 | read(*, '(a1)', advance='no') k |
| 273 | else |
| 274 | k = ch |
| 275 | end if |
| 276 | end subroutine read_arrow_key |
| 277 | |
| 278 | end program fortress_clean |