diff --git a/test/programs/raylib-ffi.flan b/test/programs/raylib-ffi.flan index ad0b719..f336fe7 100644 --- a/test/programs/raylib-ffi.flan +++ b/test/programs/raylib-ffi.flan @@ -1,12 +1,74 @@ (import rl "vendor:raylib") -;; No window: GetColor and the enums are pure, so this exercises the whole -;; boundary — struct out-pointer, keyword->enum, string ptr+len — headlessly. +;; The raylib boundary, headless. GetColor, the shapes texture and rectangle +;; intersection all need no window, so the whole crossing — a struct out of C +;; through an out-pointer, a struct into C through a pointer, a keyword +;; resolved against an enum — is exercised without a display. +;; +;; What is being checked is that a struct's FIELDS mean the same thing on both +;; sides. Note what does not check that: handing raylib a struct and reading it +;; back, because storing and returning is symmetric and a permuted layout +;; survives it unchanged. Every case below is asymmetric — raylib does +;; something to the fields that depends on which is which. + +(defn show-texture [t rl/Texture2D] + (print-i64 (i64 (.id t))) (newline) + (print-i64 (i64 (.width t))) (newline) + (print-i64 (i64 (.height t))) (newline) + (print-i64 (i64 (.mipmaps t))) (newline) + (print-i64 (i64 (.format t))) (newline)) + +(defn show-rect [r rl/Rectangle] + (print-f64 (f64 (.x r))) (newline) + (print-f64 (f64 (.y r))) (newline) + (print-f64 (f64 (.width r))) (newline) + (print-f64 (f64 (.height r))) (newline)) + (defn main [] i32 + (rl/set-trace-log-level :warning) + + ;; A Color is four bytes in RGBA order, so 0x11223344 is 17 34 51 68 and not + ;; the little-endian reading of the packed integer. An identity would pass a + ;; weaker test than this one. (let [c (rl/get-color 0x11223344)] (print-i64 (i64 (.r c))) (newline) (print-i64 (i64 (.g c))) (newline) (print-i64 (i64 (.b c))) (newline) - (print-i64 (i64 (.a c))) (newline) - (rl/set-trace-log-level :warning) - 0)) + (print-i64 (i64 (.a c))) (newline)) + + ;; Rectangle, pinned completely. The intersection of (0,0,10,4) and + ;; (6,1,10,10) is (6,1,4,3) — four different numbers, each derived from a + ;; different pair of fields, so swapping any two fields changes the answer. + (show-rect (rl/get-collision-rec (rl/Rectangle {:x 0.0 :y 0.0 :width 10.0 :height 4.0}) + (rl/Rectangle {:x 6.0 :y 1.0 :width 10.0 :height 10.0}))) + + ;; Texture2D, as far as a machine with no GPU can go. raylib keeps the + ;; shapes texture without touching GL, and substitutes a default when + ;; `texture.id`, `source.width` or `source.height` is zero — that guard is + ;; the only asymmetry a headless test gets. + (let [rect (rl/Rectangle {:x 3.5 :y 7.25 :width 11.5 :height 13.75})] + ;; (A) Valid, five distinct values: they come back, so the struct crosses + ;; intact in both directions and raylib stored it rather than defaulting. + (rl/set-shapes-texture (rl/Texture2D {:id 7 :width 13 :height 17 :mipmaps 2 :format 4}) rect) + (show-texture (rl/get-shapes-texture)) + (show-rect (rl/get-shapes-texture-rectangle)) + + ;; (B) id zero, everything else positive: the default 1 1 1 1 7 comes + ;; back. The 7 is the only distinct field in it, so this pins `format` as + ;; the last field, and the substitution happening at all pins `id` as the + ;; field the guard reads. + (rl/set-shapes-texture (rl/Texture2D {:id 0 :width 13 :height 17 :mipmaps 2 :format 4}) rect) + (show-texture (rl/get-shapes-texture)) + + ;; (C) width zero, id positive: still stored, because the guard does not + ;; look at the texture's width. Without this case, (B) would pass just as + ;; well with `id` and `width` swapped — the zero would land in the guarded + ;; slot either way. + ;; + ;; That is the limit of what is checkable here: nothing raylib computes + ;; without a GL context reads width, height or mipmaps, so their order + ;; among themselves is not pinned by this test. A swap there shows up as a + ;; visibly wrong sprite in the interactive run, and nowhere else. + (rl/set-shapes-texture (rl/Texture2D {:id 7 :width 0 :height 17 :mipmaps 2 :format 4}) rect) + (show-texture (rl/get-shapes-texture))) + 0) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index 3670c0c..7e2466e 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -142,14 +142,30 @@ let () = text code end; - (* The raylib FFI, headless. GetColor and the enums need no window, so the - whole boundary is exercised without a display: a struct returned through - an out-pointer, a keyword resolved against an enum, and a Flan string - crossing as ptr+len. 0x11223344 comes back as four separate bytes, which - is the check that matters — a Color is not the little-endian reading of - the packed integer, so an identity would pass a weaker test. *) + (* The raylib FFI, headless. GetColor, rectangle intersection and the + shapes texture need no window, so the whole boundary is exercised + without a display: a struct out of C through an out-pointer, a struct + into C through a pointer, a keyword resolved against an enum, and a + Flan string crossing as ptr+len. + + Every case is asymmetric, which is the point. 0x11223344 comes back as + four separate bytes, so a Color is not the little-endian reading of the + packed integer. The intersection of (0,0,10,4) and (6,1,10,10) is + (6,1,4,3), four numbers from four different pairs of fields, so no + permutation of Rectangle survives it. And the shapes texture is stored + or replaced by 1 1 1 1 7 depending on which field is zero, which pins + Texture2D's id and format. Handing raylib a struct and reading it back + would have passed with any of those permuted — storing and returning is + symmetric. What the last case cannot pin, because nothing raylib + computes without a GL context reads them, is width, height and mipmaps + against each other. *) if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then - outputs "raylib ffi, headless" "programs/raylib-ffi.flan" "17\n34\n51\n68\n" + outputs "raylib ffi, headless" "programs/raylib-ffi.flan" + "17\n34\n51\n68\n\ + 6\n1\n4\n3\n\ + 7\n13\n17\n2\n4\n3.5\n7.25\n11.5\n13.75\n\ + 1\n1\n1\n1\n7\n\ + 7\n0\n17\n2\n4\n" else print_endline "acceptance: skipping the raylib FFI case (no libraylib)"; diff --git a/vendor/raylib/raylib.flan b/vendor/raylib/raylib.flan index 0d6194d..9450c37 100644 --- a/vendor/raylib/raylib.flan +++ b/vendor/raylib/raylib.flan @@ -20,6 +20,12 @@ (defstruct Vector2 [x f32 y f32]) (defstruct Color [r u8 g u8 b u8 a u8]) +;; Texture2D is five 4-byte fields in a row, which is the layout most likely +;; to be silently wrong: permute two of them and every field still reads as a +;; plausible number. Rectangle is four floats in x/y/width/height order. +(defstruct Texture2D [id u32 width i32 height i32 mipmaps i32 format i32]) +(defstruct Rectangle [x f32 y f32 width f32 height f32]) + ;; KeyboardKey, the subset sand.flan uses. A keyword at a call site resolves ;; against these members at compile time and a typo is an error there. (defenum Key @@ -103,3 +109,57 @@ (defn draw-rectangle [x i32 y i32 width i32 height i32 color Color] (let [c color] (draw-rectangle-raw x y width height (addr c)))) + +;; ── Shapes texture ────────────────────────────────────────────────── +;; +;; raylib draws every shape from one atlas texture, and this pair sets and +;; reads it. It is bound here for a second reason: it is the only part of the +;; API that stores a Texture2D and a Rectangle and hands them back without +;; touching the GPU, so it is how the acceptance table checks both layouts +;; headlessly. Everything else that takes a texture needs a GL context. +;; +;; raylib substitutes a default ({1,1,1,1,7} / {0,0,1,1}) when the id or the +;; source's width or height is not positive, so a caller — and the test — +;; should keep clear of those values if it wants its own back. + +(declare set-shapes-texture-raw + [texture (Ptr Texture2D) source (Ptr Rectangle)] + "flan_rl_set_shapes_texture") + +(defn set-shapes-texture [texture Texture2D source Rectangle] + (let [t texture + r source] + (set-shapes-texture-raw (addr t) (addr r)))) + +(declare get-shapes-texture-raw [out (Ptr Texture2D)] "flan_rl_get_shapes_texture") + +(defn get-shapes-texture [] Texture2D + (let [t (Texture2D {})] + (get-shapes-texture-raw (addr t)) + t)) + +(declare get-shapes-texture-rectangle-raw + [out (Ptr Rectangle)] "flan_rl_get_shapes_texture_rectangle") + +(defn get-shapes-texture-rectangle [] Rectangle + (let [r (Rectangle {})] + (get-shapes-texture-rectangle-raw (addr r)) + r)) + +;; ── Shapes ────────────────────────────────────────────────────────── +;; +;; Rectangle intersection, which raylib computes from all four fields in +;; different ways. It is the one Rectangle call that needs no GPU, so it is +;; also how the acceptance table pins the layout: a store-and-return check is +;; symmetric and a permuted layout survives it untouched. + +(declare get-collision-rec-raw + [a (Ptr Rectangle) b (Ptr Rectangle) out (Ptr Rectangle)] + "flan_rl_get_collision_rec") + +(defn get-collision-rec [a Rectangle b Rectangle] Rectangle + (let [x a + y b + out (Rectangle {})] + (get-collision-rec-raw (addr x) (addr y) (addr out)) + out)) diff --git a/vendor/raylib/shim.c b/vendor/raylib/shim.c index 11db1a6..9b6ce88 100644 --- a/vendor/raylib/shim.c +++ b/vendor/raylib/shim.c @@ -19,6 +19,8 @@ typedef struct { float x, y; } Vector2; typedef struct { unsigned char r, g, b, a; } Color; +typedef struct { unsigned int id; int width, height, mipmaps, format; } Texture2D; +typedef struct { float x, y, width, height; } Rectangle; extern void InitWindow(int width, int height, const char *title); extern void CloseWindow(void); @@ -38,6 +40,10 @@ extern void EndDrawing(void); extern void DrawFPS(int x, int y); extern void ClearBackground(Color color); extern void DrawRectangle(int x, int y, int width, int height, Color color); +extern void SetShapesTexture(Texture2D texture, Rectangle source); +extern Texture2D GetShapesTexture(void); +extern Rectangle GetShapesTextureRectangle(void); +extern Rectangle GetCollisionRec(Rectangle a, Rectangle b); /* A Flan string arrives as ptr+len and is not NUL-terminated, so a C API that * wants a C string needs a copy. The window title is the only one, it is short @@ -81,3 +87,18 @@ void flan_rl_draw_rectangle(int x, int y, int width, int height, const Color *color) { DrawRectangle(x, y, width, height, *color); } + +void flan_rl_set_shapes_texture(const Texture2D *texture, const Rectangle *source) { + SetShapesTexture(*texture, *source); +} + +void flan_rl_get_shapes_texture(Texture2D *out) { *out = GetShapesTexture(); } + +void flan_rl_get_shapes_texture_rectangle(Rectangle *out) { + *out = GetShapesTextureRectangle(); +} + +void flan_rl_get_collision_rec(const Rectangle *a, const Rectangle *b, + Rectangle *out) { + *out = GetCollisionRec(*a, *b); +}