| 1 | module parser_mod |
| 2 | use cell_mod |
| 3 | use screen_mod |
| 4 | use terminal_mod |
| 5 | use cursor_mod, only: CURSOR_BLOCK, CURSOR_UNDERLINE, CURSOR_BAR |
| 6 | implicit none |
| 7 | private |
| 8 | |
| 9 | public :: parser_t |
| 10 | public :: parser_init, parser_process_byte |
| 11 | |
| 12 | ! Parser states |
| 13 | integer, parameter :: STATE_GROUND = 0 |
| 14 | integer, parameter :: STATE_ESCAPE = 1 |
| 15 | integer, parameter :: STATE_CSI_ENTRY = 2 |
| 16 | integer, parameter :: STATE_CSI_PARAM = 3 |
| 17 | integer, parameter :: STATE_OSC_STRING = 4 |
| 18 | |
| 19 | integer, parameter :: MAX_PARAMS = 16 |
| 20 | |
| 21 | type :: parser_t |
| 22 | integer :: state = STATE_GROUND |
| 23 | |
| 24 | ! CSI parameter accumulation |
| 25 | integer :: params(MAX_PARAMS) |
| 26 | integer :: param_count = 0 |
| 27 | integer :: current_param = 0 |
| 28 | logical :: param_started = .false. |
| 29 | |
| 30 | ! For CSI ? and > sequences |
| 31 | logical :: has_private = .false. |
| 32 | character(len=1) :: private_marker = ' ' |
| 33 | |
| 34 | ! Intermediate character (for sequences like CSI Ps SP q) |
| 35 | character(len=1) :: intermediate = ' ' |
| 36 | logical :: has_intermediate = .false. |
| 37 | |
| 38 | ! OSC string buffer (for window title, etc.) |
| 39 | character(len=256) :: osc_buffer |
| 40 | integer :: osc_len = 0 |
| 41 | |
| 42 | ! UTF-8 decoding state |
| 43 | integer :: utf8_codepoint = 0 |
| 44 | integer :: utf8_remaining = 0 |
| 45 | end type parser_t |
| 46 | |
| 47 | contains |
| 48 | |
| 49 | ! Initialize parser |
| 50 | subroutine parser_init(p) |
| 51 | type(parser_t), intent(inout) :: p |
| 52 | |
| 53 | call parser_reset(p) |
| 54 | p%utf8_codepoint = 0 |
| 55 | p%utf8_remaining = 0 |
| 56 | end subroutine parser_init |
| 57 | |
| 58 | ! Reset parser to ground state |
| 59 | subroutine parser_reset(p) |
| 60 | type(parser_t), intent(inout) :: p |
| 61 | |
| 62 | p%state = STATE_GROUND |
| 63 | p%params = 0 |
| 64 | p%param_count = 0 |
| 65 | p%current_param = 0 |
| 66 | p%param_started = .false. |
| 67 | p%has_private = .false. |
| 68 | p%private_marker = ' ' |
| 69 | p%has_intermediate = .false. |
| 70 | p%intermediate = ' ' |
| 71 | p%osc_buffer = '' |
| 72 | p%osc_len = 0 |
| 73 | ! Note: Don't reset UTF-8 state here - it persists across escape sequences |
| 74 | end subroutine parser_reset |
| 75 | |
| 76 | ! Reset UTF-8 decoding state (call on invalid sequences) |
| 77 | subroutine parser_reset_utf8(p) |
| 78 | type(parser_t), intent(inout) :: p |
| 79 | |
| 80 | p%utf8_codepoint = 0 |
| 81 | p%utf8_remaining = 0 |
| 82 | end subroutine parser_reset_utf8 |
| 83 | |
| 84 | ! Process a single byte from PTY output |
| 85 | subroutine parser_process_byte(p, term, byte) |
| 86 | type(parser_t), intent(inout) :: p |
| 87 | type(terminal_t), intent(inout) :: term |
| 88 | integer, intent(in) :: byte |
| 89 | |
| 90 | select case (p%state) |
| 91 | case (STATE_GROUND) |
| 92 | call handle_ground(p, term, byte) |
| 93 | case (STATE_ESCAPE) |
| 94 | call handle_escape(p, term, byte) |
| 95 | case (STATE_CSI_ENTRY, STATE_CSI_PARAM) |
| 96 | call handle_csi(p, term, byte) |
| 97 | case (STATE_OSC_STRING) |
| 98 | call handle_osc(p, term, byte) |
| 99 | end select |
| 100 | end subroutine parser_process_byte |
| 101 | |
| 102 | ! Handle ground state - normal character processing with UTF-8 decoding |
| 103 | recursive subroutine handle_ground(p, term, byte) |
| 104 | type(parser_t), intent(inout) :: p |
| 105 | type(terminal_t), intent(inout) :: term |
| 106 | integer, intent(in) :: byte |
| 107 | |
| 108 | ! Check for escape sequence start |
| 109 | if (byte == 27) then ! ESC |
| 110 | ! Abort any in-progress UTF-8 sequence |
| 111 | call parser_reset_utf8(p) |
| 112 | p%state = STATE_ESCAPE |
| 113 | return |
| 114 | end if |
| 115 | |
| 116 | ! UTF-8 decoding state machine |
| 117 | if (p%utf8_remaining > 0) then |
| 118 | ! Expecting continuation byte (10xxxxxx) |
| 119 | if (iand(byte, 192) == 128) then ! 192 = 0xC0, 128 = 0x80 |
| 120 | ! Valid continuation byte |
| 121 | p%utf8_codepoint = ior(ishft(p%utf8_codepoint, 6), iand(byte, 63)) |
| 122 | p%utf8_remaining = p%utf8_remaining - 1 |
| 123 | |
| 124 | if (p%utf8_remaining == 0) then |
| 125 | ! UTF-8 sequence complete - output the codepoint |
| 126 | call terminal_put_char(term, p%utf8_codepoint) |
| 127 | p%utf8_codepoint = 0 |
| 128 | end if |
| 129 | else |
| 130 | ! Invalid continuation - reset and process byte as new start |
| 131 | call parser_reset_utf8(p) |
| 132 | call handle_ground(p, term, byte) |
| 133 | end if |
| 134 | return |
| 135 | end if |
| 136 | |
| 137 | ! Check for UTF-8 lead byte |
| 138 | if (byte < 128) then |
| 139 | ! ASCII (0xxxxxxx) - single byte, pass directly |
| 140 | call terminal_put_char(term, byte) |
| 141 | |
| 142 | else if (iand(byte, 224) == 192) then ! 224 = 0xE0, 192 = 0xC0 |
| 143 | ! 2-byte sequence (110xxxxx) |
| 144 | p%utf8_codepoint = iand(byte, 31) ! Keep lower 5 bits |
| 145 | p%utf8_remaining = 1 |
| 146 | |
| 147 | else if (iand(byte, 240) == 224) then ! 240 = 0xF0, 224 = 0xE0 |
| 148 | ! 3-byte sequence (1110xxxx) |
| 149 | p%utf8_codepoint = iand(byte, 15) ! Keep lower 4 bits |
| 150 | p%utf8_remaining = 2 |
| 151 | |
| 152 | else if (iand(byte, 248) == 240) then ! 248 = 0xF8, 240 = 0xF0 |
| 153 | ! 4-byte sequence (11110xxx) |
| 154 | p%utf8_codepoint = iand(byte, 7) ! Keep lower 3 bits |
| 155 | p%utf8_remaining = 3 |
| 156 | |
| 157 | else |
| 158 | ! Invalid UTF-8 lead byte (continuation byte without lead, or invalid) |
| 159 | ! Pass through as-is (shows replacement character behavior) |
| 160 | call terminal_put_char(term, byte) |
| 161 | end if |
| 162 | |
| 163 | end subroutine handle_ground |
| 164 | |
| 165 | ! Handle escape state - ESC received |
| 166 | subroutine handle_escape(p, term, byte) |
| 167 | type(parser_t), intent(inout) :: p |
| 168 | type(terminal_t), intent(inout) :: term |
| 169 | integer, intent(in) :: byte |
| 170 | |
| 171 | select case (byte) |
| 172 | case (91) ! '[' - CSI introducer |
| 173 | p%state = STATE_CSI_ENTRY |
| 174 | p%params = 0 |
| 175 | p%param_count = 0 |
| 176 | p%current_param = 0 |
| 177 | p%param_started = .false. |
| 178 | p%has_private = .false. |
| 179 | p%private_marker = ' ' |
| 180 | |
| 181 | case (93) ! ']' - OSC introducer |
| 182 | p%state = STATE_OSC_STRING |
| 183 | p%osc_buffer = '' |
| 184 | p%osc_len = 0 |
| 185 | |
| 186 | case (55) ! '7' - DECSC (save cursor) |
| 187 | call terminal_save_cursor(term) |
| 188 | p%state = STATE_GROUND |
| 189 | |
| 190 | case (56) ! '8' - DECRC (restore cursor) |
| 191 | call terminal_restore_cursor(term) |
| 192 | p%state = STATE_GROUND |
| 193 | |
| 194 | case (68) ! 'D' - IND (index/linefeed) |
| 195 | call terminal_index(term) |
| 196 | p%state = STATE_GROUND |
| 197 | |
| 198 | case (69) ! 'E' - NEL (next line) |
| 199 | call terminal_carriage_return(term) |
| 200 | call terminal_index(term) |
| 201 | p%state = STATE_GROUND |
| 202 | |
| 203 | case (77) ! 'M' - RI (reverse index) |
| 204 | call terminal_reverse_index(term) |
| 205 | p%state = STATE_GROUND |
| 206 | |
| 207 | case (99) ! 'c' - RIS (reset to initial state) |
| 208 | call terminal_reset(term) |
| 209 | p%state = STATE_GROUND |
| 210 | |
| 211 | case default |
| 212 | ! Unknown escape sequence - return to ground |
| 213 | p%state = STATE_GROUND |
| 214 | end select |
| 215 | end subroutine handle_escape |
| 216 | |
| 217 | ! Handle CSI state - collecting parameters |
| 218 | subroutine handle_csi(p, term, byte) |
| 219 | type(parser_t), intent(inout) :: p |
| 220 | type(terminal_t), intent(inout) :: term |
| 221 | integer, intent(in) :: byte |
| 222 | |
| 223 | ! Check for private marker (?, >, etc.) |
| 224 | if (p%state == STATE_CSI_ENTRY) then |
| 225 | if (byte == 63 .or. byte == 62 .or. byte == 60 .or. byte == 61) then |
| 226 | ! '?' = 63, '>' = 62, '<' = 60, '=' = 61 |
| 227 | p%has_private = .true. |
| 228 | p%private_marker = char(byte) |
| 229 | p%state = STATE_CSI_PARAM |
| 230 | return |
| 231 | end if |
| 232 | p%state = STATE_CSI_PARAM |
| 233 | end if |
| 234 | |
| 235 | ! Numeric parameter |
| 236 | if (byte >= 48 .and. byte <= 57) then ! '0'-'9' |
| 237 | p%current_param = p%current_param * 10 + (byte - 48) |
| 238 | p%param_started = .true. |
| 239 | return |
| 240 | end if |
| 241 | |
| 242 | ! Parameter separator |
| 243 | if (byte == 59) then ! ';' |
| 244 | if (p%param_count < MAX_PARAMS) then |
| 245 | p%param_count = p%param_count + 1 |
| 246 | p%params(p%param_count) = p%current_param |
| 247 | end if |
| 248 | p%current_param = 0 |
| 249 | p%param_started = .false. |
| 250 | return |
| 251 | end if |
| 252 | |
| 253 | ! Final byte - dispatch the command |
| 254 | if (byte >= 64 .and. byte <= 126) then ! '@'-'~' |
| 255 | ! Store last parameter |
| 256 | if (p%param_started .or. p%param_count > 0) then |
| 257 | if (p%param_count < MAX_PARAMS) then |
| 258 | p%param_count = p%param_count + 1 |
| 259 | p%params(p%param_count) = p%current_param |
| 260 | end if |
| 261 | end if |
| 262 | |
| 263 | call dispatch_csi(p, term, byte) |
| 264 | call parser_reset(p) |
| 265 | return |
| 266 | end if |
| 267 | |
| 268 | ! Intermediate byte (space, !, ", etc.) - store it |
| 269 | if (byte >= 32 .and. byte <= 47) then |
| 270 | p%has_intermediate = .true. |
| 271 | p%intermediate = char(byte) |
| 272 | return |
| 273 | end if |
| 274 | |
| 275 | ! Unexpected byte - abort sequence |
| 276 | call parser_reset(p) |
| 277 | end subroutine handle_csi |
| 278 | |
| 279 | ! Handle OSC state - operating system command |
| 280 | subroutine handle_osc(p, term, byte) |
| 281 | type(parser_t), intent(inout) :: p |
| 282 | type(terminal_t), intent(inout) :: term |
| 283 | integer, intent(in) :: byte |
| 284 | |
| 285 | ! OSC ends with BEL (7) or ST (ESC \) |
| 286 | if (byte == 7) then ! BEL |
| 287 | call dispatch_osc(p, term) |
| 288 | call parser_reset(p) |
| 289 | return |
| 290 | end if |
| 291 | |
| 292 | if (byte == 27) then ! ESC - might be ST |
| 293 | ! For simplicity, dispatch and reset |
| 294 | call dispatch_osc(p, term) |
| 295 | call parser_reset(p) |
| 296 | return |
| 297 | end if |
| 298 | |
| 299 | ! Accumulate OSC string |
| 300 | if (p%osc_len < 256) then |
| 301 | p%osc_len = p%osc_len + 1 |
| 302 | p%osc_buffer(p%osc_len:p%osc_len) = char(byte) |
| 303 | end if |
| 304 | end subroutine handle_osc |
| 305 | |
| 306 | ! Dispatch OSC command |
| 307 | subroutine dispatch_osc(p, term) |
| 308 | type(parser_t), intent(in) :: p |
| 309 | type(terminal_t), intent(inout) :: term |
| 310 | integer :: cmd, sep_pos, i |
| 311 | character(len=256) :: title_text |
| 312 | |
| 313 | if (p%osc_len == 0) return |
| 314 | |
| 315 | ! Parse command number (before first ';') |
| 316 | sep_pos = 0 |
| 317 | do i = 1, p%osc_len |
| 318 | if (p%osc_buffer(i:i) == ';') then |
| 319 | sep_pos = i |
| 320 | exit |
| 321 | end if |
| 322 | end do |
| 323 | |
| 324 | if (sep_pos == 0) return ! No separator found |
| 325 | |
| 326 | ! Extract command number |
| 327 | cmd = 0 |
| 328 | do i = 1, sep_pos - 1 |
| 329 | if (p%osc_buffer(i:i) >= '0' .and. p%osc_buffer(i:i) <= '9') then |
| 330 | cmd = cmd * 10 + (ichar(p%osc_buffer(i:i)) - ichar('0')) |
| 331 | end if |
| 332 | end do |
| 333 | |
| 334 | ! Extract title text (after ';') |
| 335 | title_text = '' |
| 336 | if (sep_pos < p%osc_len) then |
| 337 | title_text = p%osc_buffer(sep_pos + 1:p%osc_len) |
| 338 | end if |
| 339 | |
| 340 | select case (cmd) |
| 341 | case (0) ! Set icon name and window title |
| 342 | call terminal_set_title(term, trim(title_text)) |
| 343 | case (1) ! Set icon name only (we treat as title too) |
| 344 | call terminal_set_title(term, trim(title_text)) |
| 345 | case (2) ! Set window title only |
| 346 | call terminal_set_title(term, trim(title_text)) |
| 347 | ! Other OSC commands can be added here |
| 348 | end select |
| 349 | end subroutine dispatch_osc |
| 350 | |
| 351 | ! Dispatch CSI command based on final byte |
| 352 | subroutine dispatch_csi(p, term, cmd) |
| 353 | type(parser_t), intent(inout) :: p |
| 354 | type(terminal_t), intent(inout) :: term |
| 355 | integer, intent(in) :: cmd |
| 356 | integer :: n, m |
| 357 | |
| 358 | ! Get first two params with defaults |
| 359 | n = 1 |
| 360 | m = 1 |
| 361 | if (p%param_count >= 1 .and. p%params(1) > 0) n = p%params(1) |
| 362 | if (p%param_count >= 2 .and. p%params(2) > 0) m = p%params(2) |
| 363 | |
| 364 | ! Handle private sequences (CSI ? ...) |
| 365 | if (p%has_private .and. p%private_marker == '?') then |
| 366 | call dispatch_dec_private(term, cmd, n) |
| 367 | return |
| 368 | end if |
| 369 | |
| 370 | ! Handle DA2 (CSI > c) - Secondary Device Attributes |
| 371 | if (p%has_private .and. p%private_marker == '>' .and. cmd == 99) then |
| 372 | ! Respond: CSI > 0 ; 10 ; 0 c (xterm-compatible: type=0, version=10, rom=0) |
| 373 | call terminal_queue_response(term, char(27) // '[>0;10;0c') |
| 374 | return |
| 375 | end if |
| 376 | |
| 377 | ! Handle DECSCUSR (CSI Ps SP q) - Set Cursor Style |
| 378 | if (p%has_intermediate .and. p%intermediate == ' ' .and. cmd == 113) then |
| 379 | ! Ps=0,1: blinking block, Ps=2: steady block |
| 380 | ! Ps=3: blinking underline, Ps=4: steady underline |
| 381 | ! Ps=5: blinking bar, Ps=6: steady bar |
| 382 | select case (n) |
| 383 | case (0, 1) ! Blinking block |
| 384 | term%cursor%style = CURSOR_BLOCK |
| 385 | term%cursor%blink = .true. |
| 386 | case (2) ! Steady block |
| 387 | term%cursor%style = CURSOR_BLOCK |
| 388 | term%cursor%blink = .false. |
| 389 | case (3) ! Blinking underline |
| 390 | term%cursor%style = CURSOR_UNDERLINE |
| 391 | term%cursor%blink = .true. |
| 392 | case (4) ! Steady underline |
| 393 | term%cursor%style = CURSOR_UNDERLINE |
| 394 | term%cursor%blink = .false. |
| 395 | case (5) ! Blinking bar |
| 396 | term%cursor%style = CURSOR_BAR |
| 397 | term%cursor%blink = .true. |
| 398 | case (6) ! Steady bar |
| 399 | term%cursor%style = CURSOR_BAR |
| 400 | term%cursor%blink = .false. |
| 401 | end select |
| 402 | return |
| 403 | end if |
| 404 | |
| 405 | select case (cmd) |
| 406 | case (65) ! 'A' - CUU (cursor up) |
| 407 | call terminal_cursor_up(term, n) |
| 408 | |
| 409 | case (66) ! 'B' - CUD (cursor down) |
| 410 | call terminal_cursor_down(term, n) |
| 411 | |
| 412 | case (67) ! 'C' - CUF (cursor forward) |
| 413 | call terminal_cursor_forward(term, n) |
| 414 | |
| 415 | case (68) ! 'D' - CUB (cursor backward) |
| 416 | call terminal_cursor_backward(term, n) |
| 417 | |
| 418 | case (69) ! 'E' - CNL (cursor next line) |
| 419 | call terminal_cursor_down(term, n) |
| 420 | term%cursor%col = 1 |
| 421 | |
| 422 | case (70) ! 'F' - CPL (cursor previous line) |
| 423 | call terminal_cursor_up(term, n) |
| 424 | term%cursor%col = 1 |
| 425 | |
| 426 | case (71) ! 'G' - CHA (cursor horizontal absolute) |
| 427 | call terminal_cursor_move(term, term%cursor%row, n) |
| 428 | |
| 429 | case (72, 102) ! 'H' or 'f' - CUP (cursor position) |
| 430 | call terminal_cursor_move(term, n, m) |
| 431 | |
| 432 | case (74) ! 'J' - ED (erase in display) |
| 433 | if (p%param_count == 0) n = 0 |
| 434 | call terminal_erase_display(term, n) |
| 435 | |
| 436 | case (75) ! 'K' - EL (erase in line) |
| 437 | if (p%param_count == 0) n = 0 |
| 438 | call terminal_erase_line(term, n) |
| 439 | |
| 440 | case (76) ! 'L' - IL (insert lines) |
| 441 | call terminal_insert_lines(term, n) |
| 442 | |
| 443 | case (77) ! 'M' - DL (delete lines) |
| 444 | call terminal_delete_lines(term, n) |
| 445 | |
| 446 | case (80) ! 'P' - DCH (delete characters) |
| 447 | call terminal_delete_chars(term, n) |
| 448 | |
| 449 | case (64) ! '@' - ICH (insert characters) |
| 450 | call terminal_insert_chars(term, n) |
| 451 | |
| 452 | case (88) ! 'X' - ECH (erase characters) |
| 453 | call terminal_erase_chars(term, n) |
| 454 | |
| 455 | case (100) ! 'd' - VPA (vertical line position absolute) |
| 456 | call terminal_cursor_move(term, n, term%cursor%col) |
| 457 | |
| 458 | case (109) ! 'm' - SGR (select graphic rendition) |
| 459 | call dispatch_sgr(p, term) |
| 460 | |
| 461 | case (114) ! 'r' - DECSTBM (set scroll region) |
| 462 | if (p%param_count == 0) then |
| 463 | call terminal_set_scroll_region(term, 1, term%rows) |
| 464 | else if (p%param_count == 1) then |
| 465 | call terminal_set_scroll_region(term, n, term%rows) |
| 466 | else |
| 467 | call terminal_set_scroll_region(term, n, m) |
| 468 | end if |
| 469 | |
| 470 | case (99) ! 'c' - DA1 (Primary Device Attributes) |
| 471 | ! Respond as VT220 with ANSI color support |
| 472 | ! 62=VT220, 22=ANSI color |
| 473 | if (p%param_count == 0 .or. (p%param_count == 1 .and. p%params(1) == 0)) then |
| 474 | call terminal_queue_response(term, char(27) // '[?62;22c') |
| 475 | end if |
| 476 | |
| 477 | case (110) ! 'n' - DSR (Device Status Report) |
| 478 | if (n == 5) then |
| 479 | ! Status report: respond "OK" (CSI 0 n) |
| 480 | call terminal_queue_response(term, char(27) // '[0n') |
| 481 | else if (n == 6) then |
| 482 | ! Cursor position report: respond CSI row ; col R |
| 483 | call terminal_queue_response(term, char(27) // '[' // & |
| 484 | trim(int_to_str(term%cursor%row)) // ';' // & |
| 485 | trim(int_to_str(term%cursor%col)) // 'R') |
| 486 | end if |
| 487 | |
| 488 | case (115) ! 's' - SCOSC (save cursor position) |
| 489 | call terminal_save_cursor(term) |
| 490 | |
| 491 | case (117) ! 'u' - SCORC (restore cursor position) |
| 492 | call terminal_restore_cursor(term) |
| 493 | |
| 494 | case default |
| 495 | ! Unknown CSI command - ignore |
| 496 | end select |
| 497 | end subroutine dispatch_csi |
| 498 | |
| 499 | ! Erase n characters at cursor (for ECH) |
| 500 | subroutine terminal_erase_chars(term, n) |
| 501 | type(terminal_t), intent(inout) :: term |
| 502 | integer, intent(in) :: n |
| 503 | type(screen_t), pointer :: scr |
| 504 | integer :: col, end_col |
| 505 | |
| 506 | scr => terminal_active_screen(term) |
| 507 | end_col = min(term%cursor%col + n - 1, term%cols) |
| 508 | |
| 509 | do col = term%cursor%col, end_col |
| 510 | scr%cells(term%cursor%row, col) = cell_t(32, default_fg, default_bg, 0) |
| 511 | end do |
| 512 | |
| 513 | call screen_mark_dirty(scr, term%cursor%row) |
| 514 | end subroutine terminal_erase_chars |
| 515 | |
| 516 | ! Dispatch DEC private mode sequences (CSI ? n h/l) |
| 517 | subroutine dispatch_dec_private(term, cmd, mode) |
| 518 | type(terminal_t), intent(inout) :: term |
| 519 | integer, intent(in) :: cmd, mode |
| 520 | logical :: set_mode |
| 521 | |
| 522 | ! 'h' = 104 (set mode), 'l' = 108 (reset mode) |
| 523 | if (cmd == 104) then |
| 524 | set_mode = .true. |
| 525 | else if (cmd == 108) then |
| 526 | set_mode = .false. |
| 527 | else |
| 528 | return ! Not a mode setting command |
| 529 | end if |
| 530 | |
| 531 | select case (mode) |
| 532 | case (1) ! DECCKM - Application cursor keys |
| 533 | ! We would need to track this mode for cursor key handling |
| 534 | ! For now, ignore |
| 535 | |
| 536 | case (7) ! DECAWM - Auto-wrap mode |
| 537 | term%mode_autowrap = set_mode |
| 538 | |
| 539 | case (12) ! Cursor blink |
| 540 | term%cursor%blink = set_mode |
| 541 | |
| 542 | case (25) ! DECTCEM - Cursor visible |
| 543 | term%cursor%visible = set_mode |
| 544 | |
| 545 | case (47) ! Alternate screen buffer (older) |
| 546 | call terminal_switch_screen(term, set_mode) |
| 547 | |
| 548 | case (1047) ! Alternate screen buffer |
| 549 | call terminal_switch_screen(term, set_mode) |
| 550 | |
| 551 | case (1048) ! Save/restore cursor |
| 552 | if (set_mode) then |
| 553 | call terminal_save_cursor(term) |
| 554 | else |
| 555 | call terminal_restore_cursor(term) |
| 556 | end if |
| 557 | |
| 558 | case (1049) ! Alternate screen + save/restore cursor |
| 559 | if (set_mode) then |
| 560 | call terminal_save_cursor(term) |
| 561 | call terminal_switch_screen(term, .true.) |
| 562 | call terminal_erase_display(term, 2) |
| 563 | else |
| 564 | call terminal_switch_screen(term, .false.) |
| 565 | call terminal_restore_cursor(term) |
| 566 | end if |
| 567 | |
| 568 | case (2004) ! Bracketed paste mode |
| 569 | ! We would need to track this for paste handling |
| 570 | ! For now, ignore |
| 571 | |
| 572 | case default |
| 573 | ! Unknown mode - ignore |
| 574 | end select |
| 575 | end subroutine dispatch_dec_private |
| 576 | |
| 577 | ! Dispatch SGR (Select Graphic Rendition) |
| 578 | subroutine dispatch_sgr(p, term) |
| 579 | type(parser_t), intent(inout) :: p |
| 580 | type(terminal_t), intent(inout) :: term |
| 581 | integer :: i, param |
| 582 | |
| 583 | ! Default: SGR 0 (reset) |
| 584 | if (p%param_count == 0) then |
| 585 | term%cursor%fg = default_fg |
| 586 | term%cursor%bg = default_bg |
| 587 | term%cursor%attrs = 0 |
| 588 | return |
| 589 | end if |
| 590 | |
| 591 | i = 1 |
| 592 | do while (i <= p%param_count) |
| 593 | param = p%params(i) |
| 594 | |
| 595 | select case (param) |
| 596 | case (0) ! Reset all |
| 597 | term%cursor%fg = default_fg |
| 598 | term%cursor%bg = default_bg |
| 599 | term%cursor%attrs = 0 |
| 600 | |
| 601 | case (1) ! Bold |
| 602 | term%cursor%attrs = ior(term%cursor%attrs, ATTR_BOLD) |
| 603 | |
| 604 | case (2) ! Dim/faint (treat as removing bold) |
| 605 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_BOLD)) |
| 606 | |
| 607 | case (3) ! Italic |
| 608 | term%cursor%attrs = ior(term%cursor%attrs, ATTR_ITALIC) |
| 609 | |
| 610 | case (4) ! Underline |
| 611 | term%cursor%attrs = ior(term%cursor%attrs, ATTR_UNDERLINE) |
| 612 | |
| 613 | case (5, 6) ! Blink (slow/rapid) |
| 614 | term%cursor%attrs = ior(term%cursor%attrs, ATTR_BLINK) |
| 615 | |
| 616 | case (7) ! Inverse |
| 617 | term%cursor%attrs = ior(term%cursor%attrs, ATTR_INVERSE) |
| 618 | |
| 619 | case (8) ! Hidden |
| 620 | term%cursor%attrs = ior(term%cursor%attrs, ATTR_HIDDEN) |
| 621 | |
| 622 | case (9) ! Strikethrough |
| 623 | term%cursor%attrs = ior(term%cursor%attrs, ATTR_STRIKETHROUGH) |
| 624 | |
| 625 | case (22) ! Normal intensity (not bold/dim) |
| 626 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_BOLD)) |
| 627 | |
| 628 | case (23) ! Not italic |
| 629 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_ITALIC)) |
| 630 | |
| 631 | case (24) ! Not underlined |
| 632 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_UNDERLINE)) |
| 633 | |
| 634 | case (25) ! Not blinking |
| 635 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_BLINK)) |
| 636 | |
| 637 | case (27) ! Not inverse |
| 638 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_INVERSE)) |
| 639 | |
| 640 | case (28) ! Not hidden |
| 641 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_HIDDEN)) |
| 642 | |
| 643 | case (29) ! Not strikethrough |
| 644 | term%cursor%attrs = iand(term%cursor%attrs, not(ATTR_STRIKETHROUGH)) |
| 645 | |
| 646 | case (30:37) ! Standard foreground colors |
| 647 | term%cursor%fg = color_from_index(param - 30) |
| 648 | |
| 649 | case (38) ! Extended foreground |
| 650 | if (i + 1 <= p%param_count) then |
| 651 | if (p%params(i + 1) == 5 .and. i + 2 <= p%param_count) then |
| 652 | ! 256-color: 38;5;n |
| 653 | term%cursor%fg = color_from_index(p%params(i + 2)) |
| 654 | i = i + 2 |
| 655 | else if (p%params(i + 1) == 2 .and. i + 4 <= p%param_count) then |
| 656 | ! RGB: 38;2;r;g;b |
| 657 | term%cursor%fg = color_from_rgb(p%params(i + 2), p%params(i + 3), p%params(i + 4)) |
| 658 | i = i + 4 |
| 659 | end if |
| 660 | end if |
| 661 | |
| 662 | case (39) ! Default foreground |
| 663 | term%cursor%fg = default_fg |
| 664 | |
| 665 | case (40:47) ! Standard background colors |
| 666 | term%cursor%bg = color_from_index(param - 40) |
| 667 | |
| 668 | case (48) ! Extended background |
| 669 | if (i + 1 <= p%param_count) then |
| 670 | if (p%params(i + 1) == 5 .and. i + 2 <= p%param_count) then |
| 671 | ! 256-color: 48;5;n |
| 672 | term%cursor%bg = color_from_index(p%params(i + 2)) |
| 673 | i = i + 2 |
| 674 | else if (p%params(i + 1) == 2 .and. i + 4 <= p%param_count) then |
| 675 | ! RGB: 48;2;r;g;b |
| 676 | term%cursor%bg = color_from_rgb(p%params(i + 2), p%params(i + 3), p%params(i + 4)) |
| 677 | i = i + 4 |
| 678 | end if |
| 679 | end if |
| 680 | |
| 681 | case (49) ! Default background |
| 682 | term%cursor%bg = default_bg |
| 683 | |
| 684 | case (90:97) ! Bright foreground colors |
| 685 | term%cursor%fg = color_from_index(param - 90 + 8) |
| 686 | |
| 687 | case (100:107) ! Bright background colors |
| 688 | term%cursor%bg = color_from_index(param - 100 + 8) |
| 689 | |
| 690 | case default |
| 691 | ! Unknown SGR parameter - ignore |
| 692 | end select |
| 693 | |
| 694 | i = i + 1 |
| 695 | end do |
| 696 | end subroutine dispatch_sgr |
| 697 | |
| 698 | ! Convert integer to string |
| 699 | function int_to_str(n) result(str) |
| 700 | integer, intent(in) :: n |
| 701 | character(len=12) :: str |
| 702 | |
| 703 | write(str, '(I0)') n |
| 704 | end function int_to_str |
| 705 | |
| 706 | end module parser_mod |
| 707 |