diff --git a/examples/text-codepoints-loading.flan b/examples/text-codepoints-loading.flan new file mode 100644 index 0000000..9ad13ae --- /dev/null +++ b/examples/text-codepoints-loading.flan @@ -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)))) diff --git a/test/programs/raylib-codepoints.flan b/test/programs/raylib-codepoints.flan new file mode 100644 index 0000000..b5a9546 --- /dev/null +++ b/test/programs/raylib-codepoints.flan @@ -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))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index cdda835..c96edb7 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -1045,6 +1045,38 @@ let () = print_endline "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 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