fortress Public

Watch 0 Fork 0 Star 0
Fortran · 9853 bytes Raw Blame History
1 module terminal_control
2 use iso_fortran_env, only: output_unit
3 implicit none
4 private
5
6 public :: get_term_size, setup_raw_mode, restore_terminal, read_arrow_key, read_arrow_key_with_shift
7 public :: enable_read_timeout, disable_read_timeout
8 public :: needs_extra_spacing
9 public :: read_key_with_modifiers
10 public :: ESC, CLEAR, ALT_SCREEN_ON, ALT_SCREEN_OFF, BOLD, DIM, REVERSE, NOREVERSE, RESET, UNDERLINE
11 public :: BLUE, GREEN, RED, GREY, WHITE, YELLOW, CYAN, BG_WHITE, BLACK
12 public :: invalidate_term_cache
13 public :: enter_alt_screen, exit_alt_screen, hide_cursor, show_cursor
14
15 ! ANSI escape codes
16 character(len=*), parameter :: ESC = char(27)
17 character(len=*), parameter :: CLEAR = ESC // "[H" // ESC // "[2J" ! Move to home, then clear
18 character(len=*), parameter :: ALT_SCREEN_ON = ESC // "[?1049h" ! Enter alternate screen
19 character(len=*), parameter :: ALT_SCREEN_OFF = ESC // "[?1049l" ! Exit alternate screen
20 character(len=*), parameter :: CURSOR_HIDE = ESC // "[?25l" ! Hide cursor
21 character(len=*), parameter :: CURSOR_SHOW = ESC // "[?25h" ! Show cursor
22 character(len=*), parameter :: HOME = ESC // "[1;1H" ! Explicit move to 1,1
23 character(len=*), parameter :: RESET_TERM = ESC // "c" ! Full terminal reset
24 character(len=*), parameter :: DISABLE_SCROLL = ESC // "[r" ! Reset scroll region
25 character(len=*), parameter :: BOLD = ESC // "[1m"
26 character(len=*), parameter :: DIM = ESC // "[2m"
27 character(len=*), parameter :: UNDERLINE = ESC // "[4m"
28 character(len=*), parameter :: REVERSE = ESC // "[7m"
29 character(len=*), parameter :: NOREVERSE = ESC // "[27m" ! Explicitly turn off reverse video
30 character(len=*), parameter :: RESET = ESC // "[0m"
31 character(len=*), parameter :: BLUE = ESC // "[34m"
32 character(len=*), parameter :: GREEN = ESC // "[32m"
33 character(len=*), parameter :: RED = ESC // "[31m"
34 character(len=*), parameter :: GREY = ESC // "[90m"
35 character(len=*), parameter :: WHITE = ESC // "[37m"
36 character(len=*), parameter :: YELLOW = ESC // "[33m"
37 character(len=*), parameter :: CYAN = ESC // "[36m"
38 character(len=*), parameter :: BLACK = ESC // "[30m"
39 character(len=*), parameter :: BG_WHITE = ESC // "[47m" ! White background
40
41 ! Terminal size cache
42 integer, save :: cached_rows = 0
43 integer, save :: cached_cols = 0
44 logical, save :: cache_valid = .false.
45 integer, save :: cache_counter = 0
46 integer, parameter :: CACHE_REFRESH_INTERVAL = 100 ! Refresh every 100 calls
47
48 contains
49
50 subroutine invalidate_term_cache()
51 cache_valid = .false.
52 end subroutine invalidate_term_cache
53
54 subroutine get_term_size(r, c)
55 integer, intent(out) :: r, c
56 integer :: unit, ios
57 character(len=256) :: temp_file
58
59 ! Increment counter for periodic refresh
60 cache_counter = cache_counter + 1
61
62 ! Use cache if valid and not time for refresh
63 if (cache_valid .and. cache_counter < CACHE_REFRESH_INTERVAL) then
64 r = cached_rows
65 c = cached_cols
66 return
67 end if
68
69 ! Reset counter when refreshing
70 if (cache_counter >= CACHE_REFRESH_INTERVAL) cache_counter = 0
71
72 ! Get fresh terminal size using single command
73 call get_environment_variable("HOME", temp_file)
74 temp_file = trim(temp_file) // "/.fortress_size"
75
76 ! Get both dimensions in one command (more efficient)
77 call execute_command_line("echo ""$(tput lines) $(tput cols)"" > " // trim(temp_file) // " 2>/dev/null", wait=.true.)
78
79 open(newunit=unit, file=temp_file, status='old', iostat=ios)
80 if (ios == 0) then
81 read(unit, *, iostat=ios) r, c
82 close(unit)
83 if (ios /= 0) then
84 ! Fallback to defaults if read fails
85 r = 24
86 c = 80
87 end if
88 else
89 ! Fallback to defaults if file open fails
90 r = 24
91 c = 80
92 end if
93
94 call execute_command_line("rm -f " // trim(temp_file) // " 2>/dev/null")
95
96 ! Update cache
97 cached_rows = r
98 cached_cols = c
99 cache_valid = .true.
100 end subroutine get_term_size
101
102 subroutine setup_raw_mode()
103 ! Blocking mode for stable operation
104 call execute_command_line("stty -icanon -echo min 1 time 0 2>/dev/null", wait=.true.)
105 end subroutine setup_raw_mode
106
107 subroutine enable_read_timeout()
108 ! No-op for now
109 end subroutine enable_read_timeout
110
111 subroutine disable_read_timeout()
112 ! No-op for now
113 end subroutine disable_read_timeout
114
115 subroutine restore_terminal()
116 call execute_command_line("stty icanon echo 2>/dev/null")
117 end subroutine restore_terminal
118
119 subroutine enter_alt_screen()
120 ! Switch to alternate screen buffer
121 write(output_unit, '(a)', advance='no') ALT_SCREEN_ON
122 flush(output_unit)
123 end subroutine enter_alt_screen
124
125 subroutine exit_alt_screen()
126 ! Return to main screen buffer
127 write(output_unit, '(a)', advance='no') ALT_SCREEN_OFF
128 flush(output_unit)
129 end subroutine exit_alt_screen
130
131 subroutine hide_cursor()
132 ! Hide the cursor
133 write(output_unit, '(a)', advance='no') CURSOR_HIDE
134 flush(output_unit)
135 end subroutine hide_cursor
136
137 subroutine show_cursor()
138 ! Show the cursor
139 write(output_unit, '(a)', advance='no') CURSOR_SHOW
140 flush(output_unit)
141 end subroutine show_cursor
142
143 function needs_extra_spacing() result(needs_spacing)
144 logical :: needs_spacing
145 character(len=256) :: term_var, alacritty_var
146 integer :: stat
147
148 needs_spacing = .false.
149
150 ! Check TERM environment variable
151 call get_environment_variable("TERM", term_var, status=stat)
152 if (stat == 0) then
153 ! Check if TERM contains "alacritty" or other terminals that need spacing
154 if (index(term_var, "alacritty") > 0) then
155 needs_spacing = .true.
156 return
157 end if
158 end if
159
160 ! Also check for ALACRITTY_SOCKET or ALACRITTY_LOG to detect alacritty
161 call get_environment_variable("ALACRITTY_SOCKET", alacritty_var, status=stat)
162 if (stat == 0 .and. len_trim(alacritty_var) > 0) then
163 needs_spacing = .true.
164 return
165 end if
166
167 call get_environment_variable("ALACRITTY_LOG", alacritty_var, status=stat)
168 if (stat == 0 .and. len_trim(alacritty_var) > 0) then
169 needs_spacing = .true.
170 return
171 end if
172 end function needs_extra_spacing
173
174 subroutine read_arrow_key(k)
175 character(len=1), intent(out) :: k
176 character(len=1) :: ch
177
178 read(*, '(a1)', advance='no') ch
179 if (ch == '[') then
180 read(*, '(a1)', advance='no') k
181 else
182 k = ch
183 end if
184 end subroutine read_arrow_key
185
186 subroutine read_arrow_key_with_shift(k, is_shift)
187 character(len=1), intent(out) :: k
188 logical, intent(out) :: is_shift
189 character(len=1) :: ch1, ch2, ch3, ch4
190
191 is_shift = .false.
192 k = ' '
193
194 ! Read first character after ESC
195 read(*, '(a1)', advance='no') ch1
196 if (ch1 /= '[') then
197 k = ch1
198 return
199 end if
200
201 ! Read second character
202 read(*, '(a1)', advance='no') ch2
203
204 ! Check if it's a simple arrow (just a letter)
205 if (ch2 == 'A' .or. ch2 == 'B' .or. ch2 == 'C' .or. ch2 == 'D') then
206 k = ch2
207 return
208 end if
209
210 ! Check for Shift+Arrow sequence: [1;2X where X is A/B/C/D
211 if (ch2 == '1') then
212 read(*, '(a1)', advance='no') ch3
213 if (ch3 == ';') then
214 read(*, '(a1)', advance='no') ch4
215 if (ch4 == '2') then
216 ! This is a Shift+Arrow sequence
217 read(*, '(a1)', advance='no') k
218 is_shift = .true.
219 return
220 end if
221 end if
222 end if
223
224 ! If we get here, it's some other sequence, treat as regular arrow
225 k = ch2
226 end subroutine read_arrow_key_with_shift
227
228 subroutine read_key_with_modifiers(k, is_shift, is_alt)
229 character(len=1), intent(out) :: k
230 logical, intent(out) :: is_shift, is_alt
231 character(len=1) :: ch1, ch2, ch3, ch4
232
233 is_shift = .false.
234 is_alt = .false.
235 k = ' '
236
237 ! Read first character after ESC
238 read(*, '(a1)', advance='no') ch1
239
240 if (ch1 == '[') then
241 ! Arrow key sequence
242 read(*, '(a1)', advance='no') ch2
243
244 if (ch2 == 'A' .or. ch2 == 'B' .or. ch2 == 'C' .or. ch2 == 'D') then
245 ! Simple arrow
246 k = ch2
247 return
248 end if
249
250 ! Check for Shift+Arrow: [1;2X
251 if (ch2 == '1') then
252 read(*, '(a1)', advance='no') ch3
253 if (ch3 == ';') then
254 read(*, '(a1)', advance='no') ch4
255 if (ch4 == '2') then
256 read(*, '(a1)', advance='no') k
257 is_shift = .true.
258 return
259 end if
260 end if
261 end if
262
263 ! Fallback: treat as regular arrow
264 k = ch2
265 else if (ch1 >= 'a' .and. ch1 <= 'z') then
266 ! Alt+letter sequence: ESC followed by lowercase letter
267 ! Encode as achar(1..26)
268 k = achar(1 + ichar(ch1) - ichar('a'))
269 is_alt = .true.
270 else
271 ! Just a standalone ESC or other sequence
272 k = ch1
273 end if
274 end subroutine read_key_with_modifiers
275
276 end module terminal_control
277