| 1 | module input_handler_module |
| 2 | use iso_fortran_env, only: input_unit, int8, error_unit |
| 3 | use terminal_io_module, only: terminal_read_char, terminal_read_char_escape |
| 4 | implicit none |
| 5 | private |
| 6 | |
| 7 | public :: get_key_input, key_type, mouse_event_t |
| 8 | |
| 9 | ! Key type constants |
| 10 | enum, bind(C) |
| 11 | enumerator :: KEY_NORMAL = 0 |
| 12 | enumerator :: KEY_CTRL |
| 13 | enumerator :: KEY_ALT |
| 14 | enumerator :: KEY_SPECIAL |
| 15 | enumerator :: KEY_MOUSE |
| 16 | end enum |
| 17 | |
| 18 | type :: key_type |
| 19 | integer :: type = KEY_NORMAL |
| 20 | character(len=32) :: value = '' |
| 21 | end type key_type |
| 22 | |
| 23 | type :: mouse_event_t |
| 24 | integer :: button ! 0=left, 1=middle, 2=right |
| 25 | integer :: row ! Terminal row (1-based) |
| 26 | integer :: col ! Terminal column (1-based) |
| 27 | logical :: pressed ! True=press, False=release |
| 28 | logical :: shift ! Shift modifier |
| 29 | logical :: alt ! Alt modifier |
| 30 | logical :: ctrl ! Ctrl modifier |
| 31 | end type mouse_event_t |
| 32 | |
| 33 | character(len=*), parameter :: ESC = char(27) |
| 34 | |
| 35 | contains |
| 36 | |
| 37 | subroutine get_key_input(key_str, status) |
| 38 | character(len=*), intent(out) :: key_str |
| 39 | integer, intent(out) :: status |
| 40 | character :: ch |
| 41 | integer :: char_code |
| 42 | |
| 43 | key_str = '' |
| 44 | status = -1 |
| 45 | |
| 46 | ! Read single character using raw mode function (50ms timeout when idle) |
| 47 | char_code = terminal_read_char() |
| 48 | |
| 49 | if (char_code < 0) then |
| 50 | return |
| 51 | end if |
| 52 | |
| 53 | ch = achar(char_code) |
| 54 | status = 0 |
| 55 | |
| 56 | ! Check for special keys |
| 57 | select case(iachar(ch)) |
| 58 | case(0) ! Ctrl-Space (NULL character) |
| 59 | key_str = 'ctrl-space' |
| 60 | case(27) ! ESC |
| 61 | call handle_escape_sequence(key_str) |
| 62 | case(9) ! Tab |
| 63 | key_str = 'tab' |
| 64 | case(10, 13) ! Enter |
| 65 | key_str = 'enter' |
| 66 | case(8) ! Ctrl-H |
| 67 | key_str = 'ctrl-h' |
| 68 | case(26) ! Ctrl-Z |
| 69 | key_str = 'ctrl-z' |
| 70 | case(31) ! Ctrl-/ and Ctrl-? (both send ASCII 31) |
| 71 | key_str = 'ctrl-/' |
| 72 | case(7) ! Ctrl-G (goto) |
| 73 | key_str = 'ctrl-g' |
| 74 | case(29) ! Ctrl-] (for redo) |
| 75 | key_str = 'ctrl-]' |
| 76 | case(1:6, 11:12, 14:25, 28) ! Ctrl keys (excluding Ctrl-G, Ctrl-H, Ctrl-Z, Tab, Enter, ESC, and Ctrl-]) |
| 77 | write(key_str, '(a,a)') 'ctrl-', achar(iachar('a') + iachar(ch) - 1) |
| 78 | case(127) ! Backspace |
| 79 | key_str = 'backspace' |
| 80 | case default |
| 81 | key_str = ch |
| 82 | end select |
| 83 | |
| 84 | end subroutine get_key_input |
| 85 | |
| 86 | subroutine handle_escape_sequence(key_str) |
| 87 | character(len=*), intent(out) :: key_str |
| 88 | character :: ch, ch1, ch2, ch3, modifier_ch |
| 89 | integer :: char_code, ios |
| 90 | |
| 91 | key_str = 'esc' |
| 92 | |
| 93 | ! Try to read next character (with fast 5ms timeout for escape sequences) |
| 94 | char_code = terminal_read_char_escape() |
| 95 | if (char_code < 0) return |
| 96 | ch1 = achar(char_code) |
| 97 | |
| 98 | if (ch1 == '[') then |
| 99 | ! CSI sequence (or Alt+[ if no valid sequence follows) |
| 100 | char_code = terminal_read_char_escape() |
| 101 | if (char_code < 0) then |
| 102 | ! Timeout - no character follows, this is Alt+[ |
| 103 | key_str = 'alt-[' |
| 104 | return |
| 105 | end if |
| 106 | ch2 = achar(char_code) |
| 107 | |
| 108 | select case(ch2) |
| 109 | case('A') |
| 110 | key_str = 'up' |
| 111 | case('B') |
| 112 | key_str = 'down' |
| 113 | case('C') |
| 114 | key_str = 'right' |
| 115 | case('D') |
| 116 | key_str = 'left' |
| 117 | case('H') |
| 118 | key_str = 'home' |
| 119 | case('F') |
| 120 | key_str = 'end' |
| 121 | case('Z') |
| 122 | ! Shift+Tab sends ESC[Z |
| 123 | key_str = 'shift-tab' |
| 124 | case('3') |
| 125 | ! Could be delete or Alt+Delete |
| 126 | char_code = terminal_read_char_escape() |
| 127 | if (char_code >= 0) then |
| 128 | ch3 = achar(char_code) |
| 129 | if (ch3 == '~') then |
| 130 | key_str = 'delete' |
| 131 | else if (ch3 == ';') then |
| 132 | ! Modified delete: ESC [ 3 ; modifier ~ |
| 133 | ! Read the modifier |
| 134 | char_code = terminal_read_char_escape() |
| 135 | if (char_code >= 0) then |
| 136 | modifier_ch = achar(char_code) |
| 137 | ! Read the terminating ~ |
| 138 | char_code = terminal_read_char_escape() |
| 139 | if (char_code >= 0 .and. achar(char_code) == '~') then |
| 140 | ! Check modifier: 3 = Alt |
| 141 | if (modifier_ch == '3') then |
| 142 | key_str = 'alt-delete' |
| 143 | else |
| 144 | key_str = 'delete' ! Other modified deletes default to delete |
| 145 | end if |
| 146 | end if |
| 147 | end if |
| 148 | end if |
| 149 | end if |
| 150 | case('5') |
| 151 | ! Could be page up |
| 152 | char_code = terminal_read_char_escape() |
| 153 | if (char_code >= 0) then |
| 154 | ch3 = achar(char_code) |
| 155 | ios = 0 |
| 156 | else |
| 157 | ios = -1 |
| 158 | end if |
| 159 | if (ios == 0 .and. ch3 == '~') then |
| 160 | key_str = 'pageup' |
| 161 | else if (ios == 0 .and. ch3 == ';') then |
| 162 | ! Modified page up (e.g., shift+pageup) |
| 163 | call handle_modified_special_key(key_str, 5) |
| 164 | end if |
| 165 | case('6') |
| 166 | ! Could be page down |
| 167 | char_code = terminal_read_char_escape() |
| 168 | if (char_code >= 0) then |
| 169 | ch3 = achar(char_code) |
| 170 | ios = 0 |
| 171 | else |
| 172 | ios = -1 |
| 173 | end if |
| 174 | if (ios == 0 .and. ch3 == '~') then |
| 175 | key_str = 'pagedown' |
| 176 | else if (ios == 0 .and. ch3 == ';') then |
| 177 | ! Modified page down (e.g., shift+pagedown) |
| 178 | call handle_modified_special_key(key_str, 6) |
| 179 | end if |
| 180 | case('1') |
| 181 | ! Could be function key (F1-F9) or modified arrow/home/end |
| 182 | ! Check next character |
| 183 | char_code = terminal_read_char_escape() |
| 184 | if (char_code >= 0) then |
| 185 | ch3 = achar(char_code) |
| 186 | if (ch3 == '~') then |
| 187 | ! F1: ESC [ 1 1 ~ (alternate format) |
| 188 | key_str = 'f1' |
| 189 | else if (ch3 == '0') then |
| 190 | ! F10 might be ESC [ 2 1 ~, check for tilde |
| 191 | char_code = terminal_read_char_escape() |
| 192 | if (char_code >= 0 .and. achar(char_code) == '~') then |
| 193 | key_str = 'f10' |
| 194 | end if |
| 195 | else if (ch3 == '1' .or. ch3 == '2' .or. ch3 == '3' .or. ch3 == '4' .or. & |
| 196 | ch3 == '5' .or. ch3 == '7' .or. ch3 == '8' .or. ch3 == '9') then |
| 197 | ! Function keys F1-F8: ESC [ 1 X ~ or ESC [ 1 X ; modifier ~ |
| 198 | char_code = terminal_read_char_escape() |
| 199 | if (char_code >= 0) then |
| 200 | ch = achar(char_code) |
| 201 | if (ch == '~') then |
| 202 | ! Unmodified F1-F8 |
| 203 | select case(ch3) |
| 204 | case('1') |
| 205 | key_str = 'f1' |
| 206 | case('2') |
| 207 | key_str = 'f2' |
| 208 | case('3') |
| 209 | key_str = 'f3' |
| 210 | case('4') |
| 211 | key_str = 'f4' |
| 212 | case('5') |
| 213 | key_str = 'f5' |
| 214 | case('7') |
| 215 | key_str = 'f6' |
| 216 | case('8') |
| 217 | key_str = 'f7' |
| 218 | case('9') |
| 219 | key_str = 'f8' |
| 220 | end select |
| 221 | else if (ch == ';') then |
| 222 | ! Modified F1-F8: ESC [ 1 X ; modifier ~ |
| 223 | call handle_modified_function_key(key_str, '1', ch3) |
| 224 | end if |
| 225 | end if |
| 226 | else if (ch3 == ';') then |
| 227 | ! Modified arrow key or home/end: ESC [ 1 ; 2 A format |
| 228 | call handle_modified_key(key_str) |
| 229 | end if |
| 230 | end if |
| 231 | case('2') |
| 232 | ! Could be F9-F12 or alternate modified keys |
| 233 | char_code = terminal_read_char_escape() |
| 234 | if (char_code >= 0) then |
| 235 | ch3 = achar(char_code) |
| 236 | if (ch3 == '0' .or. ch3 == '1' .or. ch3 == '3' .or. ch3 == '4') then |
| 237 | ! Function keys F9-F12: ESC [ 2 X ~ or ESC [ 2 X ; modifier ~ |
| 238 | char_code = terminal_read_char_escape() |
| 239 | if (char_code >= 0) then |
| 240 | ch = achar(char_code) |
| 241 | if (ch == '~') then |
| 242 | ! Unmodified F9-F12 |
| 243 | select case(ch3) |
| 244 | case('0') |
| 245 | key_str = 'f9' |
| 246 | case('1') |
| 247 | key_str = 'f10' |
| 248 | case('3') |
| 249 | key_str = 'f11' |
| 250 | case('4') |
| 251 | key_str = 'f12' |
| 252 | end select |
| 253 | else if (ch == ';') then |
| 254 | ! Modified F9-F12: ESC [ 2 X ; modifier ~ |
| 255 | call handle_modified_function_key(key_str, '2', ch3) |
| 256 | end if |
| 257 | end if |
| 258 | else if (ch3 == ';') then |
| 259 | ! ESC [ 2 ; A format (shift+arrow) |
| 260 | char_code = terminal_read_char_escape() |
| 261 | if (char_code >= 0) then |
| 262 | ch = achar(char_code) |
| 263 | key_str = 'shift-' |
| 264 | select case(ch) |
| 265 | case('A') |
| 266 | key_str = trim(key_str) // 'up' |
| 267 | case('B') |
| 268 | key_str = trim(key_str) // 'down' |
| 269 | case('C') |
| 270 | key_str = trim(key_str) // 'right' |
| 271 | case('D') |
| 272 | key_str = trim(key_str) // 'left' |
| 273 | end select |
| 274 | end if |
| 275 | else |
| 276 | ! Direct format ESC [ 2 A (we already read the 'A' in ch3) |
| 277 | key_str = 'shift-' |
| 278 | select case(ch3) |
| 279 | case('A') |
| 280 | key_str = trim(key_str) // 'up' |
| 281 | case('B') |
| 282 | key_str = trim(key_str) // 'down' |
| 283 | case('C') |
| 284 | key_str = trim(key_str) // 'right' |
| 285 | case('D') |
| 286 | key_str = trim(key_str) // 'left' |
| 287 | end select |
| 288 | end if |
| 289 | end if |
| 290 | case('4', '7', '8') |
| 291 | ! Alternate format: ESC [ 2 A (modifier directly, no '1') |
| 292 | ! This is sent by some terminals for shift+arrows |
| 293 | call handle_alternate_modified_key(key_str, ch2) |
| 294 | case('<') |
| 295 | ! Mouse event in SGR mode |
| 296 | call handle_mouse_event(key_str) |
| 297 | end select |
| 298 | else if (ch1 == 'O') then |
| 299 | ! SS3 sequence (e.g., function keys F1-F4) |
| 300 | char_code = terminal_read_char_escape() |
| 301 | if (char_code < 0) then |
| 302 | ! Timeout - this is just Alt+O |
| 303 | key_str = 'alt-o' |
| 304 | return |
| 305 | end if |
| 306 | ch2 = achar(char_code) |
| 307 | select case(ch2) |
| 308 | case('P') |
| 309 | key_str = 'f1' |
| 310 | case('Q') |
| 311 | key_str = 'f2' |
| 312 | case('R') |
| 313 | key_str = 'f3' |
| 314 | case('S') |
| 315 | key_str = 'f4' |
| 316 | case default |
| 317 | ! Unknown SS3 sequence - return as Alt+ch2 |
| 318 | write(key_str, '(a,a)') 'alt-', ch2 |
| 319 | end select |
| 320 | else if (ch1 == achar(27)) then |
| 321 | ! ESC ESC - likely Alt+something |
| 322 | char_code = terminal_read_char_escape() |
| 323 | if (char_code >= 0) then |
| 324 | ch2 = achar(char_code) |
| 325 | if (ch2 == '[') then |
| 326 | ! ESC ESC [ - Alt+arrow keys or Alt+modified keys |
| 327 | char_code = terminal_read_char_escape() |
| 328 | if (char_code >= 0) then |
| 329 | ch3 = achar(char_code) |
| 330 | select case(ch3) |
| 331 | case('A') |
| 332 | key_str = 'alt-up' |
| 333 | case('B') |
| 334 | key_str = 'alt-down' |
| 335 | case('C') |
| 336 | key_str = 'alt-right' |
| 337 | case('D') |
| 338 | key_str = 'alt-left' |
| 339 | case('3') |
| 340 | ! Could be Alt+Delete (ESC ESC [ 3 ~) |
| 341 | char_code = terminal_read_char_escape() |
| 342 | if (char_code >= 0 .and. achar(char_code) == '~') then |
| 343 | key_str = 'alt-delete' |
| 344 | end if |
| 345 | case('1', '2', '4', '7', '8') |
| 346 | ! ESC ESC [ 1 ; modifier format (Alt+Shift+arrow, etc) |
| 347 | call handle_alt_modified_key(key_str) |
| 348 | end select |
| 349 | end if |
| 350 | end if |
| 351 | end if |
| 352 | else if (ch1 == 'A') then |
| 353 | ! Could be Alt-Shift-Up |
| 354 | key_str = 'alt-shift-up' |
| 355 | else if (ch1 == 'B') then |
| 356 | ! Could be Alt-Shift-Down |
| 357 | key_str = 'alt-shift-down' |
| 358 | else if (ch1 == achar(127)) then |
| 359 | ! Alt+Backspace (ESC followed by DEL/127) |
| 360 | key_str = 'alt-backspace' |
| 361 | else if (ch1 == achar(8)) then |
| 362 | ! Alt+Backspace (ESC followed by Ctrl-H) |
| 363 | key_str = 'alt-backspace' |
| 364 | else if (ch1 >= 'a' .and. ch1 <= 'z') then |
| 365 | ! Alt+letter |
| 366 | write(key_str, '(a,a)') 'alt-', ch1 |
| 367 | else if (ch1 >= 'A' .and. ch1 <= 'Z') then |
| 368 | ! Alt+Shift+letter |
| 369 | write(key_str, '(a,a)') 'alt-shift-', achar(iachar(ch1) - iachar('A') + iachar('a')) |
| 370 | else if (ch1 >= '0' .and. ch1 <= '9') then |
| 371 | ! Alt+number (for tab switching) |
| 372 | write(key_str, '(a,a)') 'alt-', ch1 |
| 373 | else if (ch1 == "'") then |
| 374 | ! Alt+apostrophe for cycle quotes |
| 375 | key_str = "alt-'" |
| 376 | else if (ch1 == '"') then |
| 377 | ! Alt+Shift+apostrophe (double quote) for remove brackets |
| 378 | key_str = "alt-shift-apostrophe" |
| 379 | else if (ch1 == '[') then |
| 380 | ! Alt+[ for jump to matching bracket |
| 381 | key_str = "alt-[" |
| 382 | else if (ch1 == ']') then |
| 383 | ! Alt+] for jump to matching bracket |
| 384 | key_str = "alt-]" |
| 385 | else if (ch1 == '.') then |
| 386 | ! Alt+. for code actions |
| 387 | key_str = "alt-." |
| 388 | end if |
| 389 | |
| 390 | end subroutine handle_escape_sequence |
| 391 | |
| 392 | subroutine handle_modified_key(key_str) |
| 393 | character(len=*), intent(out) :: key_str |
| 394 | character :: ch, terminator |
| 395 | character(len=10) :: modifier_seq |
| 396 | integer :: ios, modifier, char_code, read_count |
| 397 | |
| 398 | key_str = '' ! Initialize to empty |
| 399 | modifier_seq = '' |
| 400 | ch = '' ! Initialize |
| 401 | terminator = '' ! To store the final character |
| 402 | read_count = 0 |
| 403 | |
| 404 | ! Read modifier sequence (e.g., ";2" for Shift) |
| 405 | do |
| 406 | read_count = read_count + 1 |
| 407 | if (read_count > 20) exit ! Safety limit |
| 408 | |
| 409 | char_code = terminal_read_char_escape() |
| 410 | if (char_code >= 0) then |
| 411 | ch = achar(char_code) |
| 412 | ios = 0 |
| 413 | else |
| 414 | ios = -1 |
| 415 | exit |
| 416 | end if |
| 417 | if ((ch >= 'A' .and. ch <= 'D') .or. ch == 'H' .or. ch == 'F' .or. ch == '~' .or. ch == 'Z') then |
| 418 | ! End of sequence - save the terminator |
| 419 | terminator = ch |
| 420 | exit |
| 421 | end if |
| 422 | modifier_seq = trim(modifier_seq) // ch |
| 423 | end do |
| 424 | |
| 425 | ! If we didn't get a terminator, return |
| 426 | if (terminator == '') return |
| 427 | |
| 428 | ! Parse modifier |
| 429 | if (len_trim(modifier_seq) >= 1 .and. modifier_seq(1:1) == ';') then |
| 430 | ! Standard format with leading ';': ";2" where 2 is the modifier |
| 431 | if (len_trim(modifier_seq) >= 2) then |
| 432 | read(modifier_seq(2:len_trim(modifier_seq)), '(i10)', iostat=ios) modifier |
| 433 | else |
| 434 | ios = -1 |
| 435 | end if |
| 436 | else if (len_trim(modifier_seq) >= 1 .and. & |
| 437 | modifier_seq(1:1) >= '1' .and. modifier_seq(1:1) <= '9') then |
| 438 | ! Format without leading ';' (already consumed by caller): "2" or "3" etc |
| 439 | read(modifier_seq(1:len_trim(modifier_seq)), '(i10)', iostat=ios) modifier |
| 440 | else |
| 441 | ios = -1 |
| 442 | end if |
| 443 | |
| 444 | if (ios == 0) then |
| 445 | select case(modifier) |
| 446 | case(2) ! Shift |
| 447 | key_str = 'shift-' |
| 448 | case(3) ! Alt |
| 449 | key_str = 'alt-' |
| 450 | case(4) ! Alt+Shift |
| 451 | key_str = 'alt-shift-' |
| 452 | case(5) ! Ctrl |
| 453 | key_str = 'ctrl-' |
| 454 | case(6) ! Ctrl+Shift |
| 455 | key_str = 'ctrl-shift-' |
| 456 | case(7) ! Alt+Ctrl |
| 457 | key_str = 'alt-ctrl-' |
| 458 | case(8) ! Alt+Shift (or Option+Shift) |
| 459 | key_str = 'alt-shift-' |
| 460 | case(9) ! Alt+Cmd (or Option+Cmd on macOS) |
| 461 | key_str = 'opt-meta-' |
| 462 | case default |
| 463 | key_str = '' |
| 464 | end select |
| 465 | |
| 466 | ! Append the key type using the terminator character |
| 467 | select case(terminator) |
| 468 | case('A') |
| 469 | key_str = trim(key_str) // 'up' |
| 470 | case('B') |
| 471 | key_str = trim(key_str) // 'down' |
| 472 | case('C') |
| 473 | key_str = trim(key_str) // 'right' |
| 474 | case('D') |
| 475 | key_str = trim(key_str) // 'left' |
| 476 | case('H') |
| 477 | key_str = trim(key_str) // 'home' |
| 478 | case('F') |
| 479 | key_str = trim(key_str) // 'end' |
| 480 | case('Z') |
| 481 | ! Shift+Z could be ctrl-shift-z for redo |
| 482 | if (index(key_str, 'ctrl-shift') == 1) then |
| 483 | key_str = 'ctrl-shift-z' |
| 484 | else |
| 485 | key_str = trim(key_str) // 'Z' |
| 486 | end if |
| 487 | case('~') |
| 488 | ! Check what special key it is based on the beginning of modifier_seq |
| 489 | if (index(modifier_seq, ';') == 1 .and. len_trim(modifier_seq) > 1) then |
| 490 | ! Already read the ;2 or ;5 etc, the key type should be before |
| 491 | key_str = trim(key_str) // 'unknown' |
| 492 | end if |
| 493 | end select |
| 494 | end if |
| 495 | end subroutine handle_modified_key |
| 496 | |
| 497 | subroutine handle_alternate_modified_key(key_str, modifier_char) |
| 498 | character(len=*), intent(out) :: key_str |
| 499 | character, intent(in) :: modifier_char |
| 500 | character :: ch |
| 501 | integer :: char_code, modifier |
| 502 | |
| 503 | key_str = '' |
| 504 | |
| 505 | ! The modifier_char ('2', '4', '7', '8') indicates the modifier |
| 506 | read(modifier_char, '(i1)') modifier |
| 507 | |
| 508 | ! Read the next character - might be the key or a semicolon |
| 509 | char_code = terminal_read_char_escape() |
| 510 | if (char_code < 0) return |
| 511 | ch = achar(char_code) |
| 512 | |
| 513 | ! Check if there's a semicolon (ESC [ 2 ; A format) or direct key (ESC [ 2 A) |
| 514 | if (ch == ';') then |
| 515 | ! Read the actual key |
| 516 | char_code = terminal_read_char_escape() |
| 517 | if (char_code < 0) return |
| 518 | ch = achar(char_code) |
| 519 | end if |
| 520 | |
| 521 | ! Map modifier to key prefix |
| 522 | select case(modifier) |
| 523 | case(2) ! Shift |
| 524 | key_str = 'shift-' |
| 525 | case(3) ! Alt |
| 526 | key_str = 'alt-' |
| 527 | case(4) ! Alt+Shift |
| 528 | key_str = 'alt-shift-' |
| 529 | case(5) ! Ctrl |
| 530 | key_str = 'ctrl-' |
| 531 | case(6) ! Ctrl+Shift |
| 532 | key_str = 'ctrl-shift-' |
| 533 | case(7) ! Alt+Ctrl |
| 534 | key_str = 'alt-ctrl-' |
| 535 | case(8) ! Alt+Shift (alternate) |
| 536 | key_str = 'alt-shift-' |
| 537 | case default |
| 538 | return |
| 539 | end select |
| 540 | |
| 541 | ! Append the key type |
| 542 | select case(ch) |
| 543 | case('A') |
| 544 | key_str = trim(key_str) // 'up' |
| 545 | case('B') |
| 546 | key_str = trim(key_str) // 'down' |
| 547 | case('C') |
| 548 | key_str = trim(key_str) // 'right' |
| 549 | case('D') |
| 550 | key_str = trim(key_str) // 'left' |
| 551 | case('H') |
| 552 | key_str = trim(key_str) // 'home' |
| 553 | case('F') |
| 554 | key_str = trim(key_str) // 'end' |
| 555 | case default |
| 556 | key_str = '' |
| 557 | end select |
| 558 | end subroutine handle_alternate_modified_key |
| 559 | |
| 560 | subroutine handle_alt_modified_key(key_str) |
| 561 | character(len=*), intent(out) :: key_str |
| 562 | character :: ch, terminator |
| 563 | character(len=10) :: modifier_seq |
| 564 | integer :: ios, modifier, char_code, read_count |
| 565 | |
| 566 | key_str = '' |
| 567 | modifier_seq = '' |
| 568 | terminator = '' |
| 569 | read_count = 0 |
| 570 | |
| 571 | ! For ESC ESC [ 1 ; modifier format, we already read the '1' |
| 572 | ! Read the rest of the sequence (should be ";modifier" then key) |
| 573 | do |
| 574 | read_count = read_count + 1 |
| 575 | if (read_count > 20) exit |
| 576 | |
| 577 | char_code = terminal_read_char_escape() |
| 578 | if (char_code < 0) exit |
| 579 | |
| 580 | ch = achar(char_code) |
| 581 | if ((ch >= 'A' .and. ch <= 'D') .or. ch == 'H' .or. ch == 'F') then |
| 582 | terminator = ch |
| 583 | exit |
| 584 | end if |
| 585 | modifier_seq = trim(modifier_seq) // ch |
| 586 | end do |
| 587 | |
| 588 | if (terminator == '') return |
| 589 | |
| 590 | ! Parse modifier from sequence like ";4" (Alt+Shift) |
| 591 | if (len_trim(modifier_seq) > 1 .and. modifier_seq(1:1) == ';') then |
| 592 | if (len_trim(modifier_seq) >= 2) then |
| 593 | read(modifier_seq(2:len_trim(modifier_seq)), '(i10)', iostat=ios) modifier |
| 594 | else |
| 595 | return |
| 596 | end if |
| 597 | |
| 598 | ! Build the key string with alt- prefix |
| 599 | select case(modifier) |
| 600 | case(2) ! Alt+Shift (ESC ESC [ 1 ; 2 is Alt+Shift) |
| 601 | key_str = 'alt-shift-' |
| 602 | case(3) ! Alt+Alt? (unusual) |
| 603 | key_str = 'alt-' |
| 604 | case(4) ! Alt+Shift (alternate) |
| 605 | key_str = 'alt-shift-' |
| 606 | case(5) ! Alt+Ctrl |
| 607 | key_str = 'alt-ctrl-' |
| 608 | case(6) ! Alt+Ctrl+Shift |
| 609 | key_str = 'alt-ctrl-shift-' |
| 610 | case default |
| 611 | ! Unknown modifier with Alt |
| 612 | key_str = 'alt-' |
| 613 | end select |
| 614 | |
| 615 | ! Append the key |
| 616 | select case(terminator) |
| 617 | case('A') |
| 618 | key_str = trim(key_str) // 'up' |
| 619 | case('B') |
| 620 | key_str = trim(key_str) // 'down' |
| 621 | case('C') |
| 622 | key_str = trim(key_str) // 'right' |
| 623 | case('D') |
| 624 | key_str = trim(key_str) // 'left' |
| 625 | case('H') |
| 626 | key_str = trim(key_str) // 'home' |
| 627 | case('F') |
| 628 | key_str = trim(key_str) // 'end' |
| 629 | end select |
| 630 | end if |
| 631 | end subroutine handle_alt_modified_key |
| 632 | |
| 633 | subroutine handle_modified_special_key(key_str, key_code) |
| 634 | character(len=*), intent(out) :: key_str |
| 635 | integer, intent(in) :: key_code |
| 636 | character :: ch |
| 637 | character(len=10) :: modifier_seq |
| 638 | integer :: ios, modifier, char_code |
| 639 | |
| 640 | modifier_seq = '' |
| 641 | |
| 642 | ! Read modifier sequence (already past the semicolon) |
| 643 | do |
| 644 | char_code = terminal_read_char_escape() |
| 645 | if (char_code >= 0) then |
| 646 | ch = achar(char_code) |
| 647 | ios = 0 |
| 648 | else |
| 649 | ios = -1 |
| 650 | end if |
| 651 | if (ios /= 0) exit |
| 652 | if (ch == '~') then |
| 653 | ! End of sequence |
| 654 | exit |
| 655 | end if |
| 656 | modifier_seq = trim(modifier_seq) // ch |
| 657 | end do |
| 658 | |
| 659 | ! Parse modifier |
| 660 | if (len_trim(modifier_seq) > 0) then |
| 661 | read(modifier_seq, '(i10)', iostat=ios) modifier |
| 662 | if (ios == 0) then |
| 663 | select case(modifier) |
| 664 | case(2) ! Shift |
| 665 | key_str = 'shift-' |
| 666 | case(3) ! Alt |
| 667 | key_str = 'alt-' |
| 668 | case(4) ! Alt+Shift |
| 669 | key_str = 'alt-shift-' |
| 670 | case(5) ! Ctrl |
| 671 | key_str = 'ctrl-' |
| 672 | case(6) ! Ctrl+Shift |
| 673 | key_str = 'ctrl-shift-' |
| 674 | case default |
| 675 | key_str = '' |
| 676 | end select |
| 677 | |
| 678 | ! Append the key type based on key_code |
| 679 | select case(key_code) |
| 680 | case(5) |
| 681 | key_str = trim(key_str) // 'pageup' |
| 682 | case(6) |
| 683 | key_str = trim(key_str) // 'pagedown' |
| 684 | end select |
| 685 | end if |
| 686 | end if |
| 687 | end subroutine handle_modified_special_key |
| 688 | |
| 689 | subroutine handle_modified_function_key(key_str, series, fkey_code) |
| 690 | character(len=*), intent(out) :: key_str |
| 691 | character, intent(in) :: series ! '1' for ESC[1X~, '2' for ESC[2X~ |
| 692 | character, intent(in) :: fkey_code ! The X in ESC[1X~ or ESC[2X~ |
| 693 | character :: modifier_ch |
| 694 | integer :: char_code, modifier |
| 695 | character(len=10) :: base_key |
| 696 | |
| 697 | key_str = '' |
| 698 | |
| 699 | ! Determine base function key from series and code |
| 700 | if (series == '1') then |
| 701 | ! ESC[1X~ format: 1=F1, 2=F2, 3=F3, 4=F4, 5=F5, 7=F6, 8=F7, 9=F8 |
| 702 | select case(fkey_code) |
| 703 | case('1') |
| 704 | base_key = 'f1' |
| 705 | case('2') |
| 706 | base_key = 'f2' |
| 707 | case('3') |
| 708 | base_key = 'f3' |
| 709 | case('4') |
| 710 | base_key = 'f4' |
| 711 | case('5') |
| 712 | base_key = 'f5' |
| 713 | case('7') |
| 714 | base_key = 'f6' |
| 715 | case('8') |
| 716 | base_key = 'f7' |
| 717 | case('9') |
| 718 | base_key = 'f8' |
| 719 | case default |
| 720 | return |
| 721 | end select |
| 722 | else if (series == '2') then |
| 723 | ! ESC[2X~ format: 0=F9, 1=F10, 3=F11, 4=F12 |
| 724 | select case(fkey_code) |
| 725 | case('0') |
| 726 | base_key = 'f9' |
| 727 | case('1') |
| 728 | base_key = 'f10' |
| 729 | case('3') |
| 730 | base_key = 'f11' |
| 731 | case('4') |
| 732 | base_key = 'f12' |
| 733 | case default |
| 734 | return |
| 735 | end select |
| 736 | else |
| 737 | return |
| 738 | end if |
| 739 | |
| 740 | ! Read modifier (should be a digit 2-8) |
| 741 | char_code = terminal_read_char_escape() |
| 742 | if (char_code < 0) return |
| 743 | modifier_ch = achar(char_code) |
| 744 | |
| 745 | ! Read terminating ~ |
| 746 | char_code = terminal_read_char_escape() |
| 747 | if (char_code < 0 .or. achar(char_code) /= '~') return |
| 748 | |
| 749 | ! Parse modifier: 2=Shift, 3=Alt, 4=Alt+Shift, 5=Ctrl, 6=Ctrl+Shift, 7=Alt+Ctrl, 8=Alt+Shift |
| 750 | read(modifier_ch, '(i1)') modifier |
| 751 | |
| 752 | select case(modifier) |
| 753 | case(2) ! Shift |
| 754 | key_str = 'shift-' // trim(base_key) |
| 755 | case(3) ! Alt |
| 756 | key_str = 'alt-' // trim(base_key) |
| 757 | case(4) ! Alt+Shift |
| 758 | key_str = 'alt-shift-' // trim(base_key) |
| 759 | case(5) ! Ctrl |
| 760 | key_str = 'ctrl-' // trim(base_key) |
| 761 | case(6) ! Ctrl+Shift |
| 762 | key_str = 'ctrl-shift-' // trim(base_key) |
| 763 | case(7) ! Alt+Ctrl |
| 764 | key_str = 'alt-ctrl-' // trim(base_key) |
| 765 | case(8) ! Alt+Ctrl+Shift |
| 766 | key_str = 'alt-ctrl-shift-' // trim(base_key) |
| 767 | case default |
| 768 | ! Unknown modifier, return unmodified key |
| 769 | key_str = trim(base_key) |
| 770 | end select |
| 771 | end subroutine handle_modified_function_key |
| 772 | |
| 773 | subroutine handle_mouse_event(key_str) |
| 774 | character(len=*), intent(out) :: key_str |
| 775 | character :: ch |
| 776 | character(len=100) :: buffer |
| 777 | integer :: i, ios, button, col, row, char_code |
| 778 | integer :: semicolon1, semicolon2 |
| 779 | logical :: is_release |
| 780 | |
| 781 | buffer = '' |
| 782 | i = 1 |
| 783 | is_release = .false. |
| 784 | |
| 785 | ! Read until 'M' (press) or 'm' (release) |
| 786 | do |
| 787 | char_code = terminal_read_char_escape() |
| 788 | if (char_code >= 0) then |
| 789 | ch = achar(char_code) |
| 790 | ios = 0 |
| 791 | else |
| 792 | ios = -1 |
| 793 | end if |
| 794 | if (ios /= 0) exit |
| 795 | if (ch == 'M' .or. ch == 'm') then |
| 796 | is_release = (ch == 'm') |
| 797 | exit |
| 798 | end if |
| 799 | if (i <= 100) then |
| 800 | buffer(i:i) = ch |
| 801 | i = i + 1 |
| 802 | end if |
| 803 | end do |
| 804 | |
| 805 | ! Parse the mouse event format: button;col;row |
| 806 | semicolon1 = index(buffer, ';') |
| 807 | if (semicolon1 > 0) then |
| 808 | semicolon2 = index(buffer(semicolon1+1:), ';') + semicolon1 |
| 809 | if (semicolon2 > semicolon1) then |
| 810 | read(buffer(1:semicolon1-1), '(i10)', iostat=ios) button |
| 811 | if (ios == 0) then |
| 812 | read(buffer(semicolon1+1:semicolon2-1), '(i10)', iostat=ios) col |
| 813 | if (ios == 0) then |
| 814 | read(buffer(semicolon2+1:i-1), '(i10)', iostat=ios) row |
| 815 | if (ios == 0) then |
| 816 | ! Format mouse event as key string |
| 817 | if (is_release) then |
| 818 | write(key_str, '(a,i0,a,i0,a,i0)') 'mouse-release:', button, ':', row, ':', col |
| 819 | else |
| 820 | ! Check for scroll wheel events (button 64 = scroll up, 65 = scroll down) |
| 821 | if (button == 64) then |
| 822 | key_str = 'mouse-scroll-up' |
| 823 | else if (button == 65) then |
| 824 | key_str = 'mouse-scroll-down' |
| 825 | ! Check modifiers in button code |
| 826 | else if (iand(button, 4) /= 0) then ! Shift |
| 827 | write(key_str, '(a,i0,a,i0,a,i0)') 'mouse-shift:', button, ':', row, ':', col |
| 828 | else if (iand(button, 8) /= 0) then ! Alt |
| 829 | write(key_str, '(a,i0,a,i0,a,i0)') 'mouse-alt:', button, ':', row, ':', col |
| 830 | else if (iand(button, 16) /= 0) then ! Ctrl |
| 831 | write(key_str, '(a,i0,a,i0,a,i0)') 'mouse-ctrl:', button, ':', row, ':', col |
| 832 | else if (iand(button, 32) /= 0) then ! Mouse motion (drag) |
| 833 | write(key_str, '(a,i0,a,i0,a,i0)') 'mouse-drag:', button, ':', row, ':', col |
| 834 | else |
| 835 | write(key_str, '(a,i0,a,i0,a,i0)') 'mouse-click:', button, ':', row, ':', col |
| 836 | end if |
| 837 | end if |
| 838 | return |
| 839 | end if |
| 840 | end if |
| 841 | end if |
| 842 | end if |
| 843 | end if |
| 844 | |
| 845 | key_str = '' |
| 846 | end subroutine handle_mouse_event |
| 847 | |
| 848 | end module input_handler_module |