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

Merge branch 'worktree-agent-affdbb9fef702b34d' into dev-loop

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-14 06:55:39 +07:00
commit ddaebf2516
10 changed files with 1303 additions and 3 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

89
HANDOFF-raylib-ports.md Normal file
View File

@ -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 <example>` 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.

260
PORTING.md
View File

@ -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.

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

@ -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))))

261
examples/textures-image-processing.flan Normal file
View File

@ -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)))))

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

@ -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)))

132
test/programs/raylib-image-processing.flan Normal file
View File

@ -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)))

96
test/test_acceptance.ml
View File

@ -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

17
vendor/raylib/bindings vendored
View File

@ -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 —

1
vendor/raylib/generated.flan vendored
View File

@ -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")

60
vendor/raylib/raylib.flan vendored
View File

@ -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.