diff --git a/HANDOFF-raylib-ports.md b/HANDOFF-raylib-ports.md new file mode 100644 index 0000000..f6d3e9b --- /dev/null +++ b/HANDOFF-raylib-ports.md @@ -0,0 +1,89 @@ +# Handoff — the last two raylib ports + +Two examples, `text_codepoints_loading` and `textures_image_processing`, ported into +`examples/`. This file is the running record: what is done, what was decided without being +able to ask, and what is still open. `PORTING.md` has the findings that outlive the port — +its last section, "Porting the raylib examples — the last two" — and this file has the +state of the work. + +## Status — done + +- [x] `examples/text-codepoints-loading.flan` — builds +- [x] `examples/textures-image-processing.flan` — builds +- [x] `test/programs/raylib-codepoints.flan` and `test/programs/raylib-image-processing.flan`, + both in the acceptance table, both gated on libraylib, both run plain and at `-O0` +- [x] `PORTING.md` section for this round +- [x] `dune test --root .` green + +Four commits, each one a working state: + +1. the plan and the open question (this file's first version) +2. `PixelFormat`, the one binding this round added +3. the image-processing example and its headless case +4. the codepoints example and its headless case + +## Open questions for the author + +1. **Vendor `DotGothic16-Regular.ttf`?** `text_codepoints_loading` draws Japanese, and + there is no CJK font in this tree. The font is SIL OFL 1.1 and therefore + redistributable, but it is 2 MB of binary in a repository whose only binary asset is a + 1 KB PNG, and that is a call about the repository rather than about the port. The + example works either way: it looks for + `examples/resources/DotGothic16-Regular.ttf`, and if it is not there raylib hands back + the default font, the kana draw as boxes, and the program says on screen why. Drop the + TTF in and the glyphs appear with nothing else to change. `~/Repositories/raylib/examples/text/resources/` + has the file and its OFL notice. + +2. **`lib/cimport.ml`'s `agrees` promises an arm it does not have.** The comment at + `lib/cimport.ml:1291` lists, among the differences that are "expected and are not + reported", *"a `(Ptr T)` where the header says `T *` and the hand-written line chose + something more specific"*. The function implements the enum-against-i32 arm and nothing + else. That missing arm is the only thing standing between this round's two refused + bindings and ordinary binding work — see `PORTING.md` §A.1 and §A.2, which have the + exact declarations and the exact error. **Not built: it is a compiler change and the + freeze is on.** It is small and it is well specified, and it is the thing to do first if + these two ports are ever revisited. + +3. The image-processing port keeps the C's `LoadImageColors` → `UpdateTexture` round trip + even though `(.data im-copy)` is the same bytes and already the right type. Kept + because it is what the C does and because nothing else in the corpus exercises that + pair. If you would rather the example were the short version, the comment on + `reload-texture` says exactly what to delete. + +## Deviations from the upstream C, all deliberate, all commented in place + +- **Neither asset is vendored.** `parrots.png` has no licence at all in raylib's own + LICENSE.md, so the image-processing example generates its picture. The generated image is + asymmetric in both axes and has hard edges on purpose — a symmetric one makes the two + flips indistinguishable and the blur invisible. +- **The duplicate removal is a build-up, not a compaction.** The C's shift-the-tail-down + loop reads one element past the end of its allocation, which C tolerates and Flan's + bounds check does not. +- **The codepoint cursor clamps at both ends.** The C's runs off both. +- **`GetCodepointPrevious` is not called**, because it cannot be: a Flan string reaches C + as a NUL-terminated copy and that function reads backwards out of the pointer. Four + lines of continuation-byte walking replace it, and the headless case pins them against + `LoadCodepoints`. +- **The UP key in image processing wraps to 7 and not to 8**, which is the C's own + off-by-one, left as it is so that the port and the example it claims to be do not + disagree. + +## Things a next lane should know + +- `examples/` is **not** compiled by `dune test`. `test/dune` globs it so that imports + resolve, nothing more. `flan build ` is the only proof an example compiles, and + it is worth running on all of them after any change to `vendor/raylib`. +- The header check in `vendor/raylib/headers` runs on **every ordinary build**, not only on + `flan generate-c`. A hand-written `declare-c` that disagrees with `raylib-5.5.h` therefore + breaks every build in the tree, not just regeneration. That is what makes open question 2 + a blocker rather than an inconvenience. +- `(string (slice b off (len b)))` is the idiom for a C `char *` cursor into the middle of a + string, and it costs nothing. It is correct for every entry point that reads forwards and + wrong for every one that reads backwards. +- `slice-from-ptr` is how a raylib pointer-plus-count becomes something with a length. Both + new test programs lean on it. + +## Log + +- Started from `957ba07` on `dev-loop`. The worktree came up on a much older commit + (`2c232dd`, no `examples/` directory at all) and was reset onto the branch tip first. diff --git a/PORTING.md b/PORTING.md index 5ee7c6d..e1d3250 100644 --- a/PORTING.md +++ b/PORTING.md @@ -635,3 +635,263 @@ site, fixed by one parameter), `Handle` and pools (nothing to pool), `Result`/`t (neither host uses that discipline), `handler-case` (one site, `handler-bind` covers it), `loop`/`recur` and tail calls (nothing recurses), user-written allocators, structural typing. + +--- + +# Porting the raylib examples — the last two + +`text_codepoints_loading` and `textures_image_processing`, the two left on the list, both +ported and both building: `examples/text-codepoints-loading.flan` and +`examples/textures-image-processing.flan`, each with a headless acceptance case beside it +in `test/programs/`. They were picked because they were expected to stress two corners the +earlier rounds had not — Unicode and codepoint arrays on one side, CPU-side pixel buffers +and in-place mutation on the other — and both expectations were right, though not in the +places anyone guessed. + +**Coverage.** Read in full: both upstream C sources in `~/Repositories/raylib`, every +`.flan` in `examples/`, `vendor/raylib/raylib.flan`, `generated.flan`, `bindings` and +`headers`, the `PixelFormat` and `Font`/`GlyphInfo` halves of `raylib-5.5.h`, `test/dune`, +the raylib blocks of `test/test_acceptance.ml`, `test/programs/raylib-image.flan` and +`test/programs/virtual-controls-headless.flan`, and the string-crossing half of +`lib/shim.ml` and `lib/cimport.ml`. Everything below was run rather than reasoned about; +each finding in §A names the command that produced the failure. + +## A. The two gaps + +### A.1 `GetCodepointPrevious` cannot be called, and closing it is a checker change + +This is the real find of the round, and it is general: **a C function that reads +*backwards* from the pointer it is handed cannot be given a Flan `string`.** + +`lib/shim.ml` is explicit about why — `Pstr` is "ptr+len in, a NUL-terminated copy out", +and the wrapper builds that copy for the duration of the call. Forwards, that is invisible +and free. Backwards it is not: the bytes in front of the copy belong to the allocator, so a +function that steps back from the pointer reads memory that has nothing to do with the +text. + +It does not crash, which is the bad part. Run headless: + +```flan +(let [text "いろはに" + b (bytes text) + sz 0] + (println (rl/get-codepoint-previous (string (slice b 3 (len b))) (addr sz))) + (println sz)) +``` + +That prints `0` and `0`, where the answer is 12356 (い) and 3. Zero is also what +`GetCodepointPrevious` returns for a genuinely malformed sequence, so there is nothing in +the result to distinguish "Flan handed you a copy" from "your text is broken". The same +expression with `get-codepoint-next` is correct, because that one only reads forwards. +That is the whole of the difference. + +**The code I wanted to write, and what stops it.** The obvious repair is the one +`raylib.flan` already uses twice — a hand-written `-raw` declaration that says `(Ptr u8)` +and means it, as `load-image-from-memory-raw` and `load-font-ex-raw` do: + +```flan +(declare-c get-codepoint-previous-raw + [text (Ptr u8) codepoint-size (Ptr i32)] i32 + "GetCodepointPrevious") +``` + +with `(addr (at b i))` for the interior pointer. It does not work, and the reason is not +the FFI. `lib/cimport.ml` maps `const char *` to `string`, and `agrees` — the function that +decides whether a hand-written declaration and the header say the same thing — accepts +exactly one difference, an enum against a 32-bit integer. `(Ptr u8)` against `string` is not +it. Adding the line above and building *anything*, not only regenerating, gives: + +``` +vendor/raylib/generated.flan:233:12: the declare-c of get-codepoint-previous-raw + disagrees with vendor/raylib/raylib-5.5.h: parameter text is (Ptr u8) and the + header says string (const char *) +``` + +`headers` is read on every build, so the binding cannot be added without relaxing the +header check, and relaxing the header check is a change to the compiler. **Feature freeze; +not built.** + +**Worth flagging beside it: `cimport.ml`'s own comment promises this and the code does not +deliver it.** The list of "three differences that are expected and are not reported" at +`lib/cimport.ml:1291` includes + +> - a `(Ptr T)` where the header says `T *` and the hand-written line chose something more +> specific for a reason it recorded. + +`agrees` implements the enum arm and nothing else. Either that bullet describes an +intention never written, or the rule was lost in a refactor. Whichever it is, the paragraph +is already the design note for the fix: a third arm in `agrees` accepting a hand-written +`(Ptr T)` against a header pointer, which would let this binding and the one in A.2 both be +written honestly. + +**The workaround, and it is a good one.** UTF-8 is walkable backwards without asking +anybody: a continuation byte is `10xxxxxx`, so stepping back over continuation bytes lands +on the lead byte of the previous codepoint, and `get-codepoint-next` from *there* says what +it is — forwards, where the copy costs nothing. That is `step-back` in the example, four +lines. `test/programs/raylib-codepoints.flan` pins it by walking the poem forwards, walking +it backwards, and checking that the two are reverses of each other and that the forward one +is what `LoadCodepoints` says the text contains. + +It is fewer instructions than the call would have been. **But the finding is not "this one +function"** — it is that the direction a C function reads in is invisible in its signature, +and Flan's string crossing makes half of those directions silently wrong. Every future +binding over a `const char *` cursor meets it. + +### A.2 There is no cast between pointer types + +`textures_image_processing` hands the pixels `LoadImageColors` returned straight to +`UpdateTexture`. In C both are pointers and nothing has to be said. Here +`load-image-colors` answers `(Ptr Color)` and `update-texture` takes `(Ptr u8)` — the +header spells that parameter `const void *`, and `cimport.ml` has to render a `void *` as +something — so the call is refused: + +``` +expected (Ptr u8), found (Ptr rl/Color) +``` + +A hand-written `(declare-c update-texture-colors [texture Texture2D pixels (Ptr Color)] … +"UpdateTexture")` is the natural binding fix and is refused by the same header check as +A.1, with the same message. **Not built.** + +**Workaround, and it is legitimate rather than a trick:** the address of the first field of +the first element is the address of the buffer. + +```flan +(rl/update-texture texture (addr (.r (at (slice-from-ptr pixels n) 0)))) +``` + +`Color`'s first field is `r`, a `u8`, at offset 0. It compiles, it is the right address, +and it says out loud what C's implicit conversion was doing quietly. It is also ugly, and +the ugliness is the report: a `(Ptr u8)` view of a typed buffer is something an FFI wants +often — `void *` appears thirty-odd times in raylib.h alone. + +Two smaller notes on the same call. `(.data im-copy)` is already a `(Ptr u8)` over the same +bytes, so the whole round trip is avoidable; the example keeps it because it is what the C +does and because nothing else in the corpus exercises +`LoadImageColors`/`UnloadImageColors`. And `slice-from-ptr` is what makes any of this +readable — it is the one form that turns a raylib pointer plus a raylib count into +something with a length, and it was reached for three times across the two files. + +## B. What was expected to be a gap and was not + +**UTF-8 in a string literal works, end to end, with nothing added.** This was the round's +open question and the answer is clean. The reader takes the bytes, the object file carries +them, the shim hands them over, and `LoadCodepoints` decodes the 54 codepoints of the Iroha +into the 49 distinct ones the atlas is built from. Nothing in Flan claims to know what a +character is — a `string` is bytes and `(bytes s)` / `(string b)` say so in both directions +at no cost — and for this job that is exactly the right amount of opinion. There is a +`valid-utf8?` in the prelude and this example never needs it. + +**An interior pointer into a string has an idiom already.** `(string (slice b off (len b)))` +is the C's `char *ptr` and compiles to nothing: a `string` and a `[u8]` are the same two +words. Every forward-reading `const char *` entry point is reachable that way. + +**`load-font-ex` needed nothing.** It takes a `[i32]` of codepoints, takes the +pointer-and-count apart itself, and uses a zeroed `defvar` as the null pointer that means +"the default ASCII set". It was written for this call before anything called it, and the +call fit it exactly. + +**`and` short-circuits, which `step-back` depends on.** The backward walk's loop condition +is `(and (> i 0) (continuation? (at b i)))`, and at the start of the text `i` is -1 — so if +`and` were a strict function rather than a form, the guard would not save the `(at b -1)` +beside it and the first press of LEFT would signal `BoundsError`. It is a form and it does +short-circuit; `test/programs/raylib-codepoints.flan` has a row for it, because the walk +itself never reaches that offset and the claim is about the language rather than about the +example. + +**Fixed arrays were the right shape for both.** A codepoint table with a count, a +`[9 Rectangle]` of toggle buttons, a `[9 string]` of labels. The §3 finding from the +siam-farmer report — a global cannot hold a `Vec`, and fixed arrays with counts are usually +the better answer anyway — held again, in two more programs, with no friction at all. + +## C. Where Flan was better than the C + +**The upstream deduplication reads out of bounds, and Flan will not perform it.** +`CodepointRemoveDuplicates` compacts its array by shifting the tail down over each +duplicate: + +```c +for (int k = j; k < codepointsNoDupsCount; k++) codepointsNoDups[k] = codepointsNoDups[k + 1]; +``` + +On the first duplicate `codepointsNoDupsCount` is still the full count, so at `k = N-1` +that reads element `N` of an `N`-element allocation. C does not notice: `RL_CALLOC` has +slack and the value is overwritten immediately. A literal transcription signals +`BoundsError` and stops the frame. The port is a build-up instead — scan the output, append +if absent — which is shorter, has no shifting in it, and keeps first-seen order exactly as +the C's version does. This is Tier 1 item 4 of the report above catching a real upstream bug +in the first program that met it. + +**The C's cursor walks off both ends of its string,** and the port clamps. `ptr += size` +with RIGHT held runs past the terminator; `ptr -= size` with LEFT held runs in front of the +literal. Same class of thing, same outcome: what C lets through is what Flan makes you +decide about. + +## D. What was added, and what was deliberately not + +**Added — `PixelFormat`, a 24-member `defenum` in `vendor/raylib/raylib.flan`.** +`ImageFormat` moved from the generated half to the hand-written one (`exclude ImageFormat` +in `bindings`), and `enum PixelFormat PIXELFORMAT_` maps the members so all 24 values are +compared against `raylib-5.5.h` on every build. Two of them need a `constant` line, because +raylib spells the ASTC block sizes `ASTC_4x4` with a lowercase `x` where every other letter +in that enum is upper — the same narrow exception `GESTURE_DOUBLETAP` already had. This is +the trade `TextureFilter` and `MouseCursor` already made, for the same reason: the C is +`int newFormat` and exactly one of twenty-four conversions is the one a program meant. + +It paid for itself in the test rather than at the call site. `ImageColorGrayscale` +reallocates into a one-byte-per-pixel buffer, so the working image's `format` goes from 7 to +1 mid-run, and `raylib-image-processing.flan` asserts that it does. Before the enum, that +row was two integers with nothing to say about them. + +**Corrected — a wrong comment.** `raylib.flan`'s `image-from-image` said "There is no +ImageCopy in 5.5". There is: `raylib-5.5.h:1348`, and `generated.flan` has had it bound all +along. The note now says which of the two is the better call for duplicating a whole image. + +**Not added — the two assets, and this is the one open decision.** Both upstream examples +load a file out of `resources/` and neither file is in this tree. + +- `parrots.png` is listed in raylib's own `examples/textures/resources/LICENSE.md` with no + author and no licence — a `❔` in both columns. It is not a file to copy into somebody + else's repository on a sleeping author's behalf. The image-processing example generates + its source picture instead, as the three textures examples already here do. What the + generated image has to be is decided by the filters rather than by taste: asymmetric in + **both** axes, or the vertical and the horizontal flip are indistinguishable and the port + looks broken, and carrying sharp edges, or the Gaussian blur has nothing to work on. +- `DotGothic16-Regular.ttf` is SIL OFL 1.1 and therefore redistributable, but it is 2 MB, + and whether a compiler repository whose only binary asset is a 1 KB PNG should grow a 2 MB + font is a call about the repository rather than about this port. Left to the author; + `HANDOFF-raylib-ports.md` carries it as the open question. The example looks for it under + `examples/resources/`, says on screen when it is not there, and runs either way — raylib + answers a missing path with the default font, whose glyphs are ASCII, so the kana draw as + boxes and the program explains itself rather than looking broken. + +**Neither example needed a language feature.** Nothing below the two refused bindings in §A +was blocked at all, and both of those are one arm in `lib/cimport.ml`'s `agrees` away from +being ordinary binding work. + +## E. Testing + +Both examples build. `flan build` on each is the only direct proof there is: `test/dune` +globs `examples/*` so that imports resolve, and does not compile them. + +Both now also have a headless half in the acceptance table, gated on `ldconfig` finding +libraylib exactly as the existing raylib cases are, each run twice — plain and `-O0`: + +- `test/programs/raylib-image-processing.flan` imports the example and runs its nine filters + over its pixels. It is the first case in the corpus to exercise the **in-place** half of + the Image surface: every filter takes a `(Ptr Image)` and rewrites the buffer under it, + and two of them free the old buffer and install a new one. `raylib-image.flan` is entirely + by value and cannot reach that. Grayscale, invert, tint, contrast, brightness and the two + flips are pinned to the byte; the blur is pinned structurally — size and format survive, a + pixel outside a red rectangle reddens, the inside stays red-dominant — because the exact + kernel is raylib's business and pinning a blurred byte buys a test that goes red when + raylib improves. +- `test/programs/raylib-codepoints.flan` imports the other example and pins three separate + things: that the literal survived (49 distinct of 54, a fact about the Iroha and nothing + else), that the forward and backward walks are reverses of each other (which is what + `step-back` is for), and that the forward walk agrees with `LoadCodepoints` element for + element — the outside opinion, because the second claim alone would pass if both walks + were wrong in the same way. + +Both rows were confirmed to go red when deliberately perturbed, which is the only way to +know an acceptance case is wired in at all. `dune test --root .` is green. diff --git a/examples/text-codepoints-loading.flan b/examples/text-codepoints-loading.flan new file mode 100644 index 0000000..7d1f85c --- /dev/null +++ b/examples/text-codepoints-loading.flan @@ -0,0 +1,263 @@ +;;;; 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) +;; 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 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, 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 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)))) diff --git a/examples/textures-image-processing.flan b/examples/textures-image-processing.flan new file mode 100644 index 0000000..a509fb5 --- /dev/null +++ b/examples/textures-image-processing.flan @@ -0,0 +1,261 @@ +;;;; raylib [textures] example - image processing +;;;; +;;;; examples/textures/textures_image_processing.c. The one example in the +;;;; category where the CPU does the work: nine filters run over a pixel +;;;; buffer in RAM, and the GPU's only job is to show the answer. Every other +;;;; textures example this tree has ported either generates pixels and uploads +;;;; them once (image-generation), draws into a render target (fog-of-war, +;;;; mouse-painting), or reads one back (mouse-painting again). None of them +;;;; had ever handed raylib a buffer and asked it to rewrite the buffer. +;;;; +;;;; What that puts under load, and it is a different thing from the nine +;;;; Gen* calls in examples/textures-image-generation.flan: **in-place +;;;; mutation of an Image through a (Ptr Image)**. Eight of the nine filters +;;;; take the image by pointer and change `data` under the caller — +;;;; image-format and image-blur-gaussian *reallocate* it, so the pointer the +;;;; caller held before the call is freed by it. raylib.flan's Images section +;;;; already says that the by-value/by-pointer split is raylib's own and is +;;;; kept deliberately so a caller can see which calls change what they are +;;;; given; this is the example that depends on it being right. +;;;; +;;;; What needed adding: `PixelFormat`, a defenum in vendor/raylib/raylib.flan, +;;;; with image-format moved from the generated half to the hand-written one +;;;; and mapped in `bindings` so its twenty-four members are checked against +;;;; raylib.h. The C's line is +;;;; +;;;; ImageFormat(&imOrigin, PIXELFORMAT_UNCOMPRESSED_R8G8B8A8); +;;;; +;;;; and without the enum the Flan for it is `7`, which is a number with +;;;; nothing in it to say which of twenty-four conversions was meant. It is +;;;; the same trade TextureFilter made for the fog-of-war port. The call is +;;;; kept even though the generated image is already in that format — raylib's +;;;; Gen* calls all produce it — because it is the C's own guard and because +;;;; the reason it is there (UpdateTexture will not take anything else) has +;;;; not stopped being true. +;;;; +;;;; **The source image is generated and not loaded, and that is a licence +;;;; decision rather than a technical one.** The C loads `resources/parrots.png`, +;;;; which raylib's own examples/textures/resources/LICENSE.md lists with no +;;;; author and no licence at all, so it is not a file to copy into this +;;;; repository. The three textures examples already here generate everything +;;;; they draw and this one joins them. What the generated image has to be is +;;;; set by the filters rather than by taste: **asymmetric in both axes**, or +;;;; the vertical and the horizontal flip look identical and the port appears +;;;; broken, and carrying **sharp edges**, or the Gaussian blur has nothing to +;;;; soften. A diagonal gradient with three solid shapes dropped on it at +;;;; three different distances from three different edges is the smallest +;;;; thing that is both. +;;;; +;;;; The other deviation is the size. parrots.png is 768x512; this is 200x150, +;;;; because a blur of radius 10 is the one filter here whose cost is visible +;;;; and because the picture is a demonstration of the filter rather than the +;;;; point of the program. +;;;; +;;;; One gap, written up in PORTING.md and worked around in `reload-texture` +;;;; below: LoadImageColors answers a (Ptr Color) and UpdateTexture takes a +;;;; (Ptr u8), because the header spells its parameter `const void *` and Flan +;;;; has no cast between pointer types. The address of the first field of the +;;;; first pixel is the same address, and saying so is what the workaround is. + +(import rl "vendor:raylib") + +(defconst screen-width 800) +(defconst screen-height 450) + +(defconst num-processes 9) + +;; The C's ImageProcess enum. Flan's defenum lowers to an i32 for C's benefit +;; and these never cross to C, so they are defconsts — the same choice +;; examples/textures-image-generation.flan made for its texture index. +(defconst proc-none 0) +(defconst proc-color-grayscale 1) +(defconst proc-color-tint 2) +(defconst proc-color-invert 3) +(defconst proc-color-contrast 4) +(defconst proc-color-brightness 5) +(defconst proc-gaussian-blur 6) +(defconst proc-flip-vertical 7) +(defconst proc-flip-horizontal 8) + +(defvar process-names [num-processes string]) + +;; The nine toggle buttons down the left-hand side, laid out once at startup. +(defvar toggle-recs [num-processes rl/Rectangle]) + +;; The generated picture's size. Small on purpose — see the header comment. +(defconst source-width 200) +(defconst source-height 150) + +;; The picture the filters run over, in place of the C's parrots.png. +;; +;; The gradient runs corner to corner rather than along an axis, so a flip in +;; either direction moves it, and the three shapes are at three different +;; distances from three different edges so that no reflection of this image is +;; this image. The rectangles are what the blur has to work on: a gradient is +;; already smooth and a blur of it is very nearly itself. +;; +;; Exported rather than local because test/programs/raylib-image-processing.flan +;; runs the same nine filters over the same pixels with no window open, and a +;; headless case asserting a *different* image would be asserting nothing. +(defn make-source-image [] rl/Image + (let [img (rl/gen-image-gradient-linear source-width source-height 45 + rl/skyblue rl/darkblue)] + (rl/image-draw-rectangle (addr img) 12 10 62 34 rl/red) + (rl/image-draw-rectangle (addr img) 24 96 44 44 rl/lime) + (rl/image-draw-circle (addr img) 152 112 26 rl/gold) + img)) + +;; The C's `switch (currentProcess)`. A cond here, as in +;; examples/textures-image-generation.flan, and for the same reason: Flan has +;; no switch and the chain reads the same. +;; +;; Every arm takes the image by pointer and every arm rewrites the buffer the +;; pointer names. `proc-none` is the C's `default: break` and does nothing at +;; all, which is what makes the top entry of the list "NO PROCESSING" rather +;; than a filter that happens to be the identity. +(defn apply-process [img (Ptr rl/Image) which i32] () + (cond + (= which proc-color-grayscale) (rl/image-color-grayscale img) + (= which proc-color-tint) (rl/image-color-tint img rl/green) + (= which proc-color-invert) (rl/image-color-invert img) + (= which proc-color-contrast) (rl/image-color-contrast img -40.0) + (= which proc-color-brightness) (rl/image-color-brightness img -80) + (= which proc-gaussian-blur) (rl/image-blur-gaussian img 10) + (= which proc-flip-vertical) (rl/image-flip-vertical img) + (= which proc-flip-horizontal) (rl/image-flip-horizontal img))) + +(defvar texture rl/Texture2D) +(defvar im-origin rl/Image) +(defvar im-copy rl/Image) +(defvar current-process i32) +(defvar mouse-hover-rec i32) + +;; Throw the working copy away, take a fresh one from the original, run the +;; filter over it, and push the result at the texture that is already on the +;; GPU. +;; +;; The round trip through LoadImageColors is the C's, and it is not the +;; shortest route: after image-format the working image is already RGBA8, so +;; `(.data im-copy)` is the same bytes and is already a (Ptr u8). It is kept +;; because it is what the C does and because the pair is the only thing in the +;; corpus that exercises it — and because the awkward step in it is a finding +;; rather than an accident. LoadImageColors answers a (Ptr Color); UpdateTexture +;; takes a (Ptr u8), the header having spelled that parameter `const void *`; +;; and there is no cast between pointer types in Flan. What there is, is the +;; address of the red channel of pixel zero, which is the address of the +;; buffer said the long way round. See PORTING.md. +(defn reload-texture [] () + (rl/unload-image im-copy) + (set im-copy (rl/image-copy im-origin)) + (apply-process (addr im-copy) current-process) + (let [n (* (.width im-copy) (.height im-copy)) + pixels (rl/load-image-colors im-copy)] + (rl/update-texture texture (addr (.r (at (slice-from-ptr pixels n) 0)))) + (rl/unload-image-colors pixels))) + +(defn main [] () + (rl/init-window screen-width screen-height + "raylib [textures] example - image processing") + (defer (rl/close-window)) + + (set (at process-names 0) "NO PROCESSING") + (set (at process-names 1) "COLOR GRAYSCALE") + (set (at process-names 2) "COLOR TINT") + (set (at process-names 3) "COLOR INVERT") + (set (at process-names 4) "COLOR CONTRAST") + (set (at process-names 5) "COLOR BRIGHTNESS") + (set (at process-names 6) "GAUSSIAN BLUR") + (set (at process-names 7) "FLIP VERTICAL") + (set (at process-names 8) "FLIP HORIZONTAL") + + ;; NOTE, as the C has it: a texture can only be made after init-window, + ;; because making one needs the GL context init-window creates. The image + ;; underneath it does not — nothing above this line touches the GPU. + (set im-origin (make-source-image)) + (rl/image-format (addr im-origin) :uncompressed-r8g8b8a8) + (set texture (rl/load-texture-from-image im-origin)) + (set im-copy (rl/image-copy im-origin)) + + (defer (rl/unload-texture texture)) + (defer (rl/unload-image im-origin)) + (defer (rl/unload-image im-copy)) + + (set current-process proc-none) + (set mouse-hover-rec -1) + + (set toggle-recs (array num-processes rl/Rectangle)) + (dotimes [i num-processes] + (set (at toggle-recs i) + (rl/Rectangle {.x 40.0 .y (f32 (+ 50 (* 32 i))) + .width 150.0 .height 30.0}))) + + (rl/set-target-fps 60) + + (until (rl/window-should-close?) + ;; Update + ;; + ;; The C computes mouseHoverRec with a loop whose `else` clause resets it + ;; on every miss and whose `break` leaves it set on a hit. As in + ;; examples/textures-mouse-painting.flan the reset is lifted out in front + ;; and the loop only ever sets it, which is the same answer said plainly — + ;; the nine rectangles do not overlap, so there is no first-hit-wins rule + ;; to preserve. + (set mouse-hover-rec -1) + (let [reload false] + (dotimes [i num-processes] + (when (rl/collision-point-rec? (rl/get-mouse-position) (at toggle-recs i)) + (set mouse-hover-rec i) + (when (rl/mouse-button-released? :left) + (set current-process i) + (set reload true)))) + + ;; The keyboard half of the same toggle group. DOWN wraps at the end of + ;; the list; UP does not wrap to the end but to 7, which is the C's own + ;; off-by-one — FLIP HORIZONTAL is unreachable going up — and is left + ;; as it is because changing it here would make this file disagree with + ;; the example it claims to be. + (cond + (rl/key-pressed? :down) + (do (set current-process (+ current-process 1)) + (when (> current-process (- num-processes 1)) + (set current-process 0)) + (set reload true)) + + (rl/key-pressed? :up) + (do (set current-process (- current-process 1)) + (when (< current-process 0) (set current-process 7)) + (set reload true))) + + ;; NOTE, as the C has it: image processing is a costly thing to do per + ;; frame. It is done here only when the selection changed, and a program + ;; that needed it every frame would do it on the GPU in a shader. + (when reload (reload-texture))) + + ;; Draw + (rl/with-drawing + (rl/clear-background rl/raywhite) + + (rl/draw-text "IMAGE PROCESSING:" 40 30 10 rl/darkgray) + + (dotimes [i num-processes] + (let [on (or (= i current-process) (= i mouse-hover-rec)) + r (at toggle-recs i) + name (at process-names i)] + (rl/draw-rectangle-rec r (if on rl/skyblue rl/lightgray)) + (rl/draw-rectangle-lines (i32 (.x r)) (i32 (.y r)) + (i32 (.width r)) (i32 (.height r)) + (if on rl/blue rl/gray)) + ;; Centred in the button, so the label's own measured width is what + ;; decides where it starts. + (rl/draw-text name + (i32 (- (+ (.x r) (/ (.width r) 2.0)) + (/ (f32 (rl/measure-text name 10)) 2.0))) + (+ (i32 (.y r)) 11) + 10 + (if on rl/darkblue rl/darkgray)))) + + (let [x (- screen-width (.width texture) 60) + y (- (/ screen-height 2) (/ (.height texture) 2))] + (rl/draw-texture texture x y rl/white) + (rl/draw-rectangle-lines x y (.width texture) (.height texture) + rl/black))))) diff --git a/test/programs/raylib-codepoints.flan b/test/programs/raylib-codepoints.flan new file mode 100644 index 0000000..f9919b9 --- /dev/null +++ b/test/programs/raylib-codepoints.flan @@ -0,0 +1,127 @@ +;;;; 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))) + + ;; The one call walk-backward never makes: step-back at the very start. + ;; It is where the example goes the moment anybody presses LEFT before + ;; pressing RIGHT, and it is the one offset where the continuation-byte + ;; loop is asked to step off the front of the buffer. `and` short-circuits, + ;; so the (> i 0) guard is what keeps (at b -1) from being evaluated at + ;; all — which is a claim about the language and so is worth a row. + (show "back at start" (cp/step-back 0)) + + ;; 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/programs/raylib-image-processing.flan b/test/programs/raylib-image-processing.flan new file mode 100644 index 0000000..b90baa7 --- /dev/null +++ b/test/programs/raylib-image-processing.flan @@ -0,0 +1,132 @@ +;;;; examples/textures-image-processing.flan's other half: the nine filters, +;;;; no window. +;;;; +;;;; The same split core-input-virtual-controls.flan and sand.flan already +;;;; have, and this one earns it more easily than either: an Image is pixels in +;;;; RAM, so every filter in that example runs with no GL context, and raylib +;;;; *computes* the answer rather than handing back what it was given. That is +;;;; what raylib.flan's Images section says makes this corner of the surface +;;;; assertable at all, and programs/raylib-image.flan is the case that already +;;;; leans on it. +;;;; +;;;; What this pins that raylib-image.flan does not: the **in-place** half of +;;;; the Image surface. Everything there is by value — gen, crop to a new +;;;; image, read a pixel. Every filter here takes a (Ptr Image) and rewrites +;;;; the buffer under it, and two of them (image-format, image-blur-gaussian) +;;;; free the old buffer and install a new one. A declaration that said `Image` +;;;; where raylib wants `Image *` would compile, would be handed a copy of the +;;;; struct, and would leave the caller's pixels untouched — which is a wrong +;;;; picture and not a crash. +;;;; +;;;; It imports the example, so the pixels here and the pixels on screen are +;;;; the same pixels. The example's `main` is not exported and nothing below +;;;; opens a window, so the only main is this one. +;;;; +;;;; **What is asserted and what is deliberately not.** Grayscale, invert and +;;;; the two flips are exact arithmetic — a fixed set of channel weights, +;;;; 255 minus the channel, and a coordinate reflection — so those are pinned +;;;; to the byte. The blur is not: the exact kernel ImageBlurGaussian uses is +;;;; raylib's business and a patch release may change it, so pinning a blurred +;;;; byte would buy a test that goes red when raylib improves. What is pinned +;;;; about the blur is the two things that are true of any blur — the image +;;;; keeps its size and format, and a pixel just outside a red rectangle has +;;;; moved toward red — and that is the shape of claim a filter can carry. +;;;; +;;;; Tint, contrast and brightness sit in between and are pinned exactly: all +;;;; three are per-channel arithmetic on a single pixel with no neighbourhood +;;;; at all, so there is nothing in them for an implementation to have an +;;;; opinion about. + +(import ip "../../examples/textures-image-processing.flan") +(import rl "vendor:raylib") + +;; Three probes, chosen so that between them every shape and the background +;; are represented, and so that no two of them are a reflection of each other +;; in either axis. That last property is what makes the flip rows mean +;; something: mirror the image and each probe lands somewhere new. +(defconst probe-a-x 40) ; inside the red rectangle near the top +(defconst probe-a-y 20) +(defconst probe-b-x 40) ; inside the lime rectangle near the bottom +(defconst probe-b-y 110) +(defconst probe-c-x 180) ; background gradient, right-hand side +(defconst probe-c-y 40) + +(defn show-color [name string which string c rl/Color] () + (print name) + (print " ") (print which) + (print " ") (print (.r c)) + (print " ") (print (.g c)) + (print " ") (print (.b c)) + (print " ") (print (.a c)) + (println "")) + +;; Size and format on the same line as the name, because two of the nine +;; filters reallocate and a filter that quietly changed either would otherwise +;; only show up as three moved pixels. +(defn show-shape [name string i rl/Image] () + (print name) + (print " ") (print (.width i)) + (print " ") (print (.height i)) + (print " ") (print (.format i)) + (println "")) + +(defn probe [name string i rl/Image] () + (show-shape name i) + (show-color name "a" (rl/get-image-color i probe-a-x probe-a-y)) + (show-color name "b" (rl/get-image-color i probe-b-x probe-b-y)) + (show-color name "c" (rl/get-image-color i probe-c-x probe-c-y))) + +;; One filter, over a fresh copy of the source, reported and thrown away. A +;; copy per filter and not one image threaded through all nine: the example +;; restores from the original before every filter for exactly this reason, and +;; a test that stacked them would be asserting the composition rather than the +;; parts. +(defn run [name string src rl/Image which i32] () + (let [img (rl/image-copy src)] + (ip/apply-process (addr img) which) + (probe name img) + (rl/unload-image img))) + +(defn yes-no [b bool] string (if b "yes" "no")) + +;; The blur, said in the only two ways a blur can be said without pinning +;; somebody else's kernel. The edge probe is one pixel outside the red +;; rectangle's left side: before the blur it is gradient, after it some of the +;; red next door has arrived, so its red channel is strictly higher. The +;; interior probe is well inside the rectangle and is still red-dominant, +;; which is what says the blur spread the colour rather than washed it out. +(defconst edge-x 10) +(defconst edge-y 20) + +(defn blur-claims [src rl/Image] () + (let [img (rl/image-copy src)] + (rl/image-blur-gaussian (addr img) 10) + (show-shape "blur" img) + (let [before (rl/get-image-color src edge-x edge-y) + after (rl/get-image-color img edge-x edge-y) + inside (rl/get-image-color img probe-a-x probe-a-y)] + (print "blur edge-reddened ") (println (yes-no (> (.r after) (.r before)))) + (print "blur inside-still-red ") + (println (yes-no (and (> (.r inside) (.g inside)) + (> (.r inside) (.b inside)))))) + (rl/unload-image img))) + +(defn main [] () + (let [src (ip/make-source-image)] + ;; The example formats the original before anything else touches it, and + ;; so does this: a filter run over a differently-formatted buffer is a + ;; different filter. + (rl/image-format (addr src) :uncompressed-r8g8b8a8) + (probe "source" src) + + (run "none" src 0) + (run "grayscale" src 1) + (run "tint" src 2) + (run "invert" src 3) + (run "contrast" src 4) + (run "brightness" src 5) + (run "flip-v" src 7) + (run "flip-h" src 8) + (blur-claims src) + + (rl/unload-image src))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 5455c9e..1ea61d6 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -982,6 +982,102 @@ let () = else print_endline "acceptance: skipping the raylib Image case (no libraylib)"; + (* The nine filters of examples/textures-image-processing.flan, headless. + The example is imported, so these are the pixels that program shows — + and the filters are the half of the raylib Image surface + programs/raylib-image.flan does not reach, because every one of them + takes a (Ptr Image) and rewrites the buffer in place. Two of the rows + here are load-bearing beyond the arithmetic: grayscale's format goes + from 7 to 1, which is ImageColorGrayscale reallocating into a + one-byte-per-pixel buffer and is exactly the kind of change a + by-value declaration would hide, and the two flip rows read the OTHER + probe's colour, which is what says the reflection happened in the axis + it claimed. The blur is asserted structurally and not to the byte — + the file says why. *) + let raylib_proc_out = + "source 200 150 7\n\ + source a 230 41 55 255\n\ + source b 0 158 47 255\n\ + source c 37 122 202 255\n\ + none 200 150 7\n\ + none a 230 41 55 255\n\ + none b 0 158 47 255\n\ + none c 37 122 202 255\n\ + grayscale 200 150 1\n\ + grayscale a 99 99 99 255\n\ + grayscale b 98 98 98 255\n\ + grayscale c 105 105 105 255\n\ + tint 200 150 7\n\ + tint a 0 36 10 255\n\ + tint b 0 141 8 255\n\ + tint c 0 109 38 255\n\ + invert 200 150 7\n\ + invert a 25 214 200 255\n\ + invert b 255 97 208 255\n\ + invert c 218 133 53 255\n\ + contrast 200 150 7\n\ + contrast a 164 96 101 255\n\ + contrast b 81 138 98 255\n\ + contrast c 94 125 154 255\n\ + brightness 200 150 7\n\ + brightness a 150 1 1 255\n\ + brightness b 1 78 1 255\n\ + brightness c 1 42 122 255\n\ + flip-v 200 150 7\n\ + flip-v a 0 158 47 255\n\ + flip-v b 230 41 55 255\n\ + flip-v c 17 100 186 255\n\ + flip-h 200 150 7\n\ + flip-h a 49 135 212 255\n\ + flip-h b 255 203 0 255\n\ + flip-h c 230 41 55 255\n\ + blur 200 150 7\n\ + blur edge-reddened yes\n\ + blur inside-still-red yes\n" + in + if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then begin + outputs "raylib image processing, headless" + "programs/raylib-image-processing.flan" raylib_proc_out; + outputs ~opt:"-O0" "raylib image processing, headless, -O0" + "programs/raylib-image-processing.flan" raylib_proc_out + end + else + 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\ + back at start 0\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 diff --git a/vendor/raylib/bindings b/vendor/raylib/bindings index f428bfb..6160586 100644 --- a/vendor/raylib/bindings +++ b/vendor/raylib/bindings @@ -136,6 +136,15 @@ exclude DrawSphereWires exclude DrawRay exclude GetScreenToWorldRay +# The third batch, and one line for one reason. ImageFormat's `int newFormat` +# is a PixelFormat in fact — twenty-four codes of which exactly one is what a +# texture upload needs — so its Flan face is the defenum and not the C +# signature, the same trade SetTextureFilter makes one block up. +# examples/textures-image-processing.flan is what wanted it: the C's +# `PIXELFORMAT_UNCOMPRESSED_R8G8B8A8` is a name there and would have been a 7 +# here. +exclude ImageFormat + # ── The idiomatic layer, which is what these last two blocks are for ── # # Three kinds of C signature get a Flan face in raylib.flan rather than the @@ -216,12 +225,20 @@ enum GamepadAxis GAMEPAD_AXIS_ enum Gesture GESTURE_ enum MouseCursor MOUSE_CURSOR_ enum TextureFilter TEXTURE_FILTER_ +enum PixelFormat PIXELFORMAT_ # raylib writes GESTURE_DOUBLETAP as one word where every other member of that # enum is underscored. This is the narrow exception and not a general escape # hatch: one name the prefix rule gets wrong, said once. constant Gesture/double-tap GESTURE_DOUBLETAP +# And the second such pair, for the same kind of reason. The rule uppercases +# the Flan member name, and raylib spells the two ASTC block sizes with a +# lowercase `x` — PIXELFORMAT_COMPRESSED_ASTC_4x4_RGBA — where every other +# letter in that enum is upper. Two names the rule gets wrong, said once each. +constant PixelFormat/compressed-astc-4x4-rgba PIXELFORMAT_COMPRESSED_ASTC_4x4_RGBA +constant PixelFormat/compressed-astc-8x8-rgba PIXELFORMAT_COMPRESSED_ASTC_8x8_RGBA + # The 16 ConfigFlags bits. These are the values sand.flan and the ported # window-flags example pass to set-config-flags, set-window-state and # clear-window-state, and each is a single bit read off raylib.h by hand — diff --git a/vendor/raylib/generated.flan b/vendor/raylib/generated.flan index 482ddc6..9d09d65 100644 --- a/vendor/raylib/generated.flan +++ b/vendor/raylib/generated.flan @@ -153,7 +153,6 @@ (declare-c image-from-channel [image Image selected-channel i32] Image "ImageFromChannel") (declare-c image-text [text string font-size i32 color Color] Image "ImageText") (declare-c image-text-ex [font Font text string font-size f32 spacing f32 tint Color] Image "ImageTextEx") -(declare-c image-format [image (Ptr Image) new-format i32] "ImageFormat") (declare-c image-to-pot [image (Ptr Image) fill Color] "ImageToPOT") (declare-c image-alpha-crop [image (Ptr Image) threshold f32] "ImageAlphaCrop") (declare-c image-alpha-clear [image (Ptr Image) color Color threshold f32] "ImageAlphaClear") diff --git a/vendor/raylib/raylib.flan b/vendor/raylib/raylib.flan index e33cd74..bd2b447 100644 --- a/vendor/raylib/raylib.flan +++ b/vendor/raylib/raylib.flan @@ -660,6 +660,59 @@ ;; level too, so a caller can see which ones change what they are given. (defstruct Image [data (Ptr u8) width i32 height i32 mipmaps i32 format i32]) +;; The codes that `format` field carries, named. The header says `int format` +;; everywhere one is passed, and there is nothing in an `int` to say that 7 is +;; the one a texture upload requires — which is exactly the trade +;; TextureFilter and MouseCursor already made, and the reason this is a +;; defenum rather than a row of defconsts. +;; +;; The set is closed and is here whole, compressed members included, because a +;; subset would put the hole where the next caller looks: `format` is a field +;; programs *read* off an Image they did not make, and a loaded .ktx or .dds +;; answers with one of the compressed codes. Nothing here converts to one — +;; raylib's own ImageFormat only moves between the uncompressed formats — so +;; the compressed half is for reading rather than for asking. +;; +;; `uncompressed-r8g8b8a8` is 7, the one GenImageColor makes and the one +;; LoadTextureFromImage and UpdateTexture want. The `x` in the two ASTC names +;; is lowercase in raylib.h where every other letter in that enum is upper, so +;; those two are mapped by name in `bindings` — the same narrow exception +;; GESTURE_DOUBLETAP already has, and for the same reason. +(defenum PixelFormat + [uncompressed-grayscale 1 + uncompressed-gray-alpha 2 + uncompressed-r5g6b5 3 + uncompressed-r8g8b8 4 + uncompressed-r5g5b5a1 5 + uncompressed-r4g4b4a4 6 + uncompressed-r8g8b8a8 7 + uncompressed-r32 8 + uncompressed-r32g32b32 9 + uncompressed-r32g32b32a32 10 + uncompressed-r16 11 + uncompressed-r16g16b16 12 + uncompressed-r16g16b16a16 13 + compressed-dxt1-rgb 14 + compressed-dxt1-rgba 15 + compressed-dxt3-rgba 16 + compressed-dxt5-rgba 17 + compressed-etc1-rgb 18 + compressed-etc2-rgb 19 + compressed-etc2-eac-rgba 20 + compressed-pvrt-rgb 21 + compressed-pvrt-rgba 22 + compressed-astc-4x4-rgba 23 + compressed-astc-8x8-rgba 24]) + +;; Reformats the pixels in place, reallocating the buffer, so the Image's +;; `data`, `format` and — for a compressed source — its size all change under +;; the caller. Hand-written rather than generated for the enum: the header's +;; `int newFormat` takes any integer at all and only one of twenty-four is the +;; conversion a given program meant. +(declare-c image-format + [image (Ptr Image) new-format PixelFormat] + "ImageFormat") + (declare-c load-image [path string] Image "LoadImage") ;; raylib 5.5 spells this IsImageValid. IsImageReady, which older code calls, @@ -726,8 +779,11 @@ ;; The non-mutating form of the line above, and the reason it is worth having ;; both: image-crop changes the image it is given, so carving a sheet into ;; twenty tiles with it destroys the sheet on the first one. This returns a -;; fresh Image and leaves the original alone. There is no ImageCopy in 5.5, so -;; this is also how a whole image is duplicated — a rec covering all of it. +;; fresh Image and leaves the original alone. A rec covering the whole image +;; duplicates it, which is what this was originally reached for — though +;; image-copy in the generated half says that in one argument and is the +;; better call for it. (An earlier comment here said 5.5 had no ImageCopy. It +;; does — raylib-5.5.h line 1348 — and generated.flan has bound it all along.) ;; ;; The result owns its own buffer: unload-image it, like anything else that ;; allocated.