264 lines
13 KiB
Plaintext
264 lines
13 KiB
Plaintext
;;;; 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 docs/PORTING.md.**
|
||
;;;;
|
||
;;;; 1. `GetCodepointPrevious` could not be called at all, and now can.
|
||
;;;; 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 did not crash; it read rubbish and answered 0, which
|
||
;;;; is the worst of the available outcomes. The repair is a binding that
|
||
;;;; says `(Ptr u8)` and means it, which the header check refused until
|
||
;;;; lib/cimport.ml's `agrees` grew the pointer arm its own comment had
|
||
;;;; been promising. `rl/get-codepoint-previous` is that binding and
|
||
;;;; `step-back` below is now one call to it.
|
||
;;;;
|
||
;;;; 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`.
|
||
|
||
;; 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, which is GetCodepointPrevious and no longer a stand-in
|
||
;; for it.
|
||
;;
|
||
;; That function reads backwards from the pointer it is given, so a Flan
|
||
;; string — which reaches C as a copy — is the one thing it must not be
|
||
;; handed. `rl/get-codepoint-previous` takes the bytes and an offset instead
|
||
;; and builds the interior pointer itself; see the note beside it in
|
||
;; vendor/raylib/raylib.flan. What comes back through `size` is the length of
|
||
;; the codepoint *behind* `off`, so the previous offset is the difference.
|
||
;;
|
||
;; This used to be a hand-written walk over continuation bytes — step back one
|
||
;; byte and keep going while the byte is 10xxxxxx — which was correct and was
|
||
;; four lines of UTF-8 that the library beside it already knew. The walk is
|
||
;; still the right answer for a language with no raylib in it; it is not the
|
||
;; right answer for this program.
|
||
(defn step-back [off i32] i32
|
||
(let [b (bytes text)
|
||
size 0]
|
||
(if (<= off 0)
|
||
0
|
||
(do (rl/get-codepoint-previous b off (addr size))
|
||
(if (< (- off size) 0) 0 (- off size))))))
|
||
|
||
(defvar font rl/Font)
|
||
;; Whether the TTF was there, asked once. A `defvar` and not the call itself
|
||
;; in the draw loop: path-file? is a stat, and a syscall per frame to answer a
|
||
;; question whose answer cannot change while the program runs is exactly what
|
||
;; the per-frame rule in docs/PORTING.md is about.
|
||
(defvar font-present bool)
|
||
(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 font-present (rl/path-file? font-path))
|
||
(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, which is now symmetric
|
||
;; here the way it is in the C — a raylib call in each direction.
|
||
(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 font-present)
|
||
(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))))
|