| 1 | module terminal_module |
| 2 | implicit none |
| 3 | |
| 4 | ! Shared temp file for reducing disk I/O |
| 5 | character(len=*), parameter :: FUSS_TEMP = '/tmp/fuss_tmp.txt' |
| 6 | |
| 7 | contains |
| 8 | |
| 9 | subroutine enter_alternate_screen() |
| 10 | ! Switch to alternate screen buffer (like vim, less, htop) |
| 11 | ! This preserves the main terminal content |
| 12 | print '(A)', achar(27) // '[?1049h' |
| 13 | end subroutine enter_alternate_screen |
| 14 | |
| 15 | subroutine exit_alternate_screen() |
| 16 | ! Return to main screen buffer |
| 17 | ! Restores terminal to state before enter_alternate_screen() |
| 18 | print '(A)', achar(27) // '[?1049l' |
| 19 | end subroutine exit_alternate_screen |
| 20 | |
| 21 | subroutine clear_screen() |
| 22 | ! ANSI escape code to clear screen and move cursor to top |
| 23 | ! In alternate screen buffer, we just need to home cursor and clear |
| 24 | print '(A)', achar(27) // '[H' // achar(27) // '[2J' |
| 25 | end subroutine clear_screen |
| 26 | |
| 27 | subroutine enable_raw_mode() |
| 28 | integer :: status |
| 29 | ! Use stty cbreak mode (processes newlines correctly) instead of raw |
| 30 | call execute_command_line('stty cbreak -echo < /dev/tty', exitstat=status) |
| 31 | end subroutine enable_raw_mode |
| 32 | |
| 33 | subroutine disable_raw_mode() |
| 34 | integer :: status |
| 35 | ! Restore terminal |
| 36 | call execute_command_line('stty sane < /dev/tty', exitstat=status) |
| 37 | end subroutine disable_raw_mode |
| 38 | |
| 39 | subroutine flush_stdin() |
| 40 | integer :: status |
| 41 | ! Flush any buffered input from stdin |
| 42 | ! Use a simple bash read with very short timeout to drain buffer without blocking |
| 43 | call execute_command_line('while read -t 0.001 -n 1 < /dev/tty 2>/dev/null; do :; done', & |
| 44 | exitstat=status) |
| 45 | end subroutine flush_stdin |
| 46 | |
| 47 | subroutine wait_for_key(key) |
| 48 | character(len=1), intent(out) :: key |
| 49 | ! Flush any buffered input before waiting for keypress |
| 50 | ! This prevents accidental double-inputs after long operations |
| 51 | call flush_stdin() |
| 52 | call read_key(key) |
| 53 | end subroutine wait_for_key |
| 54 | |
| 55 | subroutine read_key_with_timeout(key, timeout_ms, timed_out) |
| 56 | ! Read a key with timeout (in milliseconds) |
| 57 | ! If timeout occurs, timed_out is set to .true. and key is set to null |
| 58 | character(len=1), intent(out) :: key |
| 59 | integer, intent(in) :: timeout_ms |
| 60 | logical, intent(out) :: timed_out |
| 61 | integer :: status |
| 62 | character(len=256) :: cmd |
| 63 | integer :: unit_num, iostat |
| 64 | |
| 65 | timed_out = .false. |
| 66 | key = achar(0) |
| 67 | |
| 68 | ! Use bash read with timeout to read a single character |
| 69 | ! Timeout is in fractional seconds |
| 70 | write(cmd, '(A,F6.3,A)') 'bash -c "read -t ', real(timeout_ms)/1000.0, & |
| 71 | ' -n 1 -s key < /dev/tty && echo -n $key" > ' // FUSS_TEMP // ' 2>/dev/null' |
| 72 | |
| 73 | call execute_command_line(trim(cmd), exitstat=status) |
| 74 | |
| 75 | if (status /= 0) then |
| 76 | ! Timeout occurred (read returned non-zero) |
| 77 | timed_out = .true. |
| 78 | return |
| 79 | end if |
| 80 | |
| 81 | ! Read the character from temp file |
| 82 | open(newunit=unit_num, file=FUSS_TEMP, status='old', action='read', iostat=iostat) |
| 83 | if (iostat == 0) then |
| 84 | read(unit_num, '(A1)', iostat=iostat) key |
| 85 | close(unit_num, status='delete') |
| 86 | if (iostat /= 0) then |
| 87 | ! Empty file means timeout |
| 88 | timed_out = .true. |
| 89 | key = achar(0) |
| 90 | end if |
| 91 | else |
| 92 | timed_out = .true. |
| 93 | end if |
| 94 | |
| 95 | ! Handle arrow keys and escape sequences |
| 96 | if (.not. timed_out .and. key == achar(27)) then |
| 97 | ! Detected ESC - try to read next char quickly |
| 98 | write(cmd, '(A)') 'bash -c "read -t 0.05 -n 1 -s key < /dev/tty && echo -n $key" > ' // & |
| 99 | FUSS_TEMP // ' 2>/dev/null' |
| 100 | call execute_command_line(trim(cmd), exitstat=status) |
| 101 | |
| 102 | if (status == 0) then |
| 103 | open(newunit=unit_num, file=FUSS_TEMP, status='old', action='read', iostat=iostat) |
| 104 | if (iostat == 0) then |
| 105 | read(unit_num, '(A1)', iostat=iostat) key |
| 106 | close(unit_num, status='delete') |
| 107 | |
| 108 | ! Check for arrow keys (ESC [ A/B/C/D) |
| 109 | if (key == '[') then |
| 110 | ! Read final character |
| 111 | write(cmd, '(A)') 'bash -c "read -t 0.05 -n 1 -s key < /dev/tty && echo -n $key" > ' // & |
| 112 | FUSS_TEMP // ' 2>/dev/null' |
| 113 | call execute_command_line(trim(cmd), exitstat=status) |
| 114 | if (status == 0) then |
| 115 | open(newunit=unit_num, file=FUSS_TEMP, status='old', action='read', iostat=iostat) |
| 116 | if (iostat == 0) then |
| 117 | read(unit_num, '(A1)', iostat=iostat) key |
| 118 | close(unit_num, status='delete') |
| 119 | end if |
| 120 | end if |
| 121 | else if (key >= 'a' .and. key <= 'z') then |
| 122 | ! Alt-letter: encode as control char |
| 123 | key = achar(1 + ichar(key) - ichar('a')) |
| 124 | end if |
| 125 | end if |
| 126 | else |
| 127 | ! Just ESC alone |
| 128 | key = achar(27) |
| 129 | end if |
| 130 | end if |
| 131 | end subroutine read_key_with_timeout |
| 132 | |
| 133 | subroutine read_key(key) |
| 134 | character(len=1), intent(out) :: key |
| 135 | character(len=1) :: next_char |
| 136 | integer :: iostat, tty_unit |
| 137 | |
| 138 | ! Open /dev/tty for reading |
| 139 | open(newunit=tty_unit, file='/dev/tty', status='old', action='read', iostat=iostat) |
| 140 | if (iostat /= 0) then |
| 141 | key = 'q' ! If we can't open tty, quit |
| 142 | return |
| 143 | end if |
| 144 | |
| 145 | ! Read one character |
| 146 | read(tty_unit, '(A1)', iostat=iostat, advance='no') key |
| 147 | |
| 148 | ! Check for escape sequence (arrow keys or alt-key combos) |
| 149 | if (key == achar(27)) then |
| 150 | ! Detected ESC - try to read next char (non-blocking check) |
| 151 | read(tty_unit, '(A1)', iostat=iostat, advance='no') next_char |
| 152 | |
| 153 | if (iostat == 0) then |
| 154 | ! Got a character after ESC |
| 155 | if (next_char == '[') then |
| 156 | ! Arrow key sequence: ESC[A/B/C/D - read final character |
| 157 | read(tty_unit, '(A1)', iostat=iostat, advance='no') next_char |
| 158 | if (iostat == 0) then |
| 159 | ! Encode arrow keys as unique control codes to avoid conflict with uppercase letters |
| 160 | ! Up=28, Down=29, Right=30, Left=31 |
| 161 | if (next_char == 'A') then |
| 162 | key = achar(28) ! Up arrow |
| 163 | else if (next_char == 'B') then |
| 164 | key = achar(29) ! Down arrow |
| 165 | else if (next_char == 'C') then |
| 166 | key = achar(30) ! Right arrow |
| 167 | else if (next_char == 'D') then |
| 168 | key = achar(31) ! Left arrow |
| 169 | else |
| 170 | ! Unknown escape sequence, return ESC |
| 171 | key = achar(27) |
| 172 | end if |
| 173 | end if |
| 174 | else if (next_char >= 'a' .and. next_char <= 'z') then |
| 175 | ! Alt-letter sequence: ESC followed by lowercase letter |
| 176 | ! Encode as ASCII control characters (1-26 for alt-a through alt-z) |
| 177 | key = achar(1 + ichar(next_char) - ichar('a')) |
| 178 | else |
| 179 | ! Unknown sequence after ESC, return ESC |
| 180 | key = achar(27) |
| 181 | end if |
| 182 | else |
| 183 | ! No character available after ESC - it's just ESC key alone |
| 184 | key = achar(27) |
| 185 | end if |
| 186 | end if |
| 187 | |
| 188 | close(tty_unit) |
| 189 | end subroutine read_key |
| 190 | |
| 191 | subroutine read_line(prompt, line) |
| 192 | character(len=*), intent(in) :: prompt |
| 193 | character(len=*), intent(out) :: line |
| 194 | integer :: status, iostat |
| 195 | |
| 196 | ! Show prompt |
| 197 | print '(A)', trim(prompt) |
| 198 | |
| 199 | ! Temporarily restore canonical mode for line input |
| 200 | call execute_command_line('stty icanon echo < /dev/tty', exitstat=status) |
| 201 | |
| 202 | ! Read line from terminal |
| 203 | read(*, '(A)', iostat=iostat) line |
| 204 | |
| 205 | ! Restore cbreak mode |
| 206 | call execute_command_line('stty cbreak -echo < /dev/tty', exitstat=status) |
| 207 | end subroutine read_line |
| 208 | |
| 209 | subroutine get_terminal_height(height) |
| 210 | integer, intent(out) :: height |
| 211 | integer :: iostat, unit_num, status |
| 212 | character(len=256) :: env_val |
| 213 | |
| 214 | height = 24 ! Default fallback |
| 215 | |
| 216 | ! Try method 1: Use stty size to get terminal dimensions |
| 217 | call execute_command_line('stty size < /dev/tty 2>/dev/null | cut -d" " -f1 > ' // FUSS_TEMP // '', & |
| 218 | exitstat=status) |
| 219 | |
| 220 | if (status == 0) then |
| 221 | open(newunit=unit_num, file=FUSS_TEMP, status='old', action='read', iostat=iostat) |
| 222 | if (iostat == 0) then |
| 223 | read(unit_num, *, iostat=iostat) height |
| 224 | close(unit_num, status='delete') |
| 225 | ! Sanity check |
| 226 | if (height >= 10 .and. height <= 200) return |
| 227 | end if |
| 228 | end if |
| 229 | |
| 230 | ! Try method 2: tput lines |
| 231 | call execute_command_line('tput lines < /dev/tty > ' // FUSS_TEMP // ' 2>/dev/null', exitstat=status) |
| 232 | |
| 233 | if (status == 0) then |
| 234 | open(newunit=unit_num, file=FUSS_TEMP, status='old', action='read', iostat=iostat) |
| 235 | if (iostat == 0) then |
| 236 | read(unit_num, *, iostat=iostat) height |
| 237 | close(unit_num, status='delete') |
| 238 | ! Sanity check |
| 239 | if (height >= 10 .and. height <= 200) return |
| 240 | end if |
| 241 | end if |
| 242 | |
| 243 | ! Try method 3: $LINES environment variable |
| 244 | call get_environment_variable('LINES', env_val, status=iostat) |
| 245 | if (iostat == 0 .and. len_trim(env_val) > 0) then |
| 246 | read(env_val, *, iostat=iostat) height |
| 247 | if (iostat == 0 .and. height >= 10 .and. height <= 200) return |
| 248 | end if |
| 249 | |
| 250 | ! Fallback |
| 251 | height = 24 |
| 252 | end subroutine get_terminal_height |
| 253 | |
| 254 | end module terminal_module |
| 255 |