flan/vendor/raylib/raylib.flan
Joseph Ferano 07d068d297 A struct that comes back unchanged proves nothing
Texture2D and Rectangle are the two structs the texture calls need, and they
are the ones whose layout can be silently wrong: five 4-byte fields in a row,
and four floats in a row, so a permutation still reads as plausible numbers
everywhere.

The obvious test — hand raylib a struct, read it back, compare — is worthless
here, and I only found that out by trying it. Storing and returning is
symmetric: swap two fields in the Flan defstruct and the round trip still
agrees with itself, because C writes and reads the same wrong slots. That test
passes whatever the layout is, which is the kind of test this project would
rather not have at all.

So the headless case uses the two things raylib computes from the fields
without a GPU. GetCollisionRec turns (0,0,10,4) and (6,1,10,10) into
(6,1,4,3), four different numbers each derived from a different pair of
fields, and no permutation of Rectangle survives it. SetShapesTexture keeps a
Texture2D without touching GL and substitutes 1 1 1 1 7 when the id is zero,
so a zero id pins the first field, the 7 pins the last, and a zero width
stored rather than substituted is what stops that pair from passing with id
and width swapped. Each of those was checked by permuting the defstruct and
watching the case fail.

What is left unpinned is width, height and mipmaps against each other; nothing
raylib does without a GL context reads them. That is stated in the program
rather than papered over, because the alternative is a case that looks like it
covers them.

set-shapes-texture, get-shapes-texture, get-shapes-texture-rectangle and
get-collision-rec are real bindings, not test scaffolding — they are bound
here because they are also the only pure consumers of these two structs.
2026-09-11 17:52:04 +07:00

166 lines
7.4 KiB
Plaintext

;;;; raylib, declared for Flan. The directory is the package (plan.org,
;;;; Modules), and (import rl "vendor:raylib") qualifies all of it as rl/…
;;;;
;;;; Nothing here names a raylib symbol. Every `declare` names a wrapper in
;;;; shim.c, and that is the whole design decision: raylib passes Color by
;;;; value and returns Vector2 by value, and how a small aggregate is passed
;;;; differs between x86-64, arm64 and wasm32. Written in C, clang classifies
;;;; each one correctly per target for free; written in emit.ml it would be
;;;; three calling conventions to reimplement and then maintain forever. This
;;;; is "one narrow host ABI, implemented twice" (plan.org, Targets), and it
;;;; is why the checker rejects an aggregate in a `declare` signature at all.
;;;;
;;;; So each struct that crosses does it through a pointer, and the `-raw`
;;;; declaration is wrapped by an ordinary Flan function just below it. The
;;;; `-raw` names are visible as rl/…-raw because there is no visibility rule
;;;; yet; they are not meant to be called.
;; Layouts are C's — no object headers anywhere — so these are exactly
;; raylib's structs and nothing marshals.
(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
[space 32 apostrophe 39 comma 44 minus 45 period 46 slash 47
zero 48 one 49 two 50 three 51 four 52
five 53 six 54 seven 55 eight 56 nine 57
a 65 b 66 c 67 d 68 e 69 f 70 g 71 h 72 i 73
j 74 k 75 l 76 m 77 n 78 o 79 p 80 q 81 r 82
s 83 t 84 u 85 v 86 w 87 x 88 y 89 z 90
escape 256 enter 257 tab 258 backspace 259
right 262 left 263 down 264 up 265])
(defenum MouseButton
[left 0 right 1 middle 2 side 3 extra 4 forward 5 back 6])
(defenum TraceLogLevel
[all 0 trace 1 debug 2 info 3 warning 4 error 5 fatal 6 none 7])
;; ── Window ──────────────────────────────────────────────────────────
(declare init-window [width i32 height i32 title string] "flan_rl_init_window")
(declare close-window [] "flan_rl_close_window")
(declare window-should-close? [] bool "flan_rl_window_should_close")
(declare set-target-fps [fps i32] "flan_rl_set_target_fps")
(declare set-trace-log-level [level TraceLogLevel] "flan_rl_set_trace_log_level")
;; ── Input ───────────────────────────────────────────────────────────
(declare key-pressed? [key Key] bool "flan_rl_is_key_pressed")
(declare key-down? [key Key] bool "flan_rl_is_key_down")
(declare key-released? [key Key] bool "flan_rl_is_key_released")
(declare mouse-button-pressed? [button MouseButton] bool
"flan_rl_is_mouse_button_pressed")
(declare mouse-button-down? [button MouseButton] bool
"flan_rl_is_mouse_button_down")
(declare mouse-button-released? [button MouseButton] bool
"flan_rl_is_mouse_button_released")
(declare get-mouse-position-raw [out (Ptr Vector2)] "flan_rl_get_mouse_position")
(defn get-mouse-position [] Vector2
(let [v (Vector2 {})]
(get-mouse-position-raw (addr v))
v))
;; ── Colours ─────────────────────────────────────────────────────────
;;
;; A Color is four bytes in RGBA order, so it is *not* the little-endian
;; reading of the packed 0xRRGGBBAA integer — that is why get-color is a real
;; call and not a reinterpretation.
(declare get-color-raw [hex u32 out (Ptr Color)] "flan_rl_get_color")
(defn get-color [hex u32] Color
(let [c (Color {})]
(get-color-raw hex (addr c))
c))
(defconst black (Color {:r 0 :g 0 :b 0 :a 255}))
(defconst white (Color {:r 255 :g 255 :b 255 :a 255}))
;; ── Drawing ─────────────────────────────────────────────────────────
(declare begin-drawing [] "flan_rl_begin_drawing")
(declare end-drawing [] "flan_rl_end_drawing")
(declare draw-fps [x i32 y i32] "flan_rl_draw_fps")
(declare clear-background-raw [color (Ptr Color)] "flan_rl_clear_background")
(defn clear-background [color Color]
;; The copy is not ceremony: a parameter is not an assignable place
;; (spec-memory.md), so there is no address to take without one.
(let [c color]
(clear-background-raw (addr c))))
(declare draw-rectangle-raw
[x i32 y i32 width i32 height i32 color (Ptr Color)]
"flan_rl_draw_rectangle")
(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))