JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

A poem of forty-seven kana, and the one raylib call a Flan string cannot make

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 23:28:40 +07:00
parent fdf7531c37
commit 4c184e68ce
3 changed files with 408 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

257
examples/text-codepoints-loading.flan Normal file
View File

@ -0,0 +1,257 @@
;;;; raylib [text] example - codepoints loading
;;;;
;;;; examples/text/text_codepoints_loading.c. The example that scans a piece of
;;;; UTF-8 for every codepoint it contains, throws the duplicates away, and
;;;; builds a font atlas holding exactly those glyphs and no others — which is
;;;; how a game that displays Japanese ships a font without shipping all
;;;; twenty thousand kanji.
;;;;
;;;; It is here because it is the first thing in this tree to put **text** under
;;;; load rather than geometry. Everything else in examples/ that draws words
;;;; draws ASCII literals through the default font. This one carries a
;;;; non-ASCII string through the reader, into the object file, out to raylib,
;;;; back as an array of codepoints, and into a glyph set — and each of those
;;;; steps is somewhere a byte could be lost with no diagnostic anywhere.
;;;;
;;;; **What worked with nothing added, and is worth saying because it was the
;;;; open question.** Flan's reader takes UTF-8 in a string literal and the
;;;; bytes survive to the binary unexamined: the 54 codepoints in `text` below
;;;; come back out of LoadCodepoints as the right 54, and as 49 distinct ones.
;;;; Nothing in the
;;;; language claims to know what a character is — a `string` is bytes and a
;;;; `[u8]` is the same bytes, which `(string ...)` and `(bytes ...)` say in
;;;; both directions — and that turns out to be exactly the right amount of
;;;; opinion for this. The count below is a count of codepoints because raylib
;;;; decoded them, not because Flan did.
;;;;
;;;; And `load-font-ex` needed nothing either. It already takes a `[i32]` slice
;;;; of codepoints and takes the pointer-and-count apart itself, with a
;;;; zeroed global standing in for the null pointer that means "the default
;;;; ASCII set" — written for exactly this call, before anything called it.
;;;;
;;;; **Two things Flan would not do, both written up in PORTING.md.**
;;;;
;;;; 1. `GetCodepointPrevious` cannot be called at all. It reads BACKWARDS
;;;; from the pointer it is handed, and a Flan `string` crosses to C as a
;;;; NUL-terminated *copy* (lib/shim.ml) — so the bytes in front of that
;;;; pointer belong to the allocator and not to the text. It does not
;;;; crash; it reads rubbish and answers 0, which is the worst of the
;;;; available outcomes. `step-back` below is the replacement, and it is
;;;; four lines: a UTF-8 continuation byte is 10xxxxxx, so walking back
;;;; over them lands on the lead byte of the previous codepoint, and
;;;; get-codepoint-next from there says what it is.
;;;;
;;;; 2. The C's duplicate removal shifts the tail of the array down over
;;;; each duplicate it finds, and its inner loop reads one element past
;;;; the end on the first one it removes. C does not notice; Flan's
;;;; bounds check signals BoundsError and the frame stops. It is rewritten
;;;; here as a build-up — scan the output for the codepoint, append it if
;;;; it is not there — which is shorter, has no shifting in it at all, and
;;;; keeps first-seen order exactly as the C's version does.
;;;;
;;;; **The font is not in this repository, and the example says so on screen.**
;;;; raylib's own resources/DotGothic16-Regular.ttf is 2 MB, and whether a
;;;; compiler repository with one 1 KB PNG in it should grow a 2 MB font is a
;;;; decision about the repository rather than about this port — so it is left
;;;; to the author, and `font-path` below is where it goes. Without it raylib
;;;; hands back the default font, whose 224 glyphs are ASCII, and the kana draw
;;;; as boxes. Everything else in the program — the scan, the deduplication,
;;;; the codepoint walk, the atlas request — runs either way, and
;;;; test/programs/raylib-codepoints.flan asserts the arithmetic half of it
;;;; with no window and no font at all.
(import rl "vendor:raylib")
(import d "digits.flan")
(defconst screen-width 800)
(defconst screen-height 450)
;; The text to display, which must be UTF-8 — and, as the C's comment says,
;; can be all the text a game will ever show: it is scanned to find the glyphs
;; the atlas needs. This is the Iroha, a poem that uses each kana exactly once,
;; which is why the duplicate count below is as small as it is: the only
;; repeats are the ideographic space and the newline.
(defconst text
"いろはにほへと　ちりぬるを\nわかよたれそ　つねならむ\nうゐのおくやま　けふこえて\nあさきゆめみし　ゑひもせす")
;; Where the font goes if somebody puts it there. Relative to the working
;; directory, as raylib resolves every path — the C says `resources/...` and
;; is run from its own directory; this says the same thing from the root of
;; this repository.
(defconst font-path "examples/resources/DotGothic16-Regular.ttf")
;; The Iroha below is 47 kana, 4 ideographic spaces and 3 newlines — 54
;; codepoints of which 49 are distinct, the kana being famously each used once,
;; so the only repeats are the space and the newline. 128 is the round number
;; with room above that for the
;; text being edited, and it is a constant because a fixed array's length must
;; be a literal and because an atlas's glyph count is a thing worth having a
;; ceiling on: this is the number that decides how big the font texture gets.
(defconst max-codepoints 128)
(defvar unique-codepoints [max-codepoints i32])
(defvar unique-count i32)
;; Is `cp` already in the first `n` of the table?
(defn seen? [cp i32 n i32] bool
(let [found false]
(dotimes [i n]
(when (= (at unique-codepoints i) cp) (set found true)))
found))
;; The C's CodepointRemoveDuplicates, turned inside out. Theirs copies the
;; whole array and then compacts it in place, shifting the tail down over
;; every duplicate; this appends each codepoint the table does not already
;; have. Same answer, same order, and no shifting — see the header comment for
;; why the shifting version is not a transcription this language accepts.
;;
;; Exported because test/programs/raylib-codepoints.flan runs it: which
;; codepoints an atlas is asked for is arithmetic, and arithmetic is the half
;; of a raylib example a headless case can assert.
(defn collect-unique [codepoints [i32]] ()
(set unique-count 0)
(dotimes [i (len codepoints)]
(let [cp (at codepoints i)]
(when (and (not (seen? cp unique-count))
(< unique-count max-codepoints))
(set (at unique-codepoints unique-count) cp)
(set unique-count (+ unique-count 1))))))
;; ── Walking the text one codepoint at a time ────────────────────────
;;
;; The C keeps a `char *ptr` and moves it by the size of each codepoint. Here
;; the cursor is a byte offset into the text, because the pointer it would
;; otherwise be cannot be handed to C: see `step-back`.
;; Is this byte a UTF-8 continuation — 10xxxxxx? Every byte of a multi-byte
;; sequence after the first is, and no lead byte and no ASCII byte is, which
;; is the property that makes the encoding walkable in both directions without
;; a table.
(defn continuation? [b u8] bool (= (bit-and b 0xc0) 0x80))
;; The codepoint starting at `off`, and its size in bytes through `size-out`.
;;
;; `(string (slice b off (len b)))` is the whole of what the C's `ptr` is: the
;; tail of the text from here on. It costs nothing to say — a `string` and a
;; `[u8]` are the same two words — and the shim NUL-terminates a copy of it
;; for the duration of the call, which is all GetCodepointNext wants, because
;; it only ever reads forwards.
(defn codepoint-at [off i32 size-out (Ptr i32)] i32
(let [b (bytes text)]
(if (>= off (len b))
0
(rl/get-codepoint-next (string (slice b off (len b))) size-out))))
;; One codepoint forward, clamped at the end.
;;
;; The C clamps at neither end — `ptr` walks off the back of the string and
;; off the front of it if you hold the key down, which is a real bug that C
;; does not report and that this language will not perform. Stopping is the
;; behaviour a reader of this example would have expected anyway.
(defn step-forward [off i32] i32
(let [size 0
b (bytes text)]
(if (>= off (len b))
off
(do (codepoint-at off (addr size))
(if (>= (+ off size) (len b)) off (+ off size))))))
;; One codepoint back, and the replacement for GetCodepointPrevious.
;;
;; That function reads backwards from the pointer it is given, and a Flan
;; string reaches C as a copy, so backwards from it is the allocator's
;; business. What it was going to compute is computable here instead and in
;; fewer instructions than the call would have cost: step back one byte, keep
;; stepping while the byte is a continuation, and the codepoint that starts
;; there is the previous one. codepoint-at then says what it is, from the
;; forward direction, where the copy is not a problem.
(defn step-back [off i32] i32
(let [b (bytes text)
i (- off 1)]
(while (and (> i 0) (continuation? (at b i)))
(set i (- i 1)))
(if (< i 0) 0 i)))
(defvar font rl/Font)
(defvar show-font-atlas bool)
(defvar cursor i32)
(defvar codepoint-count i32)
(defn main [] ()
(rl/init-window screen-width screen-height
"raylib [text] example - codepoints loading")
(defer (rl/close-window))
;; Turn each UTF-8 character of the text into the codepoint the font file
;; indexes its glyphs by. raylib owns the array; slice-from-ptr is the
;; promise that there are `codepoint-count` of them behind the pointer, and
;; raylib's own out-parameter is where that number came from.
(let [codepoints (rl/load-codepoints text (addr codepoint-count))]
(collect-unique (slice-from-ptr codepoints codepoint-count))
(rl/unload-codepoints codepoints))
;; The atlas is generated here, from the deduplicated set — a smaller set is
;; a smaller texture, which is the entire point of the deduplication.
(set font (rl/load-font-ex font-path 36
(slice unique-codepoints 0 unique-count)))
(defer (rl/unload-font font))
;; Bilinear, so the 36-pixel atlas still reads when it is drawn at 48. The
;; default is :point and the kana come out with stepped edges.
(rl/set-texture-filter (.texture font) :bilinear)
;; Line spacing for the newlines the text contains. draw-text-ex honours it;
;; nothing else in this program does.
(rl/set-text-line-spacing 20)
(set show-font-atlas false)
(set cursor 0)
(rl/set-target-fps 60)
(until (rl/window-should-close?)
;; Update
(when (rl/key-pressed? :space) (set show-font-atlas (not show-font-atlas)))
;; The C's "testing code": walk the text and throw the answer away. Kept
;; because it is what exercises the codepoint walk, and because the two
;; directions are not symmetric here the way they are in the C — one is a
;; raylib call and the other is the four lines in step-back that stand in
;; for the raylib call that cannot be made.
(cond
(rl/key-pressed? :right) (set cursor (step-forward cursor))
(rl/key-pressed? :left) (set cursor (step-back cursor)))
;; Draw
(rl/with-drawing
(rl/clear-background rl/raywhite)
(rl/draw-rectangle 0 0 (rl/get-screen-width) 70 rl/black)
(let [x (+ 10 (d/draw-piece "Total codepoints contained in provided text: "
10 10 20 rl/green))]
(d/draw-int codepoint-count x 10 20 rl/green))
(let [x (+ 10 (d/draw-piece
"Total codepoints required for font atlas (duplicates excluded): "
10 40 20 rl/green))]
(d/draw-int unique-count x 40 20 rl/green))
(if show-font-atlas
;; The generated atlas itself, which is the picture of what the
;; deduplication bought: one cell per distinct codepoint and nothing
;; else in it.
(do (rl/draw-texture (.texture font) 150 100 rl/black)
(rl/draw-rectangle-lines 150 100 (.width (.texture font))
(.height (.texture font)) rl/black))
(rl/draw-text-ex font text (rl/Vector2 {.x 160.0 .y 110.0})
48.0 5.0 rl/black))
;; The line the C does not have, and the reason it is here is in the
;; header comment: without the TTF this program draws boxes, and a
;; program that draws boxes without saying why reads as broken.
(when (not (rl/path-file? font-path))
(d/draw-piece "No font at examples/resources/ — glyphs will be boxes."
10 (- screen-height 55) 20 rl/maroon))
(d/draw-piece "Press SPACE to toggle font atlas view!"
10 (- screen-height 30) 20 rl/gray))))

119
test/programs/raylib-codepoints.flan Normal file
View File

@ -0,0 +1,119 @@
;;;; examples/text-codepoints-loading.flan's other half: the scan, the
;;;; deduplication and the codepoint walk, with no window and no font.
;;;;
;;;; The same split core-input-virtual-controls.flan already has. What makes it
;;;; available here is that the *interesting* part of that example is not the
;;;; drawing: it is which codepoints a piece of UTF-8 contains, which of them
;;;; are distinct, and where each one starts in the bytes. All three are
;;;; arithmetic, LoadCodepoints needs no GL context, and the example's `main`
;;;; is not exported — so this runs the same code the window runs, without one.
;;;;
;;;; Three things are pinned here and they fail for three different reasons.
;;;;
;;;; **1. The text survived.** 49 distinct codepoints out of 54 is a
;;;; property of the Iroha and of nothing else, so a literal that lost a byte
;;;; between the reader and the object file changes both numbers. The first
;;;; five distinct codepoints are printed as well, because a count alone would
;;;; survive a re-ordering.
;;;;
;;;; **2. The walk agrees with itself.** The text is stepped from the first
;;;; codepoint to the last, and then back from the last to the first, and the
;;;; two sequences are compared. That is what pins `step-back` — the four lines
;;;; that replace GetCodepointPrevious, which this language cannot call because
;;;; a Flan string reaches C as a copy and that function reads backwards out of
;;;; the pointer it is handed. If the continuation-byte test were wrong the
;;;; backward walk would land mid-sequence and read a different codepoint, and
;;;; the two sequences would stop being reverses of each other.
;;;;
;;;; **3. The walk agrees with raylib.** The sequence the walk produces is
;;;; compared against the array LoadCodepoints returned, element for element.
;;;; Item 2 on its own would pass if both walks were wrong in the same way;
;;;; this is the outside opinion, and it is raylib's rather than ours.
;;;;
;;;; Nothing here draws, so nothing here needs the TTF the example looks for.
(import cp "../../examples/text-codepoints-loading.flan")
(import rl "vendor:raylib")
(defconst max-walk 128)
(defvar forward [max-walk i32])
(defvar forward-n i32)
(defvar backward [max-walk i32])
(defvar backward-n i32)
(defn yes-no [b bool] string (if b "yes" "no"))
(defn show [name string n i32] ()
(print name) (print " ") (println n))
;; From the first codepoint to the last. step-forward clamps rather than
;; running off the end — the C does not, which is a bug it gets away with —
;; so the walk is over when the offset stops moving.
(defn walk-forward [] ()
(set forward-n 0)
(let [off 0
size 0
going true]
(while going
(set (at forward forward-n) (cp/codepoint-at off (addr size)))
(set forward-n (+ forward-n 1))
(let [next (cp/step-forward off)]
(if (= next off) (set going false) (set off next))))))
;; And back again, from wherever forward stopped. Written as a separate walk
;; rather than as an index into the first one on purpose: the point is that
;; step-back finds the lead byte of the previous codepoint out of the bytes
;; alone, so it has to be asked, not remembered.
(defn walk-backward [start i32] ()
(set backward-n 0)
(let [off start
size 0
going true]
(while going
(set (at backward backward-n) (cp/codepoint-at off (addr size)))
(set backward-n (+ backward-n 1))
(if (= off 0)
(set going false)
(set off (cp/step-back off))))))
(defn main [] ()
(let [total 0
raw (rl/load-codepoints cp/text (addr total))]
(show "codepoints" total)
(cp/collect-unique (slice-from-ptr raw total))
(show "unique" cp/unique-count)
(dotimes [i 5]
(print "unique ") (print i) (print " ")
(println (at cp/unique-codepoints i)))
(walk-forward)
(show "forward" forward-n)
;; The last codepoint's offset, recomputed the same way walk-forward found
;; it, because the walk deliberately keeps no offsets.
(let [last-off 0
going true]
(while going
(let [next (cp/step-forward last-off)]
(if (= next last-off) (set going false) (set last-off next))))
(walk-backward last-off))
(show "backward" backward-n)
;; Item 2: the two walks are reverses of each other.
(let [mirrored (= forward-n backward-n)]
(dotimes [i forward-n]
(when (and mirrored
(not (= (at forward i) (at backward (- (- backward-n 1) i)))))
(set mirrored false)))
(print "walks mirror ") (println (yes-no mirrored)))
;; Item 3: and the forward walk is what raylib said the text contains.
(let [agrees (= forward-n total)
all (slice-from-ptr raw total)]
(dotimes [i forward-n]
(when (and agrees (not (= (at forward i) (at all i))))
(set agrees false)))
(print "walk matches raylib ") (println (yes-no agrees)))
(rl/unload-codepoints raw)))

32
test/test_acceptance.ml
View File

@ -1045,6 +1045,38 @@ let () =
print_endline print_endline
"acceptance: skipping the raylib image-processing case (no libraylib)"; "acceptance: skipping the raylib image-processing case (no libraylib)";
(* The scan and the codepoint walk of examples/text-codepoints-loading.flan,
headless. The example is imported, so the literal counted here is the
literal that program draws — which is the point: a non-ASCII string
literal is carried by the reader, the object file and the FFI without
any of the three claiming to understand it, and 49 distinct codepoints
out of 54 is a fact about the Iroha that a lost byte anywhere in that
chain would change. The two walk rows are what stands in for
GetCodepointPrevious, which cannot be called from Flan at all — see
PORTING.md, and the file's own header for what each row fails on. *)
let raylib_codepoints_out =
"codepoints 54\n\
unique 49\n\
unique 0 12356\n\
unique 1 12429\n\
unique 2 12399\n\
unique 3 12395\n\
unique 4 12411\n\
forward 54\n\
backward 54\n\
walks mirror yes\n\
walk matches raylib yes\n"
in
if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then begin
outputs "raylib codepoints, headless"
"programs/raylib-codepoints.flan" raylib_codepoints_out;
outputs ~opt:"-O0" "raylib codepoints, headless, -O0"
"programs/raylib-codepoints.flan" raylib_codepoints_out
end
else
print_endline
"acceptance: skipping the raylib codepoints case (no libraylib)";
(* raylib's Wave family, headless — and the first claim to make about it (* raylib's Wave family, headless — and the first claim to make about it
is that it exists. The received wisdom in this repository was that is that it exists. The received wisdom in this repository was that
audio needs a device and so cannot be in this table at all. That is audio needs a device and so cannot be in this table at all. That is