fortress Public

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