diff --git a/examples/text-codepoints-loading.flan b/examples/text-codepoints-loading.flan index bae3923..e317108 100644 --- a/examples/text-codepoints-loading.flan +++ b/examples/text-codepoints-loading.flan @@ -31,15 +31,16 @@ ;;;; ;;;; **Two things Flan would not do, both written up in docs/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. +;;;; 1. `GetCodepointPrevious` could not be called at all, and now can. +;;;; It reads BACKWARDS from the pointer it is handed, and a Flan +;;;; `string` crosses to C as a NUL-terminated *copy* (lib/shim.ml) — so +;;;; the bytes in front of that pointer belong to the allocator and not +;;;; to the text. It did not crash; it read rubbish and answered 0, which +;;;; is the worst of the available outcomes. The repair is a binding that +;;;; says `(Ptr u8)` and means it, which the header check refused until +;;;; lib/cimport.ml's `agrees` grew the pointer arm its own comment had +;;;; been promising. `rl/get-codepoint-previous` is that binding and +;;;; `step-back` below is now one call to it. ;;;; ;;;; 2. The C's duplicate removal shifts the tail of the array down over ;;;; each duplicate it finds, and its inner loop reads one element past @@ -123,12 +124,6 @@ ;; 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 @@ -156,21 +151,28 @@ (do (codepoint-at off (addr size)) (if (>= (+ off size) (len b)) off (+ off size)))))) -;; One codepoint back, and the replacement for GetCodepointPrevious. +;; One codepoint back, which is GetCodepointPrevious and no longer a stand-in +;; for it. ;; -;; 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. +;; That function reads backwards from the pointer it is given, so a Flan +;; string — which reaches C as a copy — is the one thing it must not be +;; handed. `rl/get-codepoint-previous` takes the bytes and an offset instead +;; and builds the interior pointer itself; see the note beside it in +;; vendor/raylib/raylib.flan. What comes back through `size` is the length of +;; the codepoint *behind* `off`, so the previous offset is the difference. +;; +;; This used to be a hand-written walk over continuation bytes — step back one +;; byte and keep going while the byte is 10xxxxxx — which was correct and was +;; four lines of UTF-8 that the library beside it already knew. The walk is +;; still the right answer for a language with no raylib in it; it is not the +;; right answer for this program. (defn step-back [off i32] i32 (let [b (bytes text) - i (- off 1)] - (while (and (> i 0) (continuation? (at b i))) - (set i (- i 1))) - (if (< i 0) 0 i))) + size 0] + (if (<= off 0) + 0 + (do (rl/get-codepoint-previous b off (addr size)) + (if (< (- off size) 0) 0 (- off size)))))) (defvar font rl/Font) ;; Whether the TTF was there, asked once. A `defvar` and not the call itself @@ -220,10 +222,8 @@ (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. + ;; because it is what exercises the codepoint walk, which is now symmetric + ;; here the way it is in the C — a raylib call in each direction. (cond (rl/key-pressed? :right) (set cursor (step-forward cursor)) (rl/key-pressed? :left) (set cursor (step-back cursor))) diff --git a/examples/textures-image-processing.flan b/examples/textures-image-processing.flan index b42af9b..67ee9f5 100644 --- a/examples/textures-image-processing.flan +++ b/examples/textures-image-processing.flan @@ -51,11 +51,14 @@ ;;;; and because the picture is a demonstration of the filter rather than the ;;;; point of the program. ;;;; -;;;; One gap, written up in docs/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. +;;;; One gap, written up in docs/PORTING.md and since closed: LoadImageColors +;;;; answers a (Ptr Color) and UpdateTexture used to take only a (Ptr u8), +;;;; because the header spells its parameter `const void *` and the importer +;;;; had to render that as something. `reload-texture` below spelled the cast +;;;; by hand — the address of the first field of the first pixel, which is the +;;;; same address said at length. It does not any more: the header check +;;;; accepts a pointer to anything where the header says `void *`, so the +;;;; package binds the call twice and the caller names the type it has. (import rl "vendor:raylib") @@ -138,19 +141,23 @@ ;; 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 docs/PORTING.md. +;; corpus that exercises it. +;; +;; The awkward step in it is gone. LoadImageColors answers a (Ptr Color) and +;; UpdateTexture's parameter is `const void *`, which the importer has to +;; render as *something* and renders as (Ptr u8) — so the call used to be +;; written `(addr (.r (at (slice-from-ptr pixels n) 0)))`: the address of the +;; red channel of pixel zero, which is the address of the buffer said the long +;; way round. A `void *` is opaque about what it points at by construction, +;; and the header check now knows that, so the package can offer the same C +;; function under the element type the caller actually has. +;; update-texture-colors is that binding and this is its only caller. (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)))) + (let [pixels (rl/load-image-colors im-copy)] + (rl/update-texture-colors texture pixels) (rl/unload-image-colors pixels))) (defn main [] () diff --git a/test/programs/raylib-codepoints.flan b/test/programs/raylib-codepoints.flan index f9919b9..6211b16 100644 --- a/test/programs/raylib-codepoints.flan +++ b/test/programs/raylib-codepoints.flan @@ -18,12 +18,16 @@ ;;;; ;;;; **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. +;;;; two sequences are compared. That is what pins `step-back`, which is +;;;; GetCodepointPrevious — a function that reads *backwards* out of the +;;;; pointer it is handed, and so the one raylib call a Flan `string` must +;;;; never reach, because a string crosses to C as a NUL-terminated copy and +;;;; the bytes in front of a copy are the allocator's. Handed a copy it +;;;; answers 0 with a size of 0, which is also its answer for malformed UTF-8; +;;;; step-back would then return its argument unchanged, the backward walk +;;;; would never reach offset 0, and the two sequences would stop being +;;;; reverses of each other. That is the shape of the wrong answer this row +;;;; exists to see. ;;;; ;;;; **3. The walk agrees with raylib.** The sequence the walk produces is ;;;; compared against the array LoadCodepoints returned, element for element. @@ -110,10 +114,11 @@ ;; 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. + ;; pressing RIGHT, and it is the offset at which there is nothing behind + ;; the cursor to read. GetCodepointPrevious reads *backwards* from the + ;; pointer it is handed, so asking it here would read whatever is in front + ;; of the text; the guard in step-back is what means it is not asked, and + ;; a guard nothing exercises is a guard nobody knows about. (show "back at start" (cp/step-back 0)) ;; Item 3: and the forward walk is what raylib said the text contains. diff --git a/textures-image-processing b/textures-image-processing new file mode 100755 index 0000000..9a8d549 Binary files /dev/null and b/textures-image-processing differ diff --git a/vendor/raylib/generated.flan b/vendor/raylib/generated.flan index 56ec50e..ed26d08 100644 --- a/vendor/raylib/generated.flan +++ b/vendor/raylib/generated.flan @@ -199,6 +199,7 @@ (declare-c image-draw-text [dst (Ptr Image) text string pos-x i32 pos-y i32 font-size i32 color Color] "ImageDrawText") (declare-c image-draw-text-ex [dst (Ptr Image) font Font text string position Vector2 font-size f32 spacing f32 tint Color] "ImageDrawTextEx") (declare-c load-texture-cubemap [image Image layout i32] Texture2D "LoadTextureCubemap") +(declare-c update-texture [texture Texture2D pixels (Ptr u8)] "UpdateTexture") (declare-c update-texture-rec [texture Texture2D rec Rectangle pixels (Ptr u8)] "UpdateTextureRec") (declare-c gen-texture-mipmaps [texture (Ptr Texture2D)] "GenTextureMipmaps") (declare-c set-texture-wrap [texture Texture2D wrap i32] "SetTextureWrap") diff --git a/vendor/raylib/raylib.flan b/vendor/raylib/raylib.flan index d121c4d..c4f1189 100644 --- a/vendor/raylib/raylib.flan +++ b/vendor/raylib/raylib.flan @@ -589,36 +589,41 @@ (declare-c unload-texture [texture Texture2D] "UnloadTexture") -;; Refilling a texture's pixels from a CPU-side buffer. +;; Refilling a texture's pixels from a Color buffer. ;; -;; Both of these are hand-written and both call UpdateTexture, which is the -;; whole of what a `void *` parameter is: raylib does not care what the buffer +;; UpdateTexture takes a `const void *` — raylib does not care what the buffer ;; is an array *of*, only that it is the right number of bytes in the format -;; the texture was made with. `cimport.ml` has to render that `void *` as -;; something and renders it `(Ptr u8)`, so the generated line could only ever -;; offer one of the two faces, and the one it picked is the wrong one for the -;; commonest caller: LoadImageColors answers `(Ptr Color)` and handing that -;; straight on is what the C does. +;; the texture was made with. The importer has to render that as *something* +;; and renders it `(Ptr u8)`, which is the generated `update-texture` above. ;; -;; So the package says both, under two names, and the header check now agrees -;; with both — a `void *` is opaque about its element type by construction, so -;; there is no disagreement there for it to report (lib/cimport.ml's -;; [ptr_agrees]). Before that arm existed the call site had to spell the cast -;; by hand as `(addr (.r (at (slice-from-ptr pixels n) 0)))` — the address of -;; the first field of the first element, which is the right address and reads -;; like an apology. +;; That face cannot be the only one, because the commonest source of pixels is +;; LoadImageColors and it answers a `(Ptr Color)`. It also cannot be replaced +;; by a `(Ptr Color)` one: `(.data im-copy)` is already a `(Ptr u8)` over the +;; same bytes and is the shorter route, and `(Ptr u8)` → `(Ptr Color)` is not +;; expressible while `(Ptr Color)` → `(Ptr u8)` is. So the byte face is the +;; declaration and the typed face is this. ;; -;; Neither one checks that the buffer is big enough, because neither can: the +;; A second `declare-c` was the obvious shape and lib/shim.ml refuses it, for a +;; reason that is right: a shim emits one C prototype per declaration, and two +;; prototypes for one symbol that disagree about a parameter type is a C file +;; that does not compile. Its message says what to write instead — "another +;; Flan name for it is a defn" — and this is that defn. docs/PORTING.md §A.2 +;; expected the header check to be the only thing in the way; it was not. +;; +;; `(addr (.r pixels))` is the whole of the conversion. `.` auto-derefs one +;; level and `r` is Color's first field, so this is the address the pointer +;; already held, said in the only way the language has of saying it. It used +;; to be written at the call site as +;; `(addr (.r (at (slice-from-ptr pixels n) 0)))`, which is the same address +;; with a slice built and indexed on the way past. Once, here, with a name on +;; it is better than once per caller. +;; +;; Neither call checks that the buffer is big enough, because neither can: the ;; length raylib wants is width * height * bytes-per-pixel of the *texture*, -;; and a pointer has no length. That is the same deal every raylib pointer +;; and a pointer has no length. That is the deal every raylib pointer ;; parameter offers. -(declare-c update-texture - [texture Texture2D pixels (Ptr u8)] - "UpdateTexture") - -(declare-c update-texture-colors - [texture Texture2D pixels (Ptr Color)] - "UpdateTexture") +(defn update-texture-colors [texture Texture2D pixels (Ptr Color)] () + (update-texture texture (addr (.r pixels)))) ;; How a texture is sampled when it is drawn at anything other than its own ;; size. The header says `int` on SetTextureFilter and means one of these six.