flan/vendor/raylib/raylib.flan
Joseph Ferano 27172d260f Collision bindings, and what a headless FFI test cannot pin
Finishing the 2D lane's unfinished work: the collision family was written and
had no tests when the session ended. It is the best material a headless table
gets, since every one of these is pure and needs no GL context.

Two plausible tests in a row turned out to check nothing, and that is the part
worth keeping. A struct round trip is symmetric and passes for any field order -
the texture lane found that one. The second is subtler: no axis-aligned geometry
can pin Vector2's fields, because exchanging x and y is a reflection that is
applied on the way in and undone on the way out. Swapping the shim's own typedef
leaves every collision case passing. Distances never even see it.

What does pin Vector2 is the rotated camera, because a rotation is not
axis-aligned and does not commute with the reflection. That case is load-bearing
and the comment now says so, because the collision cases look like they cover
the same ground and do not.

What the new cases do pin is Rectangle, completely: swapping width and height
turns three of the four predicates the wrong way. Verified by doing it.

collision-lines answers (Option Vector2) rather than a bool and an
out-parameter, because raylib leaves the out-parameter untouched when the
segments do not meet and a caller who forgets reads whatever was there.
2026-09-11 19:01:32 +07:00

395 lines
16 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))
;; ── Camera2D ────────────────────────────────────────────────────────
;;
;; The 2D camera: everything drawn between begin-mode-2d and end-mode-2d is
;; transformed by it. `offset` is where the camera's target lands on screen —
;; half the window size is what centres it — `target` is the world point that
;; goes there, and rotation is in degrees.
;;
;; `zoom` of 0 makes the transform singular and both conversions below hand
;; back NaN rather than failing. raylib does not guard it and neither does
;; this; 1.0 is the identity and a fresh (Camera2D {}) is therefore NOT usable
;; as one — it has to be given a zoom.
(defstruct Camera2D [offset Vector2 target Vector2 rotation f32 zoom f32])
(declare begin-mode-2d-raw [camera (Ptr Camera2D)] "flan_rl_begin_mode_2d")
(defn begin-mode-2d [camera Camera2D]
(let [c camera]
(begin-mode-2d-raw (addr c))))
(declare end-mode-2d [] "flan_rl_end_mode_2d")
;; The two conversions are pure arithmetic over every field of the camera, so
;; unlike the rest of the camera they run with no window and no GL context.
;; That is what the acceptance table uses to pin Camera2D's layout, and — via
;; a rotated camera, which is the only call here that mixes x into y — it is
;; also the only thing that pins Vector2's two fields against each other.
(declare get-screen-to-world-2d-raw
[position (Ptr Vector2) camera (Ptr Camera2D) out (Ptr Vector2)]
"flan_rl_get_screen_to_world_2d")
(defn get-screen-to-world-2d [position Vector2 camera Camera2D] Vector2
(let [p position
c camera
out (Vector2 {})]
(get-screen-to-world-2d-raw (addr p) (addr c) (addr out))
out))
(declare get-world-to-screen-2d-raw
[position (Ptr Vector2) camera (Ptr Camera2D) out (Ptr Vector2)]
"flan_rl_get_world_to_screen_2d")
(defn get-world-to-screen-2d [position Vector2 camera Camera2D] Vector2
(let [p position
c camera
out (Vector2 {})]
(get-world-to-screen-2d-raw (addr p) (addr c) (addr out))
out))
;; ── 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))
;; ── Collision ───────────────────────────────────────────────────────
;;
;; All of these are pure geometry: no window, no GL context, no state. That
;; makes them the other half of what the acceptance table can assert, and the
;; only part of the 2D surface that is tested as thoroughly as it is bound.
;;
;; Each takes its aggregates through pointers for the usual reason, and each
;; wrapper copies its parameters into locals first — a parameter is not an
;; assignable place (spec-memory.md), so there is no address to take.
(declare collision-recs?-raw [a (Ptr Rectangle) b (Ptr Rectangle)] bool
"flan_rl_check_collision_recs")
(defn collision-recs? [a Rectangle b Rectangle] bool
(let [x a y b]
(collision-recs?-raw (addr x) (addr y))))
(declare collision-circles?-raw
[c1 (Ptr Vector2) r1 f32 c2 (Ptr Vector2) r2 f32] bool
"flan_rl_check_collision_circles")
(defn collision-circles? [c1 Vector2 r1 f32 c2 Vector2 r2 f32] bool
(let [a c1 b c2]
(collision-circles?-raw (addr a) r1 (addr b) r2)))
(declare collision-circle-rec?-raw
[center (Ptr Vector2) radius f32 rec (Ptr Rectangle)] bool
"flan_rl_check_collision_circle_rec")
(defn collision-circle-rec? [center Vector2 radius f32 rec Rectangle] bool
(let [c center r rec]
(collision-circle-rec?-raw (addr c) radius (addr r))))
(declare collision-circle-line?-raw
[center (Ptr Vector2) radius f32 p1 (Ptr Vector2) p2 (Ptr Vector2)] bool
"flan_rl_check_collision_circle_line")
(defn collision-circle-line? [center Vector2 radius f32
p1 Vector2 p2 Vector2] bool
(let [c center a p1 b p2]
(collision-circle-line?-raw (addr c) radius (addr a) (addr b))))
(declare collision-point-rec?-raw [point (Ptr Vector2) rec (Ptr Rectangle)] bool
"flan_rl_check_collision_point_rec")
(defn collision-point-rec? [point Vector2 rec Rectangle] bool
(let [p point r rec]
(collision-point-rec?-raw (addr p) (addr r))))
(declare collision-point-circle?-raw
[point (Ptr Vector2) center (Ptr Vector2) radius f32] bool
"flan_rl_check_collision_point_circle")
(defn collision-point-circle? [point Vector2 center Vector2 radius f32] bool
(let [p point c center]
(collision-point-circle?-raw (addr p) (addr c) radius)))
(declare collision-point-triangle?-raw
[point (Ptr Vector2) a (Ptr Vector2) b (Ptr Vector2) c (Ptr Vector2)] bool
"flan_rl_check_collision_point_triangle")
(defn collision-point-triangle? [point Vector2 a Vector2 b Vector2
c Vector2] bool
(let [p point x a y b z c]
(collision-point-triangle?-raw (addr p) (addr x) (addr y) (addr z))))
;; `threshold` is in pixels, and it is not optional in practice: raylib's test
;; is a distance comparison in floats, so a point exactly on the line fails at
;; a threshold of 0. 1 is the useful smallest value.
(declare collision-point-line?-raw
[point (Ptr Vector2) p1 (Ptr Vector2) p2 (Ptr Vector2) threshold i32] bool
"flan_rl_check_collision_point_line")
(defn collision-point-line? [point Vector2 p1 Vector2 p2 Vector2
threshold i32] bool
(let [p point a p1 b p2]
(collision-point-line?-raw (addr p) (addr a) (addr b) threshold)))
;; A slice crosses as ptr+len, which is exactly what raylib wants here, so
;; this is the one collision call that needs no per-element copying. The
;; polygon is not closed explicitly — raylib joins the last point to the
;; first.
(declare collision-point-poly?-raw [point (Ptr Vector2) points [Vector2]] bool
"flan_rl_check_collision_point_poly")
(defn collision-point-poly? [point Vector2 points [Vector2]] bool
(let [p point]
(collision-point-poly?-raw (addr p) points)))
;; The one that answers with more than yes or no: where the two segments meet.
;; None is "they do not", so the point cannot be read when there isn't one —
;; raylib's own signature leaves the out-parameter untouched in that case and
;; a caller that forgets reads whatever was there.
(declare collision-lines-raw
[a1 (Ptr Vector2) a2 (Ptr Vector2) b1 (Ptr Vector2) b2 (Ptr Vector2)
out (Ptr Vector2)] bool
"flan_rl_check_collision_lines")
(defn collision-lines [a1 Vector2 a2 Vector2 b1 Vector2 b2 Vector2]
(Option Vector2)
(let [p a1 q a2 r b1 s b2
out (Vector2 {})]
(if (collision-lines-raw (addr p) (addr q) (addr r) (addr s) (addr out))
(Some out)
None)))
;; ── Textures ────────────────────────────────────────────────────────
;;
;; Everything here needs a GL context, so a window has to be open first —
;; load-texture before init-window returns an id of 0 and raylib says so on
;; the log. texture-valid? is how that is noticed in the program rather than
;; only in the log; raylib 5.5 spells it IsTextureValid, and IsTextureReady,
;; which older code calls, does not exist in this version.
(declare load-texture-raw [path string out (Ptr Texture2D)] "flan_rl_load_texture")
(defn load-texture [path string] Texture2D
(let [t (Texture2D {})]
(load-texture-raw path (addr t))
t))
(declare texture-valid?-raw [texture (Ptr Texture2D)] bool "flan_rl_is_texture_valid")
(defn texture-valid? [texture Texture2D] bool
(let [t texture]
(texture-valid?-raw (addr t))))
(declare unload-texture-raw [texture (Ptr Texture2D)] "flan_rl_unload_texture")
(defn unload-texture [texture Texture2D]
(let [t texture]
(unload-texture-raw (addr t))))
(declare draw-texture-raw
[texture (Ptr Texture2D) x i32 y i32 tint (Ptr Color)]
"flan_rl_draw_texture")
(defn draw-texture [texture Texture2D x i32 y i32 tint Color]
(let [t texture
c tint]
(draw-texture-raw (addr t) x y (addr c))))
(declare draw-texture-v-raw
[texture (Ptr Texture2D) position (Ptr Vector2) tint (Ptr Color)]
"flan_rl_draw_texture_v")
(defn draw-texture-v [texture Texture2D position Vector2 tint Color]
(let [t texture
p position
c tint]
(draw-texture-v-raw (addr t) (addr p) (addr c))))
(declare draw-texture-ex-raw
[texture (Ptr Texture2D) position (Ptr Vector2) rotation f32 scale f32
tint (Ptr Color)]
"flan_rl_draw_texture_ex")
(defn draw-texture-ex [texture Texture2D position Vector2 rotation f32
scale f32 tint Color]
(let [t texture
p position
c tint]
(draw-texture-ex-raw (addr t) (addr p) rotation scale (addr c))))
;; A negative source width or height flips the sprite, which is how a sheet is
;; drawn facing the other way without a second image.
(declare draw-texture-rec-raw
[texture (Ptr Texture2D) source (Ptr Rectangle) position (Ptr Vector2)
tint (Ptr Color)]
"flan_rl_draw_texture_rec")
(defn draw-texture-rec [texture Texture2D source Rectangle position Vector2
tint Color]
(let [t texture
s source
p position
c tint]
(draw-texture-rec-raw (addr t) (addr s) (addr p) (addr c))))