FORTRAT-F90 is a terminal application that fetches the AT Protocol lexicon schema. Written in Fortran
FORTRAT-F90 v0.1.0 — AT Protocol lexicon explorer in Fortran
+1794
+49
Makefile
+49
Makefile
···
1
+
# FORTRAT — Makefile
2
+
# Requires: gfortran, libcurl-dev, json-fortran
3
+
#
4
+
# json-fortran: clone and build first:
5
+
# git clone https://github.com/jacobwilliams/json-fortran vendor/json-fortran
6
+
# cd vendor/json-fortran && mkdir build && cd build && cmake .. && make
7
+
#
8
+
# Then: make
9
+
10
+
CC = gcc
11
+
FC = gfortran
12
+
FFLAGS = -O2 -std=f2018 -Wall -fimplicit-none
13
+
CFLAGS = -O2 -Wall
14
+
LIBS = -lcurl
15
+
JSONF = vendor/json-fortran/build/lib/libjsonfortran.a
16
+
JSONINC = -I vendor/json-fortran/build/include
17
+
18
+
SRC = src/types.f90 \
19
+
src/tui.f90 \
20
+
src/simulate.f90 \
21
+
src/render.f90 \
22
+
src/fetch.f90 \
23
+
src/lexparse.f90 \
24
+
src/main.f90
25
+
26
+
.PHONY: all clean
27
+
28
+
all: fortrat
29
+
30
+
src/tui_helper.o: src/tui_helper.c
31
+
$(CC) $(CFLAGS) -c src/tui_helper.c -o src/tui_helper.o
32
+
33
+
fortrat: $(SRC) $(JSONF) src/tui_helper.o
34
+
$(FC) $(FFLAGS) $(JSONINC) -o fortrat $(SRC) src/tui_helper.o $(JSONF) $(LIBS)
35
+
36
+
$(JSONF):
37
+
@echo "Building json-fortran..."
38
+
@mkdir -p vendor
39
+
@if [ ! -d vendor/json-fortran ]; then \
40
+
git clone --depth=1 https://github.com/jacobwilliams/json-fortran vendor/json-fortran; \
41
+
fi
42
+
@mkdir -p vendor/json-fortran/build
43
+
@cd vendor/json-fortran/build && cmake .. -DSKIP_DOC_GEN=TRUE && $(MAKE) --no-print-directory
44
+
45
+
clean:
46
+
rm -f fortrat *.mod *.o src/*.o
47
+
48
+
distclean: clean
49
+
rm -rf vendor/json-fortran/build
+140
README.md
+140
README.md
···
1
+
# FORTRAT-F90
2
+
3
+
**AT Protocol lexicon explorer — written in Fortran**
4
+
5
+
6
+
7
+
8
+
---
9
+
10
+
## So what is this?
11
+
12
+
FORTRAT-F90 is a terminal application that fetches the AT Protocol lexicon schema from GitHub, builds a force-directed graph of all record types and their references, and renders it as ASCII art in your terminal.
13
+
14
+
It is written in Fortran. And if you run it, it's running wild :) Still early
15
+
16
+
Not "inspired by Fortran". Not "has some Fortran vibes". Written in Fortran. The HTTP requests are Fortran. The JSON parsing is Fortran. The force simulation is Fortran. The ASCII renderer is Fortran. The terminal raw mode is a 40-line C helper because `tcsetattr` is a POSIX syscall and we are not animals.
17
+
18
+
```
19
+
./fortrat
20
+
```
21
+
22
+
That is a Fortran binary talking to the AT Protocol.
23
+
24
+
---
25
+
26
+
## Why?
27
+
28
+
[Fortransky](https://github.com/FormerLab/fortransky) — our FORTRAN Bluesky client — shipped a few days before Atmosphere 2026. The AT Proto crowd found out that someone had written a Bluesky client in a language from 1957. This was considered funny. We considered it a mandate :)
29
+
30
+
FORTRAT-F90 is the follow-up, our inhouse AT Ptoto lexicon explorer now open sourced. If Fortransky proved you *could* post to Bluesky from Fortran, FORTRAT-F90 proves you can also explore the entire AT Protocol schema from Fortran while watching a force simulation settle in real time.
31
+
32
+
The name is FORTRAN + AT Protocol. FORTRAN identifiers were limited to 6 characters. We used 6. We showed restraint.
33
+
34
+
---
35
+
36
+
## What you are looking at
37
+
38
+
The AT Protocol defines every data type on the network in a schema system called **lexicons**. A post is a lexicon. A like is a lexicon. A follow, a label, a moderation action — all lexicons, all formally specified in JSON, all living in the [atproto repository](https://github.com/bluesky-social/atproto/tree/main/lexicons).
39
+
40
+
FORTRAT-F90 fetches all of them, builds a graph where nodes are lexicon types and edges are references between them, and renders it. The dense blue-green cluster in the middle is `app.bsky.*`. The orbiting yellow nodes are `com.atproto.*`. The purple ones are `tools.ozone.*`. The force simulation pulls related types together and pushes unrelated ones apart, so the layout roughly reflects the actual structure of the protocol.
41
+
42
+
It updates every 150ms. The nodes drift.
43
+
44
+
---
45
+
46
+
## Architecture
47
+
48
+
Everything is Fortran. The exception is noted with appropriate shame.
49
+
50
+
```
51
+
src/types.f90 — all shared types, ANSI escape constants
52
+
src/tui.f90 — terminal control (ISO C binding → C helper)
53
+
src/tui_helper.c — 60 lines of C (tcsetattr, write, ioctl — we tried)
54
+
src/simulate.f90 — force-directed simulation, pure Fortran math
55
+
src/render.f90 — ASCII grid renderer, Bresenham lines, frame buffer
56
+
src/fetch.f90 — HTTP (ISO C binding → libcurl)
57
+
src/lexparse.f90 — JSON (json-fortran), graph builder
58
+
src/main.f90 — event loop, state machine
59
+
```
60
+
61
+
The renderer builds the entire frame into a Fortran allocatable array and sends it to C in a single `write()` call. This is how we avoid flicker. It works.
62
+
63
+
---
64
+
65
+
## Build
66
+
67
+
### Dependencies
68
+
69
+
```bash
70
+
# Arch / Garuda
71
+
sudo pacman -S gcc-fortran curl cmake git
72
+
73
+
# Ubuntu / Debian
74
+
sudo apt install gfortran libcurl4-openssl-dev cmake git
75
+
```
76
+
77
+
### Build
78
+
79
+
```bash
80
+
make
81
+
```
82
+
83
+
The Makefile clones and builds [json-fortran](https://github.com/jacobwilliams/json-fortran) into `vendor/` automatically on first run. Subsequent builds skip this step.
84
+
85
+
```bash
86
+
./fortrat
87
+
```
88
+
89
+
Allow 2-3 minutes for the initial lexicon fetch (~256 files from GitHub's CDN). After that it runs locally.
90
+
91
+
---
92
+
93
+
## Controls
94
+
95
+
| Key | Action |
96
+
|-----|--------|
97
+
| `hjkl` / arrows | Navigate between nodes |
98
+
| `Enter` | Inspect selected node |
99
+
| `Esc` | Deselect |
100
+
| `/` | Search lexicons |
101
+
| `Tab` | Toggle namespace visibility |
102
+
| `c` | Toggle community lexicons |
103
+
| `q` | Quit |
104
+
105
+
---
106
+
107
+
## Recommended terminal size
108
+
109
+
120×40 minimum. The wider the better. The graph breathes at 200+ columns
110
+
111
+
Works in cool-retro-term (phosphor green preset, obviously) and in any modern terminal. The screenshots from cool-retro-term looked better. The screenshots from a normal terminal are more readable. Both are valid choices and we will not judge you.
112
+
113
+
---
114
+
115
+
## Relation to Fortransky
116
+
117
+
[Fortransky](https://github.com/FormerLab/fortransky) is a FORTRAN Bluesky client. It posts. It reads timelines. It has a Rust decoder for the firehose and an x86-64 assembly decoder for fun. It is arguably the most over-engineered Bluesky client in existence...
118
+
119
+
FORTRAT-F90 is Fortran 2018. It uses allocatable strings, `iso_c_binding`, and modern modules. By comparison it is practically contemporary software.
120
+
121
+
Both are part of the FormerLab sovereign computing ecosystem, which is a fancy way of saying we build things that have no business existing and then release them anyway.
122
+
123
+
---
124
+
125
+
## Known limitations
126
+
127
+
- GitHub's unauthenticated API is rate-limited to 60 requests/hour. If the fetch fails, wait an hour or set a `GITHUB_TOKEN` in a proxy.
128
+
- The force simulation is O(n²). With 256 nodes it runs fine. With 2000 nodes it would not.
129
+
- The JSON parser is the excellent [json-fortran](https://github.com/jacobwilliams/json-fortran) by Jacob Williams. Without it this project would have required writing a JSON parser in Fortran, which we were prepared to do but preferred not to.
130
+
- `tui_helper.c` exists. We know.
131
+
132
+
---
133
+
134
+
## FormerLab
135
+
136
+
[formerlab.eu](https://formerlab.eu)
137
+
138
+
Building things that have no business existing since whenever this started.
139
+
140
+
FORTRAT = FORTRAN + AT Protocol. Six characters. We counted.
assets/screenshot-modern.png
assets/screenshot-modern.png
This is a binary file and will not be displayed.
assets/screenshot-retro.png
assets/screenshot-retro.png
This is a binary file and will not be displayed.
+23
fpm.toml
+23
fpm.toml
···
1
+
[build]
2
+
auto-executables = true
3
+
auto-tests = false
4
+
auto-examples = false
5
+
6
+
[dependencies]
7
+
json-fortran = { git = "https://github.com/jacobwilliams/json-fortran" }
8
+
9
+
[install]
10
+
library = false
11
+
12
+
[fortran]
13
+
implicit-typing = false
14
+
implicit-external = false
15
+
source-form = "free"
16
+
17
+
[[executable]]
18
+
name = "fortrat"
19
+
source-dir = "src"
20
+
main = "main.f90"
21
+
22
+
[link]
23
+
libraries = ["curl"]
+166
src/fetch.f90
+166
src/fetch.f90
···
1
+
module fortrat_fetch
2
+
use iso_c_binding
3
+
use fortrat_types
4
+
implicit none
5
+
6
+
! libcurl constants
7
+
integer(c_long), parameter :: CURLOPT_URL = 10002
8
+
integer(c_long), parameter :: CURLOPT_WRITEFUNCTION = 20011
9
+
integer(c_long), parameter :: CURLOPT_WRITEDATA = 10001
10
+
integer(c_long), parameter :: CURLOPT_USERAGENT = 10018
11
+
integer(c_long), parameter :: CURLOPT_FOLLOWLOCATION = 52
12
+
integer(c_long), parameter :: CURLOPT_SSL_VERIFYPEER = 64
13
+
integer(c_long), parameter :: CURLOPT_HTTPHEADER = 10023
14
+
integer(c_long), parameter :: CURLOPT_TIMEOUT = 30
15
+
integer(c_long), parameter :: CURLOPT_CONNECTTIMEOUT = 10
16
+
integer(c_long), parameter :: CURL_GLOBAL_ALL = 3
17
+
18
+
type(c_ptr), save :: curl_handle = c_null_ptr
19
+
20
+
! Dynamic buffer for HTTP response
21
+
integer, parameter :: MAX_HTTP_BUF = 8 * 1024 * 1024 ! 8 MB
22
+
character(len=1), save, target :: http_buf(MAX_HTTP_BUF)
23
+
integer, save :: http_buf_len = 0
24
+
25
+
interface
26
+
function curl_global_init(flags) bind(c, name='curl_global_init') result(r)
27
+
import c_long, c_int
28
+
integer(c_long), value :: flags
29
+
integer(c_int) :: r
30
+
end function
31
+
32
+
function curl_easy_init() bind(c, name='curl_easy_init') result(h)
33
+
import c_ptr
34
+
type(c_ptr) :: h
35
+
end function
36
+
37
+
function curl_easy_setopt_ptr(handle, option, param) &
38
+
bind(c, name='curl_easy_setopt') result(r)
39
+
import c_ptr, c_long, c_int
40
+
type(c_ptr), value :: handle
41
+
integer(c_long), value :: option
42
+
type(c_ptr), value :: param
43
+
integer(c_int) :: r
44
+
end function
45
+
46
+
function curl_easy_setopt_long(handle, option, param) &
47
+
bind(c, name='curl_easy_setopt') result(r)
48
+
import c_ptr, c_long, c_int
49
+
type(c_ptr), value :: handle
50
+
integer(c_long), value :: option, param
51
+
integer(c_int) :: r
52
+
end function
53
+
54
+
function curl_easy_setopt_funptr(handle, option, param) &
55
+
bind(c, name='curl_easy_setopt') result(r)
56
+
import c_ptr, c_long, c_int, c_funptr
57
+
type(c_ptr), value :: handle
58
+
integer(c_long), value :: option
59
+
type(c_funptr), value :: param
60
+
integer(c_int) :: r
61
+
end function
62
+
63
+
function curl_easy_perform(handle) bind(c, name='curl_easy_perform') result(r)
64
+
import c_ptr, c_int
65
+
type(c_ptr), value :: handle
66
+
integer(c_int) :: r
67
+
end function
68
+
69
+
subroutine curl_easy_cleanup(handle) bind(c, name='curl_easy_cleanup')
70
+
import c_ptr
71
+
type(c_ptr), value :: handle
72
+
end subroutine
73
+
74
+
function curl_slist_append(list, str) bind(c, name='curl_slist_append') result(r)
75
+
import c_ptr, c_char
76
+
type(c_ptr), value :: list
77
+
character(c_char), intent(in) :: str(*)
78
+
type(c_ptr) :: r
79
+
end function
80
+
81
+
subroutine curl_slist_free_all(list) bind(c, name='curl_slist_free_all')
82
+
import c_ptr
83
+
type(c_ptr), value :: list
84
+
end subroutine
85
+
end interface
86
+
87
+
contains
88
+
89
+
! Write callback called by curl for each received chunk
90
+
function write_callback(ptr, size, nmemb, userdata) &
91
+
bind(c) result(written)
92
+
type(c_ptr), value :: ptr, userdata
93
+
integer(c_size_t), value :: size, nmemb
94
+
integer(c_size_t) :: written
95
+
integer(c_size_t) :: nbytes
96
+
character(len=1), pointer :: src(:)
97
+
integer :: i, start
98
+
! userdata intentionally unused — curl requires the argument
99
+
if (.false.) written = transfer(userdata, written)
100
+
101
+
nbytes = size * nmemb
102
+
written = nbytes
103
+
104
+
call c_f_pointer(ptr, src, [int(nbytes)])
105
+
start = http_buf_len + 1
106
+
do i = 1, int(nbytes)
107
+
if (http_buf_len >= MAX_HTTP_BUF) exit
108
+
http_buf_len = http_buf_len + 1
109
+
http_buf(http_buf_len) = src(i)
110
+
end do
111
+
end function
112
+
113
+
subroutine fetch_init()
114
+
integer(c_int) :: rc
115
+
rc = curl_global_init(CURL_GLOBAL_ALL)
116
+
curl_handle = curl_easy_init()
117
+
rc = curl_easy_setopt_long(curl_handle, CURLOPT_FOLLOWLOCATION, 1_c_long)
118
+
rc = curl_easy_setopt_long(curl_handle, CURLOPT_SSL_VERIFYPEER, 0_c_long)
119
+
rc = curl_easy_setopt_long(curl_handle, CURLOPT_TIMEOUT, 30_c_long)
120
+
rc = curl_easy_setopt_long(curl_handle, CURLOPT_CONNECTTIMEOUT, 10_c_long)
121
+
end subroutine
122
+
123
+
! Fetch a URL, return response as allocatable string
124
+
subroutine fetch_url(url, response, ok)
125
+
character(len=*), intent(in) :: url
126
+
character(len=:), allocatable, intent(out) :: response
127
+
logical, intent(out) :: ok
128
+
integer(c_int) :: rc
129
+
type(c_funptr) :: cbfun
130
+
character(len=len_trim(url)+1, kind=c_char), target :: curl_url
131
+
character(len=12, kind=c_char), target :: ua_str
132
+
integer :: i
133
+
134
+
http_buf_len = 0
135
+
ok = .false.
136
+
137
+
! Build C strings
138
+
do i = 1, len_trim(url)
139
+
curl_url(i:i) = url(i:i)
140
+
end do
141
+
curl_url(len_trim(url)+1:len_trim(url)+1) = c_null_char
142
+
143
+
ua_str = 'fortrat/1.0' // c_null_char
144
+
145
+
cbfun = c_funloc(write_callback)
146
+
rc = curl_easy_setopt_ptr(curl_handle, CURLOPT_URL, &
147
+
c_loc(curl_url))
148
+
rc = curl_easy_setopt_funptr(curl_handle, CURLOPT_WRITEFUNCTION, cbfun)
149
+
rc = curl_easy_setopt_ptr(curl_handle, CURLOPT_USERAGENT, &
150
+
c_loc(ua_str))
151
+
152
+
rc = curl_easy_perform(curl_handle)
153
+
if (rc /= 0) return
154
+
155
+
allocate(character(len=http_buf_len) :: response)
156
+
do i = 1, http_buf_len
157
+
response(i:i) = http_buf(i)
158
+
end do
159
+
ok = .true.
160
+
end subroutine
161
+
162
+
subroutine fetch_cleanup()
163
+
if (c_associated(curl_handle)) call curl_easy_cleanup(curl_handle)
164
+
end subroutine
165
+
166
+
end module fortrat_fetch
+317
src/lexparse.f90
+317
src/lexparse.f90
···
1
+
module fortrat_lexparse
2
+
use json_module, only: json_core, json_value, json_file, &
3
+
json_CK => json_CK, &
4
+
json_LK => json_LK
5
+
use fortrat_types
6
+
use fortrat_fetch
7
+
implicit none
8
+
9
+
! Convenience alias — CK is the character kind json-fortran uses
10
+
integer, parameter :: CK = json_CK
11
+
12
+
character(len=*), parameter :: TREE_URL = &
13
+
'https://api.github.com/repos/bluesky-social/atproto/git/trees/main?recursive=1'
14
+
character(len=*), parameter :: RAW_BASE = &
15
+
'https://raw.githubusercontent.com/bluesky-social/atproto/main/'
16
+
17
+
integer, parameter :: MAX_PATHS = 256
18
+
character(len=256) :: lex_paths(MAX_PATHS)
19
+
integer :: n_paths = 0
20
+
21
+
contains
22
+
23
+
function resolve_ref(base, ref) result(target)
24
+
character(len=*), intent(in) :: base, ref
25
+
character(len=ID_LEN) :: target
26
+
character(len=ID_LEN) :: r
27
+
integer :: hash_pos
28
+
29
+
target = ''
30
+
if (len_trim(ref) == 0) return
31
+
if (ref(1:1) == '#') then; target = base; return; end if
32
+
33
+
r = ref
34
+
if (len_trim(r) > 4 .and. r(1:4) == 'lex:') r = r(5:)
35
+
hash_pos = index(r, '#')
36
+
if (hash_pos > 0) r = r(1:hash_pos-1)
37
+
if (len_trim(r) == 0 .or. index(r, '.') == 0) then
38
+
target = base; return
39
+
end if
40
+
target = trim(r)
41
+
end function
42
+
43
+
function detect_nsgroup(id) result(ns)
44
+
character(len=*), intent(in) :: id
45
+
integer :: ns
46
+
if (len_trim(id) >= 9 .and. id(1:9) == 'app.bsky.') then; ns = NS_APP_BSKY
47
+
else if(len_trim(id) >= 12 .and. id(1:12) == 'com.atproto.') then; ns = NS_COM_ATPROTO
48
+
else if(len_trim(id) >= 10 .and. id(1:10) == 'chat.bsky.') then; ns = NS_CHAT_BSKY
49
+
else if(len_trim(id) >= 13 .and. id(1:13) == 'tools.ozone.') then; ns = NS_TOOLS_OZONE
50
+
else; ns = NS_COMMUNITY
51
+
end if
52
+
end function
53
+
54
+
function detect_kind(type_str) result(k)
55
+
character(len=*), intent(in) :: type_str
56
+
integer :: k
57
+
select case(trim(type_str))
58
+
case('record'); k = KIND_RECORD
59
+
case('query'); k = KIND_QUERY
60
+
case('procedure'); k = KIND_PROCEDURE
61
+
case('subscription'); k = KIND_SUBSCRIPTION
62
+
case('token'); k = KIND_TOKEN
63
+
case('object'); k = KIND_OBJECT
64
+
case default; k = KIND_UNKNOWN
65
+
end select
66
+
end function
67
+
68
+
function short_label(id) result(lbl)
69
+
character(len=*), intent(in) :: id
70
+
character(len=LABEL_LEN) :: lbl
71
+
integer :: i
72
+
lbl = ''
73
+
do i = len_trim(id), 1, -1
74
+
if (id(i:i) == '.') then
75
+
lbl = id(i+1:min(len_trim(id), i+LABEL_LEN))
76
+
return
77
+
end if
78
+
end do
79
+
lbl = id(1:min(len_trim(id), LABEL_LEN))
80
+
end function
81
+
82
+
! Get a string from json_core by path, copy to fixed-len var
83
+
subroutine jc_get_str(jc, root, path, val, found)
84
+
type(json_core), intent(inout) :: jc
85
+
type(json_value), pointer :: root
86
+
character(len=*), intent(in) :: path
87
+
character(len=*), intent(out) :: val
88
+
logical, intent(out) :: found
89
+
character(kind=CK, len=:), allocatable :: tmp
90
+
logical(json_LK) :: f
91
+
92
+
val = ''
93
+
found = .false.
94
+
call jc%get(root, path, tmp, f)
95
+
if (.not. f) return
96
+
if (.not. allocated(tmp)) return
97
+
val = tmp(1:min(len(tmp), len(val)))
98
+
found = len_trim(val) > 0
99
+
end subroutine
100
+
101
+
! Parse GitHub tree JSON — collect lexicon file paths
102
+
subroutine parse_tree(json_str, paths, n)
103
+
character(len=*), intent(in) :: json_str
104
+
character(len=256), intent(out) :: paths(:)
105
+
integer, intent(out) :: n
106
+
type(json_core) :: jc
107
+
type(json_value), pointer :: root, tree_arr, item
108
+
character(kind=CK, len=:), allocatable :: path_val_ck
109
+
character(len=256) :: path_val
110
+
integer :: n_tree, i
111
+
logical(json_LK) :: f
112
+
113
+
n = 0
114
+
call jc%parse(root, json_str)
115
+
if (jc%failed()) then
116
+
call jc%clear_exceptions(); return
117
+
end if
118
+
119
+
call jc%get(root, 'tree', tree_arr, f)
120
+
if (.not. f .or. .not. associated(tree_arr)) then
121
+
call jc%destroy(root); return
122
+
end if
123
+
124
+
n_tree = jc%count(tree_arr)
125
+
do i = 1, n_tree
126
+
call jc%get_child(tree_arr, i, item)
127
+
if (.not. associated(item)) cycle
128
+
call jc%get(item, 'path', path_val_ck, f)
129
+
if (.not. f .or. .not. allocated(path_val_ck)) cycle
130
+
path_val = path_val_ck
131
+
132
+
if (index(path_val, 'lexicons/') == 0) cycle
133
+
if (len_trim(path_val) < 5) cycle
134
+
if (path_val(len_trim(path_val)-4:len_trim(path_val)) /= '.json') cycle
135
+
136
+
n = n + 1
137
+
if (n > size(paths)) then; n = n - 1; exit; end if
138
+
paths(n) = trim(path_val)
139
+
end do
140
+
141
+
call jc%destroy(root)
142
+
end subroutine
143
+
144
+
! Parse one lexicon JSON file, add node + edges to graph
145
+
subroutine parse_lexicon(json_str, graph, community)
146
+
character(len=*), intent(in) :: json_str
147
+
type(lex_graph_t), intent(inout) :: graph
148
+
logical, intent(in) :: community
149
+
type(json_core) :: jc
150
+
type(json_value), pointer :: root, defs_node
151
+
character(len=ID_LEN) :: lex_id, type_str, desc_str
152
+
logical :: found
153
+
integer :: node_idx, i
154
+
logical(json_LK) :: f
155
+
156
+
call jc%parse(root, json_str)
157
+
if (jc%failed()) then
158
+
call jc%clear_exceptions(); return
159
+
end if
160
+
161
+
call jc_get_str(jc, root, 'id', lex_id, found)
162
+
if (.not. found) then
163
+
call jc%destroy(root); return
164
+
end if
165
+
166
+
! Skip duplicates
167
+
do i = 1, graph%n_nodes
168
+
if (trim(graph%nodes(i)%id) == trim(lex_id)) then
169
+
call jc%destroy(root); return
170
+
end if
171
+
end do
172
+
if (graph%n_nodes >= MAX_NODES) then
173
+
call jc%destroy(root); return
174
+
end if
175
+
176
+
graph%n_nodes = graph%n_nodes + 1
177
+
node_idx = graph%n_nodes
178
+
graph%nodes(node_idx)%id = trim(lex_id)
179
+
graph%nodes(node_idx)%label = short_label(lex_id)
180
+
graph%nodes(node_idx)%ns_group = merge(NS_COMMUNITY, detect_nsgroup(lex_id), community)
181
+
graph%nodes(node_idx)%active = .true.
182
+
graph%nodes(node_idx)%kind = KIND_UNKNOWN
183
+
184
+
! defs.main.type
185
+
call jc_get_str(jc, root, 'defs.main.type', type_str, found)
186
+
if (found) graph%nodes(node_idx)%kind = detect_kind(type_str)
187
+
188
+
! defs.main.description
189
+
call jc_get_str(jc, root, 'defs.main.description', desc_str, found)
190
+
if (found) graph%nodes(node_idx)%doc = trim(desc_str)
191
+
192
+
! Walk defs for ref edges
193
+
call jc%get(root, 'defs', defs_node, f)
194
+
if (f .and. associated(defs_node)) then
195
+
call collect_refs(jc, defs_node, lex_id, graph)
196
+
end if
197
+
198
+
call jc%destroy(root)
199
+
end subroutine
200
+
201
+
! Recursively walk json_value tree collecting ref edges
202
+
recursive subroutine collect_refs(jc, node, lex_id, graph)
203
+
type(json_core), intent(inout) :: jc
204
+
type(json_value), pointer, intent(in) :: node
205
+
character(len=*), intent(in) :: lex_id
206
+
type(lex_graph_t), intent(inout) :: graph
207
+
type(json_value), pointer :: child
208
+
character(kind=CK, len=:), allocatable :: sval
209
+
character(len=ID_LEN) :: type_str, ref_str, target
210
+
integer :: i, n
211
+
logical(json_LK) :: f
212
+
213
+
if (.not. associated(node)) return
214
+
215
+
! Check type field at this node
216
+
call jc%get(node, 'type', sval, f)
217
+
if (f .and. allocated(sval)) then
218
+
type_str = sval
219
+
if (trim(type_str) == 'ref') then
220
+
call jc%get(node, 'ref', sval, f)
221
+
if (f .and. allocated(sval)) then
222
+
ref_str = sval
223
+
target = resolve_ref(lex_id, ref_str)
224
+
if (len_trim(target) > 0 .and. trim(target) /= trim(lex_id)) then
225
+
call add_edge(graph, lex_id, target, .false.)
226
+
end if
227
+
end if
228
+
end if
229
+
end if
230
+
231
+
! Recurse into children
232
+
n = jc%count(node)
233
+
do i = 1, n
234
+
call jc%get_child(node, i, child)
235
+
if (associated(child)) call collect_refs(jc, child, lex_id, graph)
236
+
end do
237
+
end subroutine
238
+
239
+
subroutine add_edge(graph, src_id, tgt_id, is_union)
240
+
type(lex_graph_t), intent(inout) :: graph
241
+
character(len=*), intent(in) :: src_id, tgt_id
242
+
logical, intent(in) :: is_union
243
+
integer :: i, src_idx, tgt_idx
244
+
245
+
if (graph%n_edges >= MAX_EDGES) return
246
+
src_idx = 0; tgt_idx = 0
247
+
do i = 1, graph%n_nodes
248
+
if (trim(graph%nodes(i)%id) == trim(src_id)) src_idx = i
249
+
if (trim(graph%nodes(i)%id) == trim(tgt_id)) tgt_idx = i
250
+
end do
251
+
if (src_idx == 0 .or. tgt_idx == 0) return
252
+
do i = 1, graph%n_edges
253
+
if (graph%edges(i)%src == src_idx .and. &
254
+
graph%edges(i)%tgt == tgt_idx) return
255
+
end do
256
+
graph%n_edges = graph%n_edges + 1
257
+
graph%edges(graph%n_edges)%src = src_idx
258
+
graph%edges(graph%n_edges)%tgt = tgt_idx
259
+
graph%edges(graph%n_edges)%is_union = is_union
260
+
end subroutine
261
+
262
+
subroutine build_graph(graph, include_community, progress_cb)
263
+
type(lex_graph_t), intent(inout) :: graph
264
+
logical, intent(in) :: include_community
265
+
interface
266
+
subroutine progress_cb(msg)
267
+
character(len=*), intent(in) :: msg
268
+
end subroutine
269
+
end interface
270
+
character(len=:), allocatable :: response
271
+
logical :: ok
272
+
integer :: i
273
+
character(len=512) :: msg
274
+
275
+
call fetch_init()
276
+
call progress_cb('Fetching atproto lexicon tree...')
277
+
call fetch_url(TREE_URL, response, ok)
278
+
if (.not. ok) then
279
+
call progress_cb('ERROR: Could not reach GitHub API'); return
280
+
end if
281
+
282
+
call parse_tree(response, lex_paths, n_paths)
283
+
deallocate(response)
284
+
write(msg, '(a,i0,a)') 'Found ', n_paths, ' lexicon files'
285
+
call progress_cb(trim(msg))
286
+
287
+
graph%n_nodes = 0
288
+
graph%n_edges = 0
289
+
290
+
do i = 1, n_paths
291
+
call fetch_url(RAW_BASE//trim(lex_paths(i)), response, ok)
292
+
if (ok) then
293
+
call parse_lexicon(response, graph, include_community)
294
+
deallocate(response)
295
+
end if
296
+
if (mod(i, 20) == 0) then
297
+
write(msg, '(a,i0,a,i0)') 'Loading: ', i, '/', n_paths
298
+
call progress_cb(trim(msg))
299
+
end if
300
+
end do
301
+
302
+
write(msg, '(a,i0,a,i0,a)') &
303
+
'Ready: ', graph%n_nodes, ' nodes, ', graph%n_edges, ' edges'
304
+
call progress_cb(trim(msg))
305
+
call fetch_cleanup()
306
+
end subroutine
307
+
308
+
subroutine apply_filters(graph, groups)
309
+
type(lex_graph_t), intent(inout) :: graph
310
+
logical, intent(in) :: groups(5)
311
+
integer :: i
312
+
do i = 1, graph%n_nodes
313
+
graph%nodes(i)%active = groups(graph%nodes(i)%ns_group)
314
+
end do
315
+
end subroutine
316
+
317
+
end module fortrat_lexparse
+204
src/main.f90
+204
src/main.f90
···
1
+
program fortrat
2
+
use iso_fortran_env, only: real64, output_unit
3
+
use fortrat_types
4
+
use fortrat_tui
5
+
use fortrat_simulate
6
+
use fortrat_render
7
+
use fortrat_lexparse
8
+
implicit none
9
+
10
+
type(lex_graph_t) :: graph
11
+
type(app_state_t) :: state
12
+
integer :: key, cols, rows
13
+
14
+
! ── Init state ──
15
+
state%groups = .true. ! all ns groups visible
16
+
state%groups(NS_COMMUNITY) = .false.
17
+
state%mode = MODE_LOADING
18
+
state%status_msg = 'READY'
19
+
20
+
! ── Get terminal size ──
21
+
call tui_get_term_size(cols, rows)
22
+
state%term_w = max(cols, 80)
23
+
state%term_h = max(rows, 24)
24
+
state%inspect_w = 42
25
+
state%graph_w = state%term_w - state%inspect_w - 1
26
+
state%graph_h = state%term_h - 3
27
+
28
+
! ── Fetch and build graph (plain text output, no raw mode yet) ──
29
+
call build_graph(graph, state%community, show_progress)
30
+
31
+
! ── Init simulation ──
32
+
write(*, '(a)') 'Settling simulation...'
33
+
flush(output_unit)
34
+
call apply_filters(graph, state%groups)
35
+
call sim_init(graph, state%graph_w, state%graph_h)
36
+
call sim_prewarm(graph, state%graph_w, state%graph_h, 40)
37
+
write(*, '(a)') 'Done. Starting TUI...'
38
+
flush(output_unit)
39
+
40
+
! ── Now enter raw mode and take over the screen ──
41
+
call tui_enter_raw_mode()
42
+
call render_reset_frame()
43
+
44
+
state%mode = MODE_GRAPH
45
+
state%status_msg = 'READY'
46
+
47
+
! ── Main event loop ──
48
+
do while (.true.)
49
+
50
+
! ── Simulation tick ──
51
+
call sim_tick(graph, state%graph_w, state%graph_h)
52
+
53
+
! ── Read input (non-blocking) ──
54
+
key = tui_read_key()
55
+
if (key /= 0) call handle_key(key, graph, state)
56
+
57
+
! ── Render ──
58
+
call render_clear(state%term_w, state%term_h)
59
+
call render_ruler(state%term_w, state%term_h)
60
+
call render_header(state%term_w, state%term_h, state%graph_w + 1)
61
+
call render_graph_pane(graph, state, state%graph_w, state%term_h, 2)
62
+
call render_inspect_pane(graph, state, state%graph_w + 2, state%term_w, state%term_h)
63
+
call render_status(state, graph, state%term_w, state%term_h)
64
+
call render_flush(state%term_w, state%term_h)
65
+
66
+
! ── Frame sleep 200ms ──
67
+
call usleep_f(200000)
68
+
end do
69
+
70
+
contains
71
+
72
+
subroutine show_progress(msg)
73
+
character(len=*), intent(in) :: msg
74
+
state%progress = trim(msg)
75
+
write(*, '(a)') trim(msg)
76
+
flush(output_unit)
77
+
end subroutine
78
+
79
+
subroutine handle_key(key, graph, state)
80
+
integer, intent(in) :: key
81
+
type(lex_graph_t), intent(inout) :: graph
82
+
type(app_state_t), intent(inout) :: state
83
+
integer :: vis_count, vis_idx, i
84
+
character(len=1) :: ch
85
+
86
+
! Count visible nodes
87
+
vis_count = 0
88
+
do i = 1, graph%n_nodes
89
+
if (graph%nodes(i)%active) vis_count = vis_count + 1
90
+
end do
91
+
92
+
ch = achar(key)
93
+
94
+
! Quit
95
+
if (ch == 'q' .or. ch == 'Q') then
96
+
call tui_exit_raw_mode()
97
+
stop
98
+
end if
99
+
100
+
! Search mode: accumulate query
101
+
if (state%mode == MODE_SEARCH) then
102
+
if (key == 13) then ! Enter
103
+
state%mode = MODE_GRAPH
104
+
state%status_msg = 'QUERY: '//trim(state%search_query)
105
+
else if (key == 27) then ! ESC
106
+
state%search_query = ''
107
+
state%mode = MODE_GRAPH
108
+
state%status_msg = 'READY'
109
+
else if (key == 127 .or. key == 8) then ! Backspace
110
+
i = len_trim(state%search_query)
111
+
if (i > 0) state%search_query(i:i) = ' '
112
+
else if (key >= 32 .and. key < 127) then
113
+
i = len_trim(state%search_query) + 1
114
+
if (i <= len(state%search_query)) then
115
+
state%search_query(i:i) = ch
116
+
end if
117
+
end if
118
+
return
119
+
end if
120
+
121
+
! Navigation
122
+
if (ch == 'j' .or. key == -2) then ! down
123
+
state%cursor_idx = min(state%cursor_idx + 1, max(vis_count, 1))
124
+
state%status_msg = 'NAV'
125
+
else if (ch == 'k' .or. key == -1) then ! up
126
+
state%cursor_idx = max(state%cursor_idx - 1, 1)
127
+
state%status_msg = 'NAV'
128
+
else if (ch == 'l' .or. key == -4) then ! right/next
129
+
state%cursor_idx = min(state%cursor_idx + 5, max(vis_count, 1))
130
+
else if (ch == 'h' .or. key == -3) then ! left/prev
131
+
state%cursor_idx = max(state%cursor_idx - 5, 1)
132
+
133
+
! Select
134
+
else if (key == 13) then ! Enter
135
+
if (state%cursor_idx > 0) then
136
+
vis_idx = 0
137
+
do i = 1, graph%n_nodes
138
+
if (.not. graph%nodes(i)%active) cycle
139
+
vis_idx = vis_idx + 1
140
+
if (vis_idx == state%cursor_idx) then
141
+
state%selected_idx = i
142
+
state%mode = MODE_INSPECT
143
+
state%status_msg = 'INSPECT: '//trim(graph%nodes(i)%id)
144
+
exit
145
+
end if
146
+
end do
147
+
end if
148
+
149
+
! Escape — deselect
150
+
else if (key == 27) then
151
+
state%selected_idx = 0
152
+
state%mode = MODE_GRAPH
153
+
state%status_msg = 'READY'
154
+
155
+
! Search
156
+
else if (ch == '/') then
157
+
state%search_query = ''
158
+
state%mode = MODE_SEARCH
159
+
state%status_msg = 'SEARCH — type, ENTER confirm, ESC cancel'
160
+
161
+
! Tab — cycle one ns group on/off
162
+
else if (key == 9) then
163
+
block
164
+
integer :: g
165
+
do g = 1, 5
166
+
if (.not. state%groups(g)) then
167
+
state%groups(g) = .true.
168
+
write(state%status_msg, '(a,i0,a)') 'NS GROUP ', g, ' ON'
169
+
go to 99
170
+
end if
171
+
end do
172
+
state%groups(5) = .false.
173
+
state%status_msg = 'COMMUNITY OFF'
174
+
99 continue
175
+
end block
176
+
call apply_filters(graph, state%groups)
177
+
call sim_init(graph, state%graph_w, state%graph_h)
178
+
call sim_prewarm(graph, state%graph_w, state%graph_h, 40)
179
+
180
+
! c — toggle community
181
+
else if (ch == 'c' .or. ch == 'C') then
182
+
state%community = .not. state%community
183
+
state%groups(NS_COMMUNITY) = state%community
184
+
call apply_filters(graph, state%groups)
185
+
write(state%status_msg, '(a)') merge('COMMUNITY ON ', 'COMMUNITY OFF', state%community)
186
+
187
+
end if
188
+
end subroutine
189
+
190
+
end program fortrat
191
+
192
+
! usleep wrapper via ISO C binding
193
+
subroutine usleep_f(microseconds)
194
+
use iso_c_binding
195
+
implicit none
196
+
integer, intent(in) :: microseconds
197
+
interface
198
+
subroutine c_usleep(us) bind(c, name='usleep')
199
+
import c_int
200
+
integer(c_int), value :: us
201
+
end subroutine
202
+
end interface
203
+
call c_usleep(int(microseconds, c_int))
204
+
end subroutine
+429
src/render.f90
+429
src/render.f90
···
1
+
module 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
+
19
+
contains
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, sigil, color, selected, w, h)
87
+
integer, intent(in) :: cx, cy, w, h
88
+
character(len=3), intent(in) :: sigil
89
+
character(len=*), intent(in) :: color
90
+
logical, intent(in) :: selected
91
+
character(len=5) :: label
92
+
integer :: i
93
+
94
+
if (selected) then
95
+
label = '['//sigil//']'
96
+
else
97
+
label = ' '//sigil//' '
98
+
end if
99
+
100
+
do i = 1, 5
101
+
call render_set(cx - 2 + i, cy, label(i:i), color, selected, w, h)
102
+
end do
103
+
end subroutine
104
+
105
+
! Draw text string at position (truncated to fit)
106
+
subroutine render_text(c, r, text, color, bold, w, h)
107
+
integer, intent(in) :: c, r, w, h
108
+
character(len=*), intent(in) :: text, color
109
+
logical, intent(in) :: bold
110
+
integer :: i, len_t
111
+
len_t = min(len_trim(text), w - c + 1)
112
+
do i = 1, len_t
113
+
call render_set(c + i - 1, r, text(i:i), color, bold, w, h)
114
+
end do
115
+
end subroutine
116
+
117
+
! Flush frame to terminal — clear screen then write only non-space cells
118
+
subroutine render_flush(w, h)
119
+
use fortrat_tui, only: fortrat_write_at, fortrat_flush, fortrat_clear_screen
120
+
use iso_c_binding
121
+
integer, intent(in) :: w, h
122
+
integer :: c, r, clen
123
+
character(len=512) :: cell_str
124
+
integer(c_int) :: ci, ri
125
+
126
+
! Clear screen once per frame
127
+
call fortrat_clear_screen()
128
+
129
+
! Write only non-space cells individually — each as ESC[row;colH + color + char
130
+
do r = 1, h
131
+
do c = 1, w
132
+
if (cur_frame(c,r)%ch == ' ' .and. len_trim(cur_frame(c,r)%color) == 0) cycle
133
+
134
+
! Build: color + bold + char
135
+
clen = 0
136
+
if (len_trim(cur_frame(c,r)%color) > 0) then
137
+
block
138
+
integer :: cl
139
+
cl = len_trim(cur_frame(c,r)%color)
140
+
cell_str(1:cl) = cur_frame(c,r)%color(1:cl)
141
+
clen = cl
142
+
end block
143
+
end if
144
+
if (cur_frame(c,r)%bold) then
145
+
cell_str(clen+1:clen+4) = char(27)//'[1m'
146
+
clen = clen + 4
147
+
end if
148
+
cell_str(clen+1:clen+1) = cur_frame(c,r)%ch
149
+
clen = clen + 1
150
+
! Append reset
151
+
cell_str(clen+1:clen+4) = char(27)//'[0m'
152
+
clen = clen + 4
153
+
154
+
ri = int(r, c_int)
155
+
ci = int(c, c_int)
156
+
call fortrat_write_at(ri, ci, cell_str, int(clen, c_int))
157
+
prv_frame(c,r) = cur_frame(c,r)
158
+
end do
159
+
end do
160
+
161
+
call fortrat_flush()
162
+
first_frame = .false.
163
+
end subroutine
164
+
165
+
! ── Main graph pane render ──
166
+
subroutine render_graph_pane(graph, state, w, h, row_off)
167
+
type(lex_graph_t), intent(in) :: graph
168
+
type(app_state_t), intent(in) :: state
169
+
integer, intent(in) :: w, h, row_off
170
+
integer :: i, cx, cy, vis_idx
171
+
character(len=3) :: sigil
172
+
character(len=16) :: col
173
+
logical :: selected, dimmed
174
+
integer :: visible_nodes(MAX_NODES), n_vis
175
+
176
+
! Build visible node index list
177
+
n_vis = 0
178
+
do i = 1, graph%n_nodes
179
+
if (graph%nodes(i)%active) then
180
+
n_vis = n_vis + 1
181
+
visible_nodes(n_vis) = i
182
+
end if
183
+
end do
184
+
185
+
! Draw edges first
186
+
do i = 1, graph%n_edges
187
+
if (graph%edges(i)%src == 0) cycle
188
+
if (.not. graph%nodes(graph%edges(i)%src)%active) cycle
189
+
if (.not. graph%nodes(graph%edges(i)%tgt)%active) cycle
190
+
cx = nint(graph%nodes(graph%edges(i)%src)%x)
191
+
cy = nint(graph%nodes(graph%edges(i)%src)%y) + row_off
192
+
call render_edge( &
193
+
cx, cy, &
194
+
nint(graph%nodes(graph%edges(i)%tgt)%x), &
195
+
nint(graph%nodes(graph%edges(i)%tgt)%y) + row_off, &
196
+
GREEN_DIM, w, h)
197
+
end do
198
+
199
+
! Draw nodes
200
+
vis_idx = 0
201
+
do i = 1, graph%n_nodes
202
+
if (.not. graph%nodes(i)%active) cycle
203
+
vis_idx = vis_idx + 1
204
+
cx = nint(graph%nodes(i)%x)
205
+
cy = nint(graph%nodes(i)%y) + row_off
206
+
sigil = KIND_SIGIL(graph%nodes(i)%kind)(1:3)
207
+
col = ns_color(graph%nodes(i)%ns_group)
208
+
selected = (vis_idx == state%cursor_idx .or. i == state%selected_idx)
209
+
dimmed = len_trim(state%search_query) > 0 .and. &
210
+
index(graph%nodes(i)%id, trim(state%search_query)) == 0
211
+
if (dimmed) col = GREEN_DIM
212
+
call render_node(cx, cy, sigil, col, selected, w, h)
213
+
end do
214
+
end subroutine
215
+
216
+
! ── Inspect pane ──
217
+
subroutine render_inspect_pane(graph, state, col_off, w, h)
218
+
type(lex_graph_t), intent(in) :: graph
219
+
type(app_state_t), intent(in) :: state
220
+
integer, intent(in) :: col_off, w, h
221
+
integer :: row, i, idx, vis_idx, n_out
222
+
character(len=ID_LEN) :: out_ids(64)
223
+
character(len=3) :: sigil
224
+
character(len=w) :: divider
225
+
226
+
row = 2 ! start below pane header
227
+
228
+
! Find actual node index from cursor
229
+
idx = 0
230
+
vis_idx = 0
231
+
do i = 1, graph%n_nodes
232
+
if (.not. graph%nodes(i)%active) cycle
233
+
vis_idx = vis_idx + 1
234
+
if (vis_idx == state%cursor_idx) then; idx = i; exit; end if
235
+
end do
236
+
237
+
if (state%selected_idx > 0) idx = state%selected_idx
238
+
239
+
if (idx == 0) then
240
+
call render_text(col_off, row, 'C NO NODE SELECTED', GREEN_DIM, .false., w, h)
241
+
call render_text(col_off, row+2, ' HJKL : navigate', GREEN_DIM, .false., w, h)
242
+
call render_text(col_off, row+3, ' ENTER : inspect', GREEN_DIM, .false., w, h)
243
+
call render_text(col_off, row+4, ' / : search', GREEN_DIM, .false., w, h)
244
+
call render_text(col_off, row+5, ' TAB : toggle ns',GREEN_DIM, .false., w, h)
245
+
call render_text(col_off, row+6, ' C : community',GREEN_DIM, .false., w, h)
246
+
call render_text(col_off, row+7, ' Q : quit', GREEN_DIM, .false., w, h)
247
+
return
248
+
end if
249
+
250
+
sigil = KIND_SIGIL(graph%nodes(idx)%kind)(1:3)
251
+
call render_text(col_off, row, 'SUBROUTINE INSPECT('//sigil//')', GREEN_BR, .true., w, h)
252
+
row = row + 1
253
+
254
+
divider = repeat('-', w - col_off)
255
+
call render_text(col_off, row, divider, GREEN_DIM, .false., w, h)
256
+
row = row + 1
257
+
258
+
call render_text(col_off, row, trim(graph%nodes(idx)%id), GREEN_BR, .true., w, h)
259
+
row = row + 2
260
+
261
+
call render_text(col_off, row, 'COMMON /LEXDATA/', GREEN_DIM, .false., w, h)
262
+
row = row + 1
263
+
call render_text(col_off, row, ' KIND '//sigil, GREEN, .false., w, h)
264
+
row = row + 1
265
+
call render_text(col_off, row, ' NS_GROUP '//ns_name(graph%nodes(idx)%ns_group), GREEN, .false., w, h)
266
+
row = row + 1
267
+
if (graph%nodes(idx)%ns_group == NS_COMMUNITY) then
268
+
call render_text(col_off, row, ' ORIGIN EXTERNAL', YELLOW, .false., w, h)
269
+
row = row + 1
270
+
end if
271
+
row = row + 1
272
+
273
+
! Description
274
+
if (len_trim(graph%nodes(idx)%doc) > 0) then
275
+
block
276
+
integer :: doc_len, max_len
277
+
doc_len = len_trim(graph%nodes(idx)%doc)
278
+
max_len = min(doc_len, w - col_off - 6)
279
+
call render_text(col_off, row, &
280
+
'C '//graph%nodes(idx)%doc(1:max_len), &
281
+
GREEN_DIM, .false., w, h)
282
+
end block
283
+
row = row + 2
284
+
end if
285
+
286
+
! Fields
287
+
if (graph%nodes(idx)%n_fields > 0) then
288
+
call render_text(col_off, row, 'C FIELDS', GREEN_DIM, .false., w, h)
289
+
row = row + 1
290
+
do i = 1, min(graph%nodes(idx)%n_fields, 8)
291
+
if (graph%nodes(idx)%fields(i)%required) then
292
+
call render_text(col_off, row, ' '//trim(graph%nodes(idx)%fields(i)%name), GREEN_BR, .false., w, h)
293
+
else
294
+
call render_text(col_off, row, 'C '//trim(graph%nodes(idx)%fields(i)%name), GREEN, .false., w, h)
295
+
end if
296
+
row = row + 1
297
+
if (row >= h - 2) exit
298
+
end do
299
+
row = row + 1
300
+
end if
301
+
302
+
! Outbound refs
303
+
if (row < h - 4) then
304
+
n_out = 0
305
+
do i = 1, graph%n_edges
306
+
if (graph%edges(i)%src == idx) then
307
+
n_out = n_out + 1
308
+
if (n_out <= 4) out_ids(n_out) = graph%nodes(graph%edges(i)%tgt)%id
309
+
end if
310
+
end do
311
+
if (n_out > 0) then
312
+
call render_text(col_off, row, 'C CALL/REF', GREEN_DIM, .false., w, h)
313
+
row = row + 1
314
+
do i = 1, min(n_out, 4)
315
+
call render_text(col_off, row, ' CALL '//trim(out_ids(i)), GREEN, .false., w, h)
316
+
row = row + 1
317
+
if (row >= h - 2) exit
318
+
end do
319
+
end if
320
+
end if
321
+
322
+
! Footer
323
+
call render_text(col_off, h-1, 'END SUBROUTINE INSPECT', GREEN_DIM, .false., w, h)
324
+
end subroutine
325
+
326
+
! ── Column ruler ──
327
+
subroutine render_ruler(w, h)
328
+
integer, intent(in) :: w, h
329
+
character(len=80) :: ruler
330
+
ruler = 'C23456789012345678901234567890123456789012345678901234567890123456789072'
331
+
call render_text(1, 1, ruler(1:min(w,72)), GREEN_DIM, .false., w, h)
332
+
end subroutine
333
+
334
+
! ── Pane header bar ──
335
+
subroutine render_header(w, h, divider_col)
336
+
integer, intent(in) :: w, h, divider_col
337
+
integer :: i
338
+
character(len=w) :: line
339
+
character(len=32) :: left_hdr, right_hdr
340
+
341
+
line = repeat('-', w)
342
+
left_hdr = '-[FORTRAT:GRAPH]'
343
+
right_hdr = '-[INSPECT]'
344
+
line(1:len_trim(left_hdr)) = left_hdr
345
+
line(divider_col:divider_col) = '+'
346
+
line(divider_col+1:divider_col+len_trim(right_hdr)) = right_hdr(1:len_trim(right_hdr))
347
+
348
+
call render_text(1, 2, line, GREEN_DIM, .false., w, h)
349
+
350
+
! Vertical divider
351
+
do i = 3, h - 1
352
+
call render_set(divider_col, i, '|', GREEN_DIM, .false., w, h)
353
+
end do
354
+
end subroutine
355
+
356
+
! ── Status bar ──
357
+
subroutine render_status(state, graph, w, h)
358
+
type(app_state_t), intent(in) :: state
359
+
type(lex_graph_t), intent(in) :: graph
360
+
integer, intent(in) :: w, h
361
+
character(len=w) :: bar
362
+
character(len=32) :: left_part, right_part, mode_str
363
+
character(len=16) :: n_str, e_str
364
+
integer :: n_vis, n_edg, i
365
+
366
+
select case(state%mode)
367
+
case(MODE_GRAPH); mode_str = '[GRAPH]'
368
+
case(MODE_SEARCH); mode_str = '[SEARCH]'
369
+
case(MODE_INSPECT); mode_str = '[INSPECT]'
370
+
case(MODE_LOADING); mode_str = '[LOADING]'
371
+
case default; mode_str = '[?]'
372
+
end select
373
+
374
+
n_vis = 0
375
+
do i = 1, graph%n_nodes
376
+
if (graph%nodes(i)%active) n_vis = n_vis + 1
377
+
end do
378
+
n_edg = graph%n_edges
379
+
380
+
write(n_str, '(i0)') n_vis
381
+
write(e_str, '(i0)') n_edg
382
+
383
+
left_part = ' FORTRAT '//trim(mode_str)//' '//trim(state%status_msg)
384
+
right_part = ' N='//trim(n_str)//' E='//trim(e_str)//' '
385
+
386
+
bar = repeat(' ', w)
387
+
bar(1:min(len_trim(left_part),w)) = left_part(1:min(len_trim(left_part),w))
388
+
bar(w-len_trim(right_part)+1:w) = right_part
389
+
390
+
call render_text(1, h, bar, GREEN, .true., w, h)
391
+
end subroutine
392
+
393
+
! ── Loading screen ──
394
+
subroutine render_loading(state, w, h)
395
+
type(app_state_t), intent(in) :: state
396
+
integer, intent(in) :: w, h
397
+
integer :: r
398
+
399
+
r = 2
400
+
call render_text(1, r, 'C23456789012345678901234567890123456789012345678901234567890123456789072', GREEN_DIM, .false., w, h)
401
+
r = r + 2
402
+
call render_text(7, r, 'FORTRAT V1.0 (FORMERLAB 2026)', GREEN_BR, .true., w, h)
403
+
r = r + 1
404
+
call render_text(7, r, 'COPYRIGHT (C) FORMERLAB. ALL RIGHTS RESERVED.', GREEN_DIM, .false., w, h)
405
+
r = r + 2
406
+
call render_text(7, r, 'IMPLICIT NONE', GREEN, .false., w, h); r=r+1
407
+
call render_text(7, r, 'CHARACTER*(256) QUERY', GREEN, .false., w, h); r=r+1
408
+
call render_text(7, r, 'INTEGER N_NODES, N_EDGES', GREEN, .false., w, h); r=r+1
409
+
call render_text(7, r, 'LOGICAL COMMUNITY_FLAG', GREEN, .false., w, h); r=r+1
410
+
call render_text(7, r, 'DATA COMMUNITY_FLAG /.FALSE./', GREEN, .false., w, h); r=r+2
411
+
call render_text(7, r, 'CALL FETCH_LEXICONS(ATPROTO_REPO, GRAPH)', GREEN, .false., w, h); r=r+2
412
+
call render_text(7, r, 'C STATUS:', GREEN_DIM, .false., w, h); r=r+1
413
+
call render_text(7, r, '>> '//trim(state%progress), GREEN_BR, .false., w, h)
414
+
end subroutine
415
+
416
+
! Helper
417
+
function ns_name(ns) result(s)
418
+
integer, intent(in) :: ns
419
+
character(len=20) :: s
420
+
select case(ns)
421
+
case(NS_APP_BSKY); s = 'app.bsky'
422
+
case(NS_COM_ATPROTO); s = 'com.atproto'
423
+
case(NS_CHAT_BSKY); s = 'chat.bsky'
424
+
case(NS_TOOLS_OZONE); s = 'tools.ozone'
425
+
case default; s = 'community'
426
+
end select
427
+
end function
428
+
429
+
end module fortrat_render
+152
src/simulate.f90
+152
src/simulate.f90
···
1
+
module fortrat_simulate
2
+
use iso_fortran_env, only: real64
3
+
use fortrat_types
4
+
implicit none
5
+
6
+
real(real64), parameter :: REPULSION = -20.0d0 ! many-body strength
7
+
real(real64), parameter :: LINK_DIST = 6.0d0 ! target edge length (chars)
8
+
real(real64), parameter :: LINK_STR = 0.35d0
9
+
real(real64), parameter :: CLUSTER_STR = 0.06d0 ! x-axis namespace clustering
10
+
real(real64), parameter :: CENTER_STR = 0.02d0
11
+
real(real64), parameter :: COLLIDE_R = 4.0d0 ! collision radius (chars)
12
+
real(real64), parameter :: ALPHA_DECAY = 0.02d0
13
+
real(real64), parameter :: VELOCITY_DEC = 0.6d0 ! velocity decay per tick
14
+
15
+
real(real64), save :: alpha = 1.0d0
16
+
17
+
contains
18
+
19
+
! Assign initial positions scattered by ns_group
20
+
subroutine sim_init(graph, w, h)
21
+
type(lex_graph_t), intent(inout) :: graph
22
+
integer, intent(in) :: w, h
23
+
integer :: i, ns
24
+
real(real64) :: cx, seed
25
+
26
+
alpha = 1.0d0
27
+
28
+
do i = 1, graph%n_nodes
29
+
ns = graph%nodes(i)%ns_group
30
+
! Cluster x-center for each ns group
31
+
cx = (dble(ns) / 6.0d0) * dble(w)
32
+
! Pseudo-random scatter using node index
33
+
seed = dble(mod(int(i,int64) * 2654435769_int64, 100000_int64)) / 100000.0d0
34
+
graph%nodes(i)%x = cx + (seed - 0.5d0) * dble(w) * 0.15d0
35
+
graph%nodes(i)%y = dble(h) * 0.5d0 + (seed - 0.3d0) * dble(h) * 0.4d0
36
+
graph%nodes(i)%vx = 0.0d0
37
+
graph%nodes(i)%vy = 0.0d0
38
+
end do
39
+
end subroutine
40
+
41
+
subroutine sim_tick(graph, w, h)
42
+
type(lex_graph_t), intent(inout) :: graph
43
+
integer, intent(in) :: w, h
44
+
real(real64) :: ax(MAX_NODES), ay(MAX_NODES)
45
+
real(real64) :: dx, dy, dist, force, cx
46
+
integer :: i, j, src, tgt, ns
47
+
real(real64) :: alpha_k
48
+
49
+
alpha_k = alpha
50
+
51
+
ax = 0.0d0
52
+
ay = 0.0d0
53
+
54
+
! ── Many-body repulsion (O(n²) — fine for ~200 nodes) ──
55
+
do i = 1, graph%n_nodes
56
+
if (.not. graph%nodes(i)%active) cycle
57
+
do j = i+1, graph%n_nodes
58
+
if (.not. graph%nodes(j)%active) cycle
59
+
dx = graph%nodes(j)%x - graph%nodes(i)%x
60
+
dy = graph%nodes(j)%y - graph%nodes(i)%y
61
+
dist = sqrt(dx*dx + dy*dy) + 0.01d0
62
+
force = REPULSION * alpha_k / (dist * dist)
63
+
ax(i) = ax(i) - force * dx / dist
64
+
ay(i) = ay(i) - force * dy / dist
65
+
ax(j) = ax(j) + force * dx / dist
66
+
ay(j) = ay(j) + force * dy / dist
67
+
end do
68
+
end do
69
+
70
+
! ── Link forces ──
71
+
do i = 1, graph%n_edges
72
+
src = graph%edges(i)%src
73
+
tgt = graph%edges(i)%tgt
74
+
if (src == 0 .or. tgt == 0) cycle
75
+
if (.not. graph%nodes(src)%active) cycle
76
+
if (.not. graph%nodes(tgt)%active) cycle
77
+
dx = graph%nodes(tgt)%x - graph%nodes(src)%x
78
+
dy = graph%nodes(tgt)%y - graph%nodes(src)%y
79
+
dist = sqrt(dx*dx + dy*dy) + 0.01d0
80
+
force = (dist - LINK_DIST) / dist * LINK_STR * alpha_k
81
+
ax(src) = ax(src) + force * dx
82
+
ay(src) = ay(src) + force * dy
83
+
ax(tgt) = ax(tgt) - force * dx
84
+
ay(tgt) = ay(tgt) - force * dy
85
+
end do
86
+
87
+
! ── Namespace cluster + center forces ──
88
+
do i = 1, graph%n_nodes
89
+
if (.not. graph%nodes(i)%active) cycle
90
+
ns = graph%nodes(i)%ns_group
91
+
cx = (dble(ns) / 6.0d0) * dble(w)
92
+
ax(i) = ax(i) + (cx - graph%nodes(i)%x) * CLUSTER_STR * alpha_k
93
+
ay(i) = ay(i) + (dble(h)*0.5d0 - graph%nodes(i)%y) * CENTER_STR * alpha_k
94
+
end do
95
+
96
+
! ── Collision avoidance (skip when alpha is low — saves O(n²)) ──
97
+
if (alpha_k > 0.1d0) then
98
+
do i = 1, graph%n_nodes
99
+
if (.not. graph%nodes(i)%active) cycle
100
+
do j = i+1, graph%n_nodes
101
+
if (.not. graph%nodes(j)%active) cycle
102
+
dx = graph%nodes(j)%x - graph%nodes(i)%x
103
+
dy = graph%nodes(j)%y - graph%nodes(i)%y
104
+
dist = sqrt(dx*dx + dy*dy) + 0.01d0
105
+
if (dist < COLLIDE_R) then
106
+
force = (COLLIDE_R - dist) / dist * 0.5d0
107
+
ax(i) = ax(i) - force * dx
108
+
ay(i) = ay(i) - force * dy
109
+
ax(j) = ax(j) + force * dx
110
+
ay(j) = ay(j) + force * dy
111
+
end if
112
+
end do
113
+
end do
114
+
end if
115
+
116
+
! ── Integrate velocities ──
117
+
do i = 1, graph%n_nodes
118
+
if (.not. graph%nodes(i)%active) cycle
119
+
if (graph%nodes(i)%fx >= 0.0d0) then
120
+
! Pinned node
121
+
graph%nodes(i)%x = graph%nodes(i)%fx
122
+
graph%nodes(i)%vx = 0.0d0
123
+
graph%nodes(i)%vy = 0.0d0
124
+
cycle
125
+
end if
126
+
graph%nodes(i)%vx = (graph%nodes(i)%vx + ax(i)) * VELOCITY_DEC
127
+
graph%nodes(i)%vy = (graph%nodes(i)%vy + ay(i)) * VELOCITY_DEC
128
+
graph%nodes(i)%x = graph%nodes(i)%x + graph%nodes(i)%vx
129
+
graph%nodes(i)%y = graph%nodes(i)%y + graph%nodes(i)%vy
130
+
! Clamp to grid
131
+
graph%nodes(i)%x = max(3.0d0, min(dble(w)-4.0d0, graph%nodes(i)%x))
132
+
graph%nodes(i)%y = max(1.0d0, min(dble(h)-1.0d0, graph%nodes(i)%y))
133
+
end do
134
+
135
+
! ── Cool down ──
136
+
alpha = alpha * (1.0d0 - ALPHA_DECAY)
137
+
if (alpha < 0.001d0) alpha = 0.001d0
138
+
end subroutine
139
+
140
+
! Pre-warm: run N ticks with high alpha to settle initial layout
141
+
subroutine sim_prewarm(graph, w, h, n_ticks)
142
+
type(lex_graph_t), intent(inout) :: graph
143
+
integer, intent(in) :: w, h, n_ticks
144
+
integer :: i
145
+
alpha = 1.0d0
146
+
do i = 1, n_ticks
147
+
call sim_tick(graph, w, h)
148
+
end do
149
+
alpha = 0.3d0 ! keep some heat for live animation
150
+
end subroutine
151
+
152
+
end module fortrat_simulate
+118
src/tui.f90
+118
src/tui.f90
···
1
+
module fortrat_tui
2
+
use iso_c_binding
3
+
use iso_fortran_env, only: output_unit
4
+
use fortrat_types
5
+
implicit none
6
+
7
+
logical, save :: raw_mode_active = .false.
8
+
9
+
interface
10
+
function fortrat_enter_raw() bind(c, name='fortrat_enter_raw') result(r)
11
+
import c_int
12
+
integer(c_int) :: r
13
+
end function
14
+
15
+
function fortrat_exit_raw() bind(c, name='fortrat_exit_raw') result(r)
16
+
import c_int
17
+
integer(c_int) :: r
18
+
end function
19
+
20
+
subroutine fortrat_winsize(cols, rows) bind(c, name='fortrat_winsize')
21
+
import c_int
22
+
integer(c_int), intent(out) :: cols, rows
23
+
end subroutine
24
+
25
+
subroutine fortrat_clear_screen() bind(c, name='fortrat_clear_screen')
26
+
end subroutine
27
+
28
+
subroutine fortrat_write_at(row, col, str, len) bind(c, name='fortrat_write_at')
29
+
import c_int, c_char
30
+
integer(c_int), value :: row, col, len
31
+
character(kind=c_char, len=1), intent(in) :: str(len)
32
+
end subroutine
33
+
34
+
subroutine fortrat_flush() bind(c, name='fortrat_flush')
35
+
end subroutine
36
+
37
+
function fortrat_read_key(buf) bind(c, name='fortrat_read_key') result(n)
38
+
import c_int, c_char
39
+
character(c_char), intent(out) :: buf(4)
40
+
integer(c_int) :: n
41
+
end function
42
+
end interface
43
+
44
+
contains
45
+
46
+
subroutine tui_enter_raw_mode()
47
+
integer(c_int) :: rc
48
+
rc = fortrat_enter_raw()
49
+
raw_mode_active = .true.
50
+
call fortrat_clear_screen()
51
+
end subroutine
52
+
53
+
subroutine tui_exit_raw_mode()
54
+
integer(c_int) :: rc
55
+
if (.not. raw_mode_active) return
56
+
rc = fortrat_exit_raw()
57
+
raw_mode_active = .false.
58
+
write(*, '(a)', advance='no') SHOW_CUR // RESET
59
+
write(*, *)
60
+
flush(output_unit)
61
+
end subroutine
62
+
63
+
subroutine tui_get_term_size(cols, rows)
64
+
integer, intent(out) :: cols, rows
65
+
integer(c_int) :: c, r
66
+
call fortrat_winsize(c, r)
67
+
cols = int(c)
68
+
rows = int(r)
69
+
if (cols <= 0) cols = 120
70
+
if (rows <= 0) rows = 40
71
+
end subroutine
72
+
73
+
! Non-blocking key read. Returns:
74
+
! 0 = nothing available
75
+
! 1..127 = ASCII char
76
+
! -1 = up arrow
77
+
! -2 = down arrow
78
+
! -3 = left arrow
79
+
! -4 = right arrow
80
+
! -5 = ESC (bare)
81
+
function tui_read_key() result(key)
82
+
integer :: key
83
+
character(c_char) :: buf(4)
84
+
integer(c_int) :: n
85
+
86
+
n = fortrat_read_key(buf)
87
+
if (n <= 0) then
88
+
key = 0; return
89
+
end if
90
+
91
+
! ESC sequence
92
+
if (ichar(buf(1)) == 27 .and. n >= 3) then
93
+
if (buf(2) == '[') then
94
+
select case(buf(3))
95
+
case('A'); key = -1 ! up
96
+
case('B'); key = -2 ! down
97
+
case('C'); key = -4 ! right
98
+
case('D'); key = -3 ! left
99
+
case default; key = -5
100
+
end select
101
+
return
102
+
end if
103
+
end if
104
+
if (ichar(buf(1)) == 27 .and. n == 1) then
105
+
key = -5; return
106
+
end if
107
+
key = ichar(buf(1))
108
+
end function
109
+
110
+
! Move cursor to 1-based (col, row)
111
+
subroutine tui_move(col, row)
112
+
integer, intent(in) :: col, row
113
+
character(len=16) :: buf
114
+
write(buf, '(a,i0,a,i0,a)') ESC//'[', row, ';', col, 'H'
115
+
write(*, '(a)', advance='no') trim(buf)
116
+
end subroutine
117
+
118
+
end module fortrat_tui
+65
src/tui_helper.c
+65
src/tui_helper.c
···
1
+
/* fortrat_tui_helper.c
2
+
Terminal helpers for FORTRAT — called from Fortran via ISO C binding.
3
+
*/
4
+
#include <termios.h>
5
+
#include <unistd.h>
6
+
#include <sys/ioctl.h>
7
+
#include <fcntl.h>
8
+
#include <stdio.h>
9
+
10
+
static struct termios saved_termios;
11
+
12
+
static void xwrite(int fd, const void *buf, size_t n) {
13
+
ssize_t r = write(fd, buf, n);
14
+
(void)r;
15
+
}
16
+
17
+
int fortrat_enter_raw(void) {
18
+
struct termios raw;
19
+
if (tcgetattr(STDIN_FILENO, &saved_termios) < 0) return -1;
20
+
raw = saved_termios;
21
+
raw.c_lflag &= ~(ICANON | ECHO | ISIG);
22
+
raw.c_iflag &= ~(IXON | ICRNL);
23
+
raw.c_cc[VMIN] = 1;
24
+
raw.c_cc[VTIME] = 0;
25
+
if (tcsetattr(STDIN_FILENO, TCSANOW, &raw) < 0) return -1;
26
+
int flags = fcntl(STDIN_FILENO, F_GETFL, 0);
27
+
fcntl(STDIN_FILENO, F_SETFL, flags | O_NONBLOCK);
28
+
return 0;
29
+
}
30
+
31
+
int fortrat_exit_raw(void) {
32
+
int flags = fcntl(STDIN_FILENO, F_GETFL, 0);
33
+
fcntl(STDIN_FILENO, F_SETFL, flags & ~O_NONBLOCK);
34
+
return tcsetattr(STDIN_FILENO, TCSANOW, &saved_termios);
35
+
}
36
+
37
+
void fortrat_winsize(int *cols, int *rows) {
38
+
struct winsize ws;
39
+
if (ioctl(STDIN_FILENO, TIOCGWINSZ, &ws) == 0) {
40
+
*cols = ws.ws_col;
41
+
*rows = ws.ws_row;
42
+
} else {
43
+
*cols = 120;
44
+
*rows = 40;
45
+
}
46
+
}
47
+
48
+
void fortrat_clear_screen(void) {
49
+
xwrite(STDOUT_FILENO, "\033[?25l\033[2J\033[H", 11);
50
+
}
51
+
52
+
void fortrat_write_at(int row, int col, const char *str, int len) {
53
+
char buf[32];
54
+
int n = snprintf(buf, sizeof(buf), "\033[%d;%dH", row, col);
55
+
xwrite(STDOUT_FILENO, buf, n);
56
+
xwrite(STDOUT_FILENO, str, len);
57
+
}
58
+
59
+
void fortrat_flush(void) {
60
+
fsync(STDOUT_FILENO);
61
+
}
62
+
63
+
int fortrat_read_key(char *buf) {
64
+
return (int)read(STDIN_FILENO, buf, 4);
65
+
}
+126
src/types.f90
+126
src/types.f90
···
1
+
module fortrat_types
2
+
use iso_fortran_env, only: int32, int64, real64
3
+
implicit none
4
+
5
+
integer, parameter :: MAX_NODES = 512
6
+
integer, parameter :: MAX_EDGES = 4096
7
+
integer, parameter :: MAX_FIELDS = 64
8
+
integer, parameter :: ID_LEN = 128
9
+
integer, parameter :: LABEL_LEN = 32
10
+
integer, parameter :: DOC_LEN = 256
11
+
integer, parameter :: KIND_LEN = 16
12
+
13
+
! Namespace group IDs
14
+
integer, parameter :: NS_APP_BSKY = 1
15
+
integer, parameter :: NS_COM_ATPROTO = 2
16
+
integer, parameter :: NS_CHAT_BSKY = 3
17
+
integer, parameter :: NS_TOOLS_OZONE = 4
18
+
integer, parameter :: NS_COMMUNITY = 5
19
+
20
+
! Lexicon kinds
21
+
integer, parameter :: KIND_RECORD = 1
22
+
integer, parameter :: KIND_QUERY = 2
23
+
integer, parameter :: KIND_PROCEDURE = 3
24
+
integer, parameter :: KIND_SUBSCRIPTION = 4
25
+
integer, parameter :: KIND_TOKEN = 5
26
+
integer, parameter :: KIND_OBJECT = 6
27
+
integer, parameter :: KIND_UNKNOWN = 7
28
+
29
+
character(len=4), parameter :: KIND_SIGIL(7) = &
30
+
[ 'REC ', 'QRY ', 'SUB ', 'EVT ', 'TOK ', 'OBJ ', '??? ' ]
31
+
32
+
! ANSI color escape codes (phosphor green palette)
33
+
character(len=*), parameter :: ESC = achar(27)
34
+
character(len=*), parameter :: CSI = ESC // '['
35
+
character(len=*), parameter :: RESET = ESC // '[0m'
36
+
character(len=*), parameter :: GREEN_BR = ESC // '[92m' ! bright green — primary
37
+
character(len=*), parameter :: GREEN = ESC // '[32m' ! mid green
38
+
character(len=*), parameter :: GREEN_DIM = ESC // '[2;32m' ! dim green
39
+
character(len=*), parameter :: YELLOW = ESC // '[33m' ! amber — community
40
+
character(len=*), parameter :: CYAN = ESC // '[36m' ! chat.bsky
41
+
character(len=*), parameter :: MAGENTA = ESC // '[35m' ! tools.ozone
42
+
character(len=*), parameter :: WHITE = ESC // '[97m'
43
+
character(len=*), parameter :: BLACK_BG = ESC // '[40m'
44
+
character(len=*), parameter :: GREEN_BG = ESC // '[42m'
45
+
character(len=*), parameter :: BOLD = ESC // '[1m'
46
+
character(len=*), parameter :: REVERSE = ESC // '[7m'
47
+
character(len=*), parameter :: CLEAR_SCR = ESC // '[2J'
48
+
character(len=*), parameter :: HIDE_CUR = ESC // '[?25l'
49
+
character(len=*), parameter :: SHOW_CUR = ESC // '[?25h'
50
+
51
+
type :: lex_field_t
52
+
character(len=ID_LEN) :: name = ''
53
+
character(len=KIND_LEN) :: ftype = ''
54
+
character(len=ID_LEN) :: ref = ''
55
+
logical :: required = .false.
56
+
end type
57
+
58
+
type :: lex_node_t
59
+
character(len=ID_LEN) :: id = ''
60
+
character(len=LABEL_LEN) :: label = ''
61
+
integer :: ns_group = NS_COMMUNITY
62
+
integer :: kind = KIND_UNKNOWN
63
+
character(len=DOC_LEN) :: doc = ''
64
+
integer :: n_fields = 0
65
+
type(lex_field_t) :: fields(MAX_FIELDS)
66
+
logical :: active = .false. ! visible in current filter
67
+
! Force simulation state
68
+
real(real64) :: x = 0.0d0, y = 0.0d0
69
+
real(real64) :: vx = 0.0d0, vy = 0.0d0
70
+
real(real64) :: fx = -1.0d0 ! -1 means unpin
71
+
end type
72
+
73
+
type :: lex_edge_t
74
+
integer :: src = 0 ! index into nodes array
75
+
integer :: tgt = 0
76
+
logical :: is_union = .false.
77
+
end type
78
+
79
+
type :: lex_graph_t
80
+
integer :: n_nodes = 0
81
+
integer :: n_edges = 0
82
+
type(lex_node_t) :: nodes(MAX_NODES)
83
+
type(lex_edge_t) :: edges(MAX_EDGES)
84
+
end type
85
+
86
+
! Application state
87
+
integer, parameter :: MODE_LOADING = 0
88
+
integer, parameter :: MODE_GRAPH = 1
89
+
integer, parameter :: MODE_SEARCH = 2
90
+
integer, parameter :: MODE_INSPECT = 3
91
+
integer, parameter :: MODE_ERROR = 4
92
+
integer, parameter :: MODE_HELP = 5
93
+
94
+
type :: app_state_t
95
+
integer :: mode = MODE_LOADING
96
+
integer :: cursor_idx = 1 ! 1-based into visible nodes
97
+
integer :: selected_idx = 0 ! 0 = none
98
+
character(len=ID_LEN) :: search_query = ''
99
+
logical :: groups(5) ! visible ns groups
100
+
logical :: community = .false.
101
+
character(len=128) :: status_msg = 'READY'
102
+
character(len=256) :: progress = ''
103
+
character(len=512) :: error_msg = ''
104
+
integer :: term_w = 120
105
+
integer :: term_h = 40
106
+
integer :: graph_w = 78 ! cols for graph pane
107
+
integer :: inspect_w = 42 ! cols for inspect pane
108
+
integer :: graph_h = 36 ! rows for graph area
109
+
end type
110
+
111
+
contains
112
+
113
+
! NS group → ANSI color string
114
+
function ns_color(ns) result(col)
115
+
integer, intent(in) :: ns
116
+
character(len=16) :: col
117
+
select case(ns)
118
+
case(NS_APP_BSKY); col = GREEN_BR
119
+
case(NS_COM_ATPROTO); col = YELLOW
120
+
case(NS_CHAT_BSKY); col = CYAN
121
+
case(NS_TOOLS_OZONE); col = MAGENTA
122
+
case default; col = WHITE
123
+
end select
124
+
end function
125
+
126
+
end module fortrat_types