fortress Public

Watch 0 Fork 0 Star 0
Fortran · 6394 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 :: ESC, CLEAR, BOLD, DIM, REVERSE, RESET
10 public :: BLUE, GREEN, RED, GREY, WHITE, YELLOW
11 public :: invalidate_term_cache
12
13 ! ANSI escape codes
14 character(len=*), parameter :: ESC = char(27)
15 character(len=*), parameter :: CLEAR = ESC // "[2J" // ESC // "[H"
16 character(len=*), parameter :: BOLD = ESC // "[1m"
17 character(len=*), parameter :: DIM = ESC // "[2m"
18 character(len=*), parameter :: REVERSE = ESC // "[7m"
19 character(len=*), parameter :: RESET = ESC // "[0m"
20 character(len=*), parameter :: BLUE = ESC // "[34m"
21 character(len=*), parameter :: GREEN = ESC // "[32m"
22 character(len=*), parameter :: RED = ESC // "[31m"
23 character(len=*), parameter :: GREY = ESC // "[90m"
24 character(len=*), parameter :: WHITE = ESC // "[37m"
25 character(len=*), parameter :: YELLOW = ESC // "[33m"
26
27 ! Terminal size cache
28 integer, save :: cached_rows = 0
29 integer, save :: cached_cols = 0
30 logical, save :: cache_valid = .false.
31 integer, save :: cache_counter = 0
32 integer, parameter :: CACHE_REFRESH_INTERVAL = 100 ! Refresh every 100 calls
33
34 contains
35
36 subroutine invalidate_term_cache()
37 cache_valid = .false.
38 end subroutine invalidate_term_cache
39
40 subroutine get_term_size(r, c)
41 integer, intent(out) :: r, c
42 integer :: unit, ios
43 character(len=256) :: temp_file
44
45 ! Increment counter for periodic refresh
46 cache_counter = cache_counter + 1
47
48 ! Use cache if valid and not time for refresh
49 if (cache_valid .and. cache_counter < CACHE_REFRESH_INTERVAL) then
50 r = cached_rows
51 c = cached_cols
52 return
53 end if
54
55 ! Reset counter when refreshing
56 if (cache_counter >= CACHE_REFRESH_INTERVAL) cache_counter = 0
57
58 ! Get fresh terminal size using single command
59 call get_environment_variable("HOME", temp_file)
60 temp_file = trim(temp_file) // "/.fortress_size"
61
62 ! Get both dimensions in one command (more efficient)
63 call execute_command_line("echo ""$(tput lines) $(tput cols)"" > " // trim(temp_file) // " 2>/dev/null", wait=.true.)
64
65 open(newunit=unit, file=temp_file, status='old', iostat=ios)
66 if (ios == 0) then
67 read(unit, *, iostat=ios) r, c
68 close(unit)
69 if (ios /= 0) then
70 ! Fallback to defaults if read fails
71 r = 24
72 c = 80
73 end if
74 else
75 ! Fallback to defaults if file open fails
76 r = 24
77 c = 80
78 end if
79
80 call execute_command_line("rm -f " // trim(temp_file) // " 2>/dev/null")
81
82 ! Update cache
83 cached_rows = r
84 cached_cols = c
85 cache_valid = .true.
86 end subroutine get_term_size
87
88 subroutine setup_raw_mode()
89 ! Blocking mode for stable operation
90 call execute_command_line("stty -icanon -echo min 1 time 0 2>/dev/null", wait=.true.)
91 end subroutine setup_raw_mode
92
93 subroutine enable_read_timeout()
94 ! No-op for now
95 end subroutine enable_read_timeout
96
97 subroutine disable_read_timeout()
98 ! No-op for now
99 end subroutine disable_read_timeout
100
101 subroutine restore_terminal()
102 call execute_command_line("stty icanon echo 2>/dev/null")
103 end subroutine restore_terminal
104
105 function needs_extra_spacing() result(needs_spacing)
106 logical :: needs_spacing
107 character(len=256) :: term_var, alacritty_var
108 integer :: stat
109
110 needs_spacing = .false.
111
112 ! Check TERM environment variable
113 call get_environment_variable("TERM", term_var, status=stat)
114 if (stat == 0) then
115 ! Check if TERM contains "alacritty" or other terminals that need spacing
116 if (index(term_var, "alacritty") > 0) then
117 needs_spacing = .true.
118 return
119 end if
120 end if
121
122 ! Also check for ALACRITTY_SOCKET or ALACRITTY_LOG to detect alacritty
123 call get_environment_variable("ALACRITTY_SOCKET", alacritty_var, status=stat)
124 if (stat == 0 .and. len_trim(alacritty_var) > 0) then
125 needs_spacing = .true.
126 return
127 end if
128
129 call get_environment_variable("ALACRITTY_LOG", alacritty_var, status=stat)
130 if (stat == 0 .and. len_trim(alacritty_var) > 0) then
131 needs_spacing = .true.
132 return
133 end if
134 end function needs_extra_spacing
135
136 subroutine read_arrow_key(k)
137 character(len=1), intent(out) :: k
138 character(len=1) :: ch
139
140 read(*, '(a1)', advance='no') ch
141 if (ch == '[') then
142 read(*, '(a1)', advance='no') k
143 else
144 k = ch
145 end if
146 end subroutine read_arrow_key
147
148 subroutine read_arrow_key_with_shift(k, is_shift)
149 character(len=1), intent(out) :: k
150 logical, intent(out) :: is_shift
151 character(len=1) :: ch1, ch2, ch3, ch4
152
153 is_shift = .false.
154 k = ' '
155
156 ! Read first character after ESC
157 read(*, '(a1)', advance='no') ch1
158 if (ch1 /= '[') then
159 k = ch1
160 return
161 end if
162
163 ! Read second character
164 read(*, '(a1)', advance='no') ch2
165
166 ! Check if it's a simple arrow (just a letter)
167 if (ch2 == 'A' .or. ch2 == 'B' .or. ch2 == 'C' .or. ch2 == 'D') then
168 k = ch2
169 return
170 end if
171
172 ! Check for Shift+Arrow sequence: [1;2X where X is A/B/C/D
173 if (ch2 == '1') then
174 read(*, '(a1)', advance='no') ch3
175 if (ch3 == ';') then
176 read(*, '(a1)', advance='no') ch4
177 if (ch4 == '2') then
178 ! This is a Shift+Arrow sequence
179 read(*, '(a1)', advance='no') k
180 is_shift = .true.
181 return
182 end if
183 end if
184 end if
185
186 ! If we get here, it's some other sequence, treat as regular arrow
187 k = ch2
188 end subroutine read_arrow_key_with_shift
189
190 end module terminal_control
191