formerlab.tngl.sh
FORTRAT-F90 is a terminal application that fetches the AT Protocol lexicon schema. Written in Fortran
1module fortrat_render
2 use iso_fortran_env, only: real64, output_unit
3 use fortrat_types
4 implicit none
5
6 integer, parameter :: MAX_COLS = 300
7 integer, parameter :: MAX_ROWS = 100
8
9 type :: cell_t
10 character(len=1) :: ch = ' '
11 character(len=16):: color = ''
12 logical :: bold = .false.
13 end type
14
15 type(cell_t), save :: cur_frame(MAX_COLS, MAX_ROWS)
16 type(cell_t), save :: prv_frame(MAX_COLS, MAX_ROWS)
17 logical, save :: first_frame = .true.
18
19contains
20
21 subroutine render_reset_frame()
22 first_frame = .true.
23 end subroutine
24
25 subroutine render_clear(w, h)
26 integer, intent(in) :: w, h
27 integer :: c, r
28 do r = 1, h
29 do c = 1, w
30 cur_frame(c,r)%ch = ' '
31 cur_frame(c,r)%color = ''
32 cur_frame(c,r)%bold = .false.
33 end do
34 end do
35 end subroutine
36
37 subroutine render_set(c, r, ch, color, bold, w, h)
38 integer, intent(in) :: c, r, w, h
39 character(len=1), intent(in) :: ch
40 character(len=*), intent(in) :: color
41 logical, intent(in) :: bold
42 if (c < 1 .or. c > w .or. r < 1 .or. r > h) return
43 ! Don't overwrite bold (node) cells with edge chars
44 if (cur_frame(c,r)%bold .and. .not. bold) return
45 cur_frame(c,r)%ch = ch
46 cur_frame(c,r)%color = trim(color)
47 cur_frame(c,r)%bold = bold
48 end subroutine
49
50 ! Bresenham line — draw edge between two node positions
51 subroutine render_edge(x0, y0, x1, y1, color, w, h)
52 integer, intent(in) :: x0, y0, x1, y1, w, h
53 character(len=*), intent(in) :: color
54 integer :: cx, cy, dx, dy, sx, sy, err, e2
55 character(len=1) :: ch
56
57 dx = abs(x1-x0); sx = merge(1, -1, x0 < x1)
58 dy = -abs(y1-y0); sy = merge(1, -1, y0 < y1)
59 err = dx + dy
60 cx = x0; cy = y0
61
62 do
63 ! Pick character based on local slope
64 if (dx == 0 .or. abs(dy) > abs(dx)*2) then
65 ch = '|'
66 else if (dy == 0 .or. abs(dx) > abs(dy)*2) then
67 ch = '-'
68 else if ((sx > 0 .and. sy > 0) .or. (sx < 0 .and. sy < 0)) then
69 ch = '\'
70 else
71 ch = '/'
72 end if
73 ! Skip cells too close to endpoints (node area)
74 if (.not. (cx == x0 .and. cy == y0) .and. &
75 .not. (cx == x1 .and. cy == y1)) then
76 call render_set(cx, cy, ch, color, .false., w, h)
77 end if
78 if (cx == x1 .and. cy == y1) exit
79 e2 = 2 * err
80 if (e2 >= dy) then; err = err + dy; cx = cx + sx; end if
81 if (e2 <= dx) then; err = err + dx; cy = cy + sy; end if
82 end do
83 end subroutine
84
85 ! Draw a node sigil at position
86 subroutine render_node(cx, cy, lbl, color, selected, w, h)
87 integer, intent(in) :: cx, cy, w, h
88 character(len=*), intent(in) :: lbl, color
89 logical, intent(in) :: selected
90 integer :: i, llen, start_col
91 character(len=12) :: display
92 llen = min(len_trim(lbl), 10) ! cap at 10 chars
93 if (selected) then
94 display = '['//lbl(1:llen)//']'
95 llen = llen + 2
96 else
97 display = lbl(1:llen)
98 end if
99 ! Centre the label on cx
100 start_col = cx - llen/2
101 do i = 1, llen
102 call render_set(start_col + i - 1, cy, display(i:i), color, selected, w, h)
103 end do
104 end subroutine
105
106 ! Draw text string at position (truncated to fit)
107 subroutine render_text(c, r, text, color, bold, w, h)
108 integer, intent(in) :: c, r, w, h
109 character(len=*), intent(in) :: text, color
110 logical, intent(in) :: bold
111 integer :: i, len_t
112 len_t = min(len_trim(text), w - c + 1)
113 do i = 1, len_t
114 call render_set(c + i - 1, r, text(i:i), color, bold, w, h)
115 end do
116 end subroutine
117
118 ! Flush frame — build entire output as one buffer, write atomically (no flicker)
119 subroutine render_flush(w, h)
120 use fortrat_tui, only: fortrat_write_buf, fortrat_flush
121 use iso_c_binding
122 integer, intent(in) :: w, h
123 ! Frame buffer: enough for clear + all cells
124 ! Each cell: ~20 bytes (cursor pos + color + char + reset)
125 ! Max cells: 300*100 = 30000 * 20 = 600KB — use allocatable
126 character(len=1), allocatable :: fbuf(:)
127 integer :: fbuf_size, fpos
128 integer :: c, r, cl
129 character(len=32) :: pos_seq
130 integer :: pos_len
131
132 fbuf_size = 9 + w * h * 16 ! home seq + per cell: color+bold+char+reset ~16 bytes
133 allocate(fbuf(fbuf_size))
134 fpos = 0
135
136 ! Start with: hide cursor, home cursor only (no clear — prevents scroll)
137 call fbuf_append(fbuf, fpos, char(27)//'[?25l', 6) ! hide cursor
138 call fbuf_append(fbuf, fpos, char(27)//'[H', 3) ! cursor home row 1 col 1
139
140 ! Write all cells — including spaces — so previous frame is fully overwritten
141 do r = 1, h
142 ! Move to start of row
143 write(pos_seq, '(a,i0,a,i0,a)') char(27)//'[', r, ';1H'
144 pos_len = len_trim(pos_seq)
145 call fbuf_append(fbuf, fpos, pos_seq(1:pos_len), pos_len)
146
147 do c = 1, w
148 ! Color
149 if (len_trim(cur_frame(c,r)%color) > 0) then
150 cl = len_trim(cur_frame(c,r)%color)
151 call fbuf_append(fbuf, fpos, cur_frame(c,r)%color(1:cl), cl)
152 else
153 call fbuf_append(fbuf, fpos, char(27)//'[0m', 4)
154 end if
155 ! Bold
156 if (cur_frame(c,r)%bold) then
157 call fbuf_append(fbuf, fpos, char(27)//'[1m', 4)
158 end if
159 ! Character
160 call fbuf_append(fbuf, fpos, cur_frame(c,r)%ch, 1)
161 prv_frame(c,r) = cur_frame(c,r)
162 if (fpos > fbuf_size - 64) exit
163 end do
164 ! Reset at end of row
165 call fbuf_append(fbuf, fpos, char(27)//'[0m', 4)
166 if (fpos > fbuf_size - 64) exit
167 end do
168
169 ! Single write call — atomic, no flicker
170 call fortrat_write_buf(fbuf, int(fpos, c_int))
171 call fortrat_flush()
172 deallocate(fbuf)
173 first_frame = .false.
174 end subroutine
175
176 subroutine fbuf_append(buf, pos, str, n)
177 character(len=1), intent(inout) :: buf(:)
178 integer, intent(inout) :: pos
179 character(len=*), intent(in) :: str
180 integer, intent(in) :: n
181 integer :: i
182 do i = 1, n
183 pos = pos + 1
184 if (pos <= size(buf)) buf(pos) = str(i:i)
185 end do
186 end subroutine
187
188 ! ── Main graph pane render ──
189 subroutine render_graph_pane(graph, state, w, h, row_off)
190 type(lex_graph_t), intent(in) :: graph
191 type(app_state_t), intent(in) :: state
192 integer, intent(in) :: w, h, row_off
193 integer :: i, cx, cy, vis_idx
194 character(len=16) :: col
195 logical :: selected, dimmed
196 integer :: visible_nodes(MAX_NODES), n_vis
197 ! Build visible node index list
198 n_vis = 0
199 do i = 1, graph%n_nodes
200 if (graph%nodes(i)%active) then
201 n_vis = n_vis + 1
202 visible_nodes(n_vis) = i
203 end if
204 end do
205
206 ! Draw edges first
207 do i = 1, graph%n_edges
208 if (graph%edges(i)%src == 0) cycle
209 if (.not. graph%nodes(graph%edges(i)%src)%active) cycle
210 if (.not. graph%nodes(graph%edges(i)%tgt)%active) cycle
211 cx = nint(graph%nodes(graph%edges(i)%src)%x)
212 cy = nint(graph%nodes(graph%edges(i)%src)%y) + row_off
213 call render_edge( &
214 cx, cy, &
215 nint(graph%nodes(graph%edges(i)%tgt)%x), &
216 nint(graph%nodes(graph%edges(i)%tgt)%y) + row_off, &
217 GREEN_DIM, w, h)
218 end do
219
220 ! Draw nodes
221 vis_idx = 0
222 do i = 1, graph%n_nodes
223 if (.not. graph%nodes(i)%active) cycle
224 vis_idx = vis_idx + 1
225 cx = nint(graph%nodes(i)%x)
226 cy = nint(graph%nodes(i)%y) + row_off
227 col = ns_color(graph%nodes(i)%ns_group)
228 selected = (vis_idx == state%cursor_idx .or. i == state%selected_idx)
229 dimmed = len_trim(state%search_query) > 0 .and. &
230 index(graph%nodes(i)%id, trim(state%search_query)) == 0
231 if (dimmed) col = GREEN_DIM
232 call render_node(cx, cy, trim(graph%nodes(i)%label), col, selected, w, h)
233 end do
234 end subroutine
235
236 ! ── Inspect pane ──
237 subroutine render_inspect_pane(graph, state, col_off, w, h)
238 type(lex_graph_t), intent(in) :: graph
239 type(app_state_t), intent(in) :: state
240 integer, intent(in) :: col_off, w, h
241 integer :: row, i, idx, vis_idx, n_out, pane_w
242 character(len=ID_LEN) :: out_ids(64)
243 character(len=3) :: sigil
244
245 pane_w = w - col_off
246 row = 2
247
248 idx = 0
249 vis_idx = 0
250 do i = 1, graph%n_nodes
251 if (.not. graph%nodes(i)%active) cycle
252 vis_idx = vis_idx + 1
253 if (vis_idx == state%cursor_idx) then; idx = i; exit; end if
254 end do
255 if (state%selected_idx > 0) idx = state%selected_idx
256
257 if (idx == 0) then
258 call render_text(col_off, row, 'C NO NODE SELECTED', GREEN_DIM, .false., w, h)
259 call render_text(col_off, row+2, ' HJKL : navigate', GREEN_DIM, .false., w, h)
260 call render_text(col_off, row+3, ' ENTER : inspect', GREEN_DIM, .false., w, h)
261 call render_text(col_off, row+4, ' / : search', GREEN_DIM, .false., w, h)
262 call render_text(col_off, row+5, ' TAB : toggle ns',GREEN_DIM, .false., w, h)
263 call render_text(col_off, row+6, ' C : community',GREEN_DIM, .false., w, h)
264 call render_text(col_off, row+7, ' Q : quit', GREEN_DIM, .false., w, h)
265 return
266 end if
267
268 sigil = KIND_SIGIL(graph%nodes(idx)%kind)(1:3)
269 call render_text(col_off, row, 'SUBROUTINE INSPECT('//sigil//')', GREEN_BR, .true., w, h)
270 row = row + 1
271 call render_text(col_off, row, repeat('-', pane_w), GREEN_DIM, .false., w, h)
272 row = row + 1
273 call render_text(col_off, row, trim(graph%nodes(idx)%id), GREEN_BR, .true., w, h)
274 row = row + 2
275
276 call render_text(col_off, row, 'COMMON /LEXDATA/', GREEN_DIM, .false., w, h)
277 row = row + 1
278 call render_text(col_off, row, ' KIND '//sigil, GREEN, .false., w, h)
279 row = row + 1
280 call render_text(col_off, row, ' NS_GROUP '//ns_name(graph%nodes(idx)%ns_group), GREEN, .false., w, h)
281 row = row + 1
282 if (graph%nodes(idx)%ns_group == NS_COMMUNITY) then
283 call render_text(col_off, row, ' ORIGIN EXTERNAL', YELLOW, .false., w, h)
284 row = row + 1
285 end if
286 row = row + 1
287
288 ! Description with word-wrap
289 if (len_trim(graph%nodes(idx)%doc) > 0 .and. row < h - 3) then
290 block
291 integer :: dlen, lw, pos, npos
292 character(len=DOC_LEN) :: doc
293 doc = trim(graph%nodes(idx)%doc)
294 dlen = len_trim(doc)
295 lw = pane_w - 6
296 pos = 1
297 call render_text(col_off, row, 'C DESCRIPTION', GREEN_DIM, .false., w, h)
298 row = row + 1
299 do while (pos <= dlen .and. row < h - 3)
300 npos = min(pos + lw - 1, dlen)
301 call render_text(col_off, row, 'C '//doc(pos:npos), GREEN_DIM, .false., w, h)
302 pos = npos + 1
303 row = row + 1
304 end do
305 row = row + 1
306 end block
307 end if
308
309 ! Fields
310 if (graph%nodes(idx)%n_fields > 0 .and. row < h - 3) then
311 call render_text(col_off, row, 'C FIELDS', GREEN_DIM, .false., w, h)
312 row = row + 1
313 do i = 1, min(graph%nodes(idx)%n_fields, 8)
314 if (graph%nodes(idx)%fields(i)%required) then
315 call render_text(col_off, row, ' '//trim(graph%nodes(idx)%fields(i)%name), GREEN_BR, .false., w, h)
316 else
317 call render_text(col_off, row, 'C '//trim(graph%nodes(idx)%fields(i)%name), GREEN, .false., w, h)
318 end if
319 row = row + 1
320 if (row >= h - 2) exit
321 end do
322 row = row + 1
323 end if
324
325 ! Outbound refs
326 if (row < h - 4) then
327 n_out = 0
328 do i = 1, graph%n_edges
329 if (graph%edges(i)%src == idx) then
330 n_out = n_out + 1
331 if (n_out <= 4) out_ids(n_out) = graph%nodes(graph%edges(i)%tgt)%id
332 end if
333 end do
334 if (n_out > 0) then
335 call render_text(col_off, row, 'C CALL/REF', GREEN_DIM, .false., w, h)
336 row = row + 1
337 do i = 1, min(n_out, 4)
338 call render_text(col_off, row, ' CALL '//trim(out_ids(i)), GREEN, .false., w, h)
339 row = row + 1
340 if (row >= h - 2) exit
341 end do
342 end if
343 end if
344
345 call render_text(col_off, h-1, 'END SUBROUTINE INSPECT', GREEN_DIM, .false., w, h)
346 end subroutine
347
348 ! ── Column ruler ──
349 subroutine render_ruler(w, h)
350 integer, intent(in) :: w, h
351 character(len=80) :: ruler
352 ruler = 'C23456789012345678901234567890123456789012345678901234567890123456789072'
353 call render_text(1, 1, ruler(1:min(w,72)), GREEN_DIM, .false., w, h)
354 end subroutine
355
356 ! ── Pane header bar ──
357 subroutine render_header(w, h, divider_col)
358 integer, intent(in) :: w, h, divider_col
359 integer :: i
360 character(len=w) :: line
361 character(len=32) :: left_hdr, right_hdr
362
363 line = repeat('-', w)
364 left_hdr = '-[FORTRAT:GRAPH]'
365 right_hdr = '-[INSPECT]'
366 line(1:len_trim(left_hdr)) = left_hdr
367 line(divider_col:divider_col) = '+'
368 line(divider_col+1:divider_col+len_trim(right_hdr)) = right_hdr(1:len_trim(right_hdr))
369
370 call render_text(1, 2, line, GREEN_DIM, .false., w, h)
371
372 ! Vertical divider
373 do i = 3, h - 1
374 call render_set(divider_col, i, '|', GREEN_DIM, .false., w, h)
375 end do
376 end subroutine
377
378 ! ── Status bar ──
379 subroutine render_status(state, graph, w, h)
380 type(app_state_t), intent(in) :: state
381 type(lex_graph_t), intent(in) :: graph
382 integer, intent(in) :: w, h
383 character(len=w) :: bar
384 character(len=32) :: left_part, right_part, mode_str
385 character(len=16) :: n_str, e_str
386 integer :: n_vis, n_edg, i
387
388 select case(state%mode)
389 case(MODE_GRAPH); mode_str = '[GRAPH]'
390 case(MODE_SEARCH); mode_str = '[SEARCH]'
391 case(MODE_INSPECT); mode_str = '[INSPECT]'
392 case(MODE_LOADING); mode_str = '[LOADING]'
393 case default; mode_str = '[?]'
394 end select
395
396 n_vis = 0
397 do i = 1, graph%n_nodes
398 if (graph%nodes(i)%active) n_vis = n_vis + 1
399 end do
400 n_edg = graph%n_edges
401
402 write(n_str, '(i0)') n_vis
403 write(e_str, '(i0)') n_edg
404
405 left_part = ' FORTRAT '//trim(mode_str)//' '//trim(state%status_msg)
406 right_part = ' N='//trim(n_str)//' E='//trim(e_str)//' '
407
408 bar = repeat(' ', w)
409 bar(1:min(len_trim(left_part),w)) = left_part(1:min(len_trim(left_part),w))
410 bar(w-len_trim(right_part)+1:w) = right_part
411
412 call render_text(1, h, bar, GREEN, .true., w, h)
413 end subroutine
414
415 ! ── Loading screen ──
416 subroutine render_loading(state, w, h)
417 type(app_state_t), intent(in) :: state
418 integer, intent(in) :: w, h
419 integer :: r
420
421 r = 2
422 call render_text(1, r, 'C23456789012345678901234567890123456789012345678901234567890123456789072', GREEN_DIM, .false., w, h)
423 r = r + 2
424 call render_text(7, r, 'FORTRAT V1.0 (FORMERLAB 2026)', GREEN_BR, .true., w, h)
425 r = r + 1
426 call render_text(7, r, 'COPYRIGHT (C) FORMERLAB. ALL RIGHTS RESERVED.', GREEN_DIM, .false., w, h)
427 r = r + 2
428 call render_text(7, r, 'IMPLICIT NONE', GREEN, .false., w, h); r=r+1
429 call render_text(7, r, 'CHARACTER*(256) QUERY', GREEN, .false., w, h); r=r+1
430 call render_text(7, r, 'INTEGER N_NODES, N_EDGES', GREEN, .false., w, h); r=r+1
431 call render_text(7, r, 'LOGICAL COMMUNITY_FLAG', GREEN, .false., w, h); r=r+1
432 call render_text(7, r, 'DATA COMMUNITY_FLAG /.FALSE./', GREEN, .false., w, h); r=r+2
433 call render_text(7, r, 'CALL FETCH_LEXICONS(ATPROTO_REPO, GRAPH)', GREEN, .false., w, h); r=r+2
434 call render_text(7, r, 'C STATUS:', GREEN_DIM, .false., w, h); r=r+1
435 call render_text(7, r, '>> '//trim(state%progress), GREEN_BR, .false., w, h)
436 end subroutine
437
438 ! Helper
439 function ns_name(ns) result(s)
440 integer, intent(in) :: ns
441 character(len=20) :: s
442 select case(ns)
443 case(NS_APP_BSKY); s = 'app.bsky'
444 case(NS_COM_ATPROTO); s = 'com.atproto'
445 case(NS_CHAT_BSKY); s = 'chat.bsky'
446 case(NS_TOOLS_OZONE); s = 'tools.ozone'
447 case default; s = 'community'
448 end select
449 end function
450
451end module fortrat_render