facsimile Public

Watch 0 Fork 0 Star 0
Fortran · 6596 bytes Raw Blame History
1 module terminal_io_module
2 use iso_c_binding
3 use iso_fortran_env, only: output_unit, input_unit
4 use raw_mode_module, only: raw_enable_raw_mode => enable_raw_mode, &
5 raw_disable_raw_mode => disable_raw_mode, &
6 raw_input_available => input_available, &
7 raw_read_char_timeout => read_char_timeout, &
8 raw_read_char_escape => read_char_escape, &
9 raw_input_available_count => input_available_count
10 implicit none
11 private
12
13 public :: terminal_init, terminal_cleanup, terminal_clear_screen
14 public :: terminal_move_cursor, terminal_hide_cursor, terminal_show_cursor
15 public :: terminal_get_size, terminal_enable_raw_mode, terminal_disable_raw_mode
16 public :: terminal_write, terminal_enable_mouse, terminal_disable_mouse
17 public :: terminal_input_available, terminal_read_char
18 public :: terminal_read_char_escape, terminal_input_available_count
19
20 ! ANSI escape codes
21 character(len=*), parameter :: ESC = char(27)
22 character(len=*), parameter :: CSI = ESC // '['
23
24 contains
25
26 subroutine terminal_init()
27 call terminal_enable_raw_mode()
28 call terminal_enable_mouse()
29 call terminal_clear_screen()
30 call terminal_hide_cursor()
31 end subroutine terminal_init
32
33 subroutine terminal_cleanup()
34 call terminal_show_cursor()
35 call terminal_disable_mouse()
36 call terminal_clear_screen()
37 call terminal_move_cursor(1, 1)
38 call terminal_disable_raw_mode()
39 end subroutine terminal_cleanup
40
41 subroutine terminal_clear_screen()
42 write(output_unit, '(a)', advance='no') CSI // '2J'
43 write(output_unit, '(a)', advance='no') CSI // 'H'
44 flush(output_unit)
45 end subroutine terminal_clear_screen
46
47 subroutine terminal_move_cursor(row, col)
48 integer, intent(in) :: row, col
49 character(len=32) :: seq
50
51 write(seq, '(a,i0,a,i0,a)') CSI, row, ';', col, 'H'
52 write(output_unit, '(a)', advance='no') trim(seq)
53 flush(output_unit)
54 end subroutine terminal_move_cursor
55
56 subroutine terminal_hide_cursor()
57 write(output_unit, '(a)', advance='no') CSI // '?25l'
58 flush(output_unit)
59 end subroutine terminal_hide_cursor
60
61 subroutine terminal_show_cursor()
62 write(output_unit, '(a)', advance='no') CSI // '?25h'
63 flush(output_unit)
64 end subroutine terminal_show_cursor
65
66 subroutine terminal_get_size(rows, cols)
67 integer, intent(out) :: rows, cols
68 character(len=32) :: response
69 integer :: ios, r, c
70
71 ! Request cursor position after moving to bottom-right
72 write(output_unit, '(a)', advance='no') CSI // '999;999H'
73 write(output_unit, '(a)', advance='no') CSI // '6n'
74 flush(output_unit)
75
76 ! Read response (format: ESC[row;colR)
77 read(input_unit, '(a)', iostat=ios) response
78
79 ! Parse response
80 if (ios == 0 .and. response(1:2) == ESC // '[') then
81 ! Parse the response manually to handle variable width
82 call parse_cursor_response(response(3:), r, c)
83 rows = r
84 cols = c
85 else
86 ! Fallback to default
87 rows = 24
88 cols = 80
89 end if
90 end subroutine terminal_get_size
91
92 subroutine terminal_enable_raw_mode()
93 logical :: success
94
95 success = raw_enable_raw_mode()
96 if (.not. success) then
97 ! Fallback - just disable echo
98 write(output_unit, '(a)', advance='no') ESC // '[12l'
99 flush(output_unit)
100 end if
101 end subroutine terminal_enable_raw_mode
102
103 subroutine terminal_disable_raw_mode()
104 logical :: success
105
106 success = raw_disable_raw_mode()
107 if (.not. success) then
108 ! Fallback - re-enable echo
109 write(output_unit, '(a)', advance='no') ESC // '[12h'
110 flush(output_unit)
111 end if
112 end subroutine terminal_disable_raw_mode
113
114 function terminal_input_available() result(available)
115 logical :: available
116 available = raw_input_available()
117 end function terminal_input_available
118
119 function terminal_read_char() result(ch)
120 integer :: ch
121 ch = raw_read_char_timeout()
122 end function terminal_read_char
123
124 ! Fast read for escape sequences (5ms timeout)
125 function terminal_read_char_escape() result(ch)
126 integer :: ch
127 ch = raw_read_char_escape()
128 end function terminal_read_char_escape
129
130 ! Get count of available input bytes
131 function terminal_input_available_count() result(count)
132 integer :: count
133 count = raw_input_available_count()
134 end function terminal_input_available_count
135
136 subroutine terminal_write(text)
137 character(len=*), intent(in) :: text
138 write(output_unit, '(a)', advance='no') text
139 flush(output_unit)
140 end subroutine terminal_write
141
142 subroutine parse_cursor_response(response, row, col)
143 character(len=*), intent(in) :: response
144 integer, intent(out) :: row, col
145 integer :: semicolon_pos, r_pos, ios
146
147 row = 24
148 col = 80
149
150 ! Find semicolon position
151 semicolon_pos = index(response, ';')
152 if (semicolon_pos == 0) return
153
154 ! Find 'R' position
155 r_pos = index(response, 'R')
156 if (r_pos == 0) return
157
158 ! Parse row and column
159 read(response(1:semicolon_pos-1), '(i10)', iostat=ios) row
160 if (ios /= 0) return
161
162 read(response(semicolon_pos+1:r_pos-1), '(i10)', iostat=ios) col
163 if (ios /= 0) return
164 end subroutine parse_cursor_response
165
166 subroutine terminal_enable_mouse()
167 ! Enable mouse tracking modes:
168 ! 1000 - Enable normal mouse tracking
169 ! 1002 - Enable button-motion tracking (for drag)
170 ! 1006 - Enable SGR extended mode (for large terminals)
171 write(output_unit, '(a)', advance='no') CSI // '?1000h'
172 write(output_unit, '(a)', advance='no') CSI // '?1002h'
173 write(output_unit, '(a)', advance='no') CSI // '?1006h'
174 flush(output_unit)
175 end subroutine terminal_enable_mouse
176
177 subroutine terminal_disable_mouse()
178 ! Disable mouse tracking modes
179 write(output_unit, '(a)', advance='no') CSI // '?1006l'
180 write(output_unit, '(a)', advance='no') CSI // '?1002l'
181 write(output_unit, '(a)', advance='no') CSI // '?1000l'
182 flush(output_unit)
183 end subroutine terminal_disable_mouse
184
185 end module terminal_io_module