;;;; Falling sand — Flan port of the Odin/Janet/Lisp/jank versions in ~/Development/fnm. ;;;; ;;;; THE SECOND ACCEPTANCE PROGRAM — build sequence milestone 4. calc-me.flan ;;;; comes first: sand cannot run at all until raylib FFI, keyword->enum ;;;; coercion and a window exist, and none of those should be on the critical ;;;; path to "the language runs something". ;;;; ;;;; It is tested twice: headless (N frames, hash the grid — the version CI runs ;;;; on native and wasm32) and interactive at 120 fps. Both halves are one file ;;;; now. The simulation lived in a package of its own for a while, not because ;;;; it wanted to but because importing raylib linked libraylib whatever main ;;;; did, and on wasm32 that link cannot succeed. The link follows what the ;;;; program reaches now, so test/programs/sand-headless.flan imports *this ;;;; file* as a package, calls the simulation directly, and pulls in neither a ;;;; window nor libraylib. The main below is not exported: an entry point is ;;;; not something a package offers. ;;;; ;;;; Note what it still deliberately does not use: no Vec, no Map, no generics, ;;;; no user-written macros, no conditions, no allocator other than the stack ;;;; and static storage. ;;;; ;;;; Notation reminders (see plan.org and spec-memory.md): ;;;; [n T] fixed array, length n, element T — a VALUE, copies ;;;; [T] slice, ptr+len, non-owning (Vec T) owning, move-only ;;;; (Ptr T) pointer (Handle T) generational handle ;;;; types are inline name/type pairs, as in `let` and `defstruct` ;;;; an omitted return type means Unit ;;;; lowercase in a TYPE position is a type variable; in a LENGTH position ;;;; it is an ordinary compile-time value, so [rows [cols u32]] is unambiguous (import rl "vendor:raylib") ; directory = package; declaration optional (import agent "vendor:agent") ; the dev agent: redefinitions, installed below ;;;; ── The simulation ─────────────────────────────────────────── ;;;; ;;;; No raylib between here and the next banner, which is what the headless ;;;; driver imports this file for. The hash is over exactly this. (defconst screen-width 1400) (defconst screen-height 1000) (defconst cell-size 5) ;; f32: velocity is [f32], and there is no implicit widening. (defconst gravity f32 0.05) (defconst rows (/ screen-height cell-size)) (defconst cols (/ screen-width cell-size)) (defconst brush-size 10) ;; Packed 0xRRGGBBAA. A cell of 0 means empty, so no Option and no tag word. (defconst colors [4 u32] [0xE6B800FF 0x3B6E8CFF 0xA83232FF 0xCC6B1FFF]) ;; Flat, unboxed, statically sized. No headers, so these are exactly ;; rows*cols*4 bytes each — the same memory the Odin port has. Fixed arrays are ;; values, so `(set grid (zeroed))` overwrites in place rather than reallocating. ;; No initialiser means all-bytes-zero (plan.org, zero values), so these are ;; BSS and cost nothing to start. `(zeroed)` below is the explicit spelling for ;; re-zeroing later — a memset, not an allocation. (defvar grid [rows [cols u32]]) (defvar velocity [rows [cols f32]]) ;; An index into colors, not a colour. (defvar current-color i32) (defn clear-grid [] (set grid (zeroed)) (set velocity (zeroed))) (defn empty-at? [row i32 col i32] bool (= 0 (at grid row col))) (defn next-color [] (set current-color (% (+ current-color 1) (len colors)))) ;; Drop a brush-sized cloud of grains centred on [row col]. This is what the ;; mouse drives interactively and what the headless run calls directly — the ;; only difference between the two is where the centre comes from. (defn paint-at [row i32 col i32] (let [half (/ brush-size 2)] (dotimes [x brush-size] (dotimes [y brush-size] (let [r (+ y (- row half)) c (+ x (- col half))] (when (and (>= r 0) (< r (- rows 1)) (>= c 0) (< c (- cols 1)) (empty-at? r c) (< (rand-f32) 0.5)) (set (at grid r c) (nth colors current-color)) (set (at velocity r c) 1.0))))))) (defn move-grain [from-row i32 from-col i32 to-row i32 to-col i32 vel f32] (set (at grid to-row to-col) (at grid from-row from-col)) (set (at grid from-row from-col) 0) (set (at velocity to-row to-col) vel) (set (at velocity from-row from-col) 0.0)) ;; Move the grain at [row col] as far down as it can, sliding to a free ;; diagonal neighbour when the cell below is taken. ;; ;; Imperative `while` with early `return`, not loop/recur — see plan.org ;; "Loop story". The recur version read as a tail call but was a countdown ;; over a mutable scan position, which is what a while loop is. (defn settle [row i32 col i32] (let [vel (+ gravity (at velocity row col)) y (min (- rows 1) (+ row (i32 vel)))] (while (> y row) (when (empty-at? y col) (move-grain row col y col vel) (return)) (let [left? (and (> col 0) (empty-at? y (- col 1))) right? (and (< col (- cols 1)) (empty-at? y (+ col 1)))] (when (or left? right?) (let [side (cond (not left?) 1 (not right?) -1 :else (if (< (rand-f32) 0.5) 1 -1))] (move-grain row col y (+ col side) vel) (return)))) (set y (- y 1))) ;; Nowhere to fall: reset the accumulated velocity and stay put. (set (at velocity row col) 0.0))) ;; One frame of physics. Bottom-up, so a grain settles at most once per frame. (defn step [] (let [row (- rows 2)] (while (>= row 0) (dotimes [col cols] (unless (empty-at? row col) (settle row col))) (set row (- row 1))))) ;; FNV-1a over the grid, so the headless run has one number to compare. It has ;; to be identical on native and wasm32, which is the whole reason rand-f32 is ;; a seeded PRNG written in Flan rather than libc's (plan.org, RNG is ours). ;; Named because a let binding takes no type annotation, and 0xcbf29ce484222325 ;; does not fit the i32 an unannotated integer literal would default to. (defconst fnv-offset u64 0xcbf29ce484222325) (defconst fnv-prime u64 1099511628211) (defn hash-grid [] u64 (let [h fnv-offset] (dotimes [row rows] (dotimes [col cols] (let [c (at grid row col)] (dotimes [b 4] (set h (bit-xor h (u64 (bit-and (>> c (u32 (* b 8))) 255)))) (set h (* h fnv-prime)))))) h)) ;;;; ── The raylib front-end ────────────────────────────────── ;;;; ;;;; Everything from here on needs a window, and nothing headless reaches any ;;;; of it — which is why importing this file costs a headless build nothing. ;; The brush sprite: a 16x8 sheet of two 8x8 frames, the ring drawn while the ;; mouse is idle and the blob while it is painting. It is here because the ;; texture calls cannot be in the acceptance table at all — loading one needs a ;; GL context — so the only way they are exercised is by running this. (defvar brush rl/Texture2D) (defvar brush-ok bool) ;; The same sheet a second time, mirrored on the CPU before the GPU ever sees ;; it. That is what the Image family is for, and this is its only call site: ;; nothing headless can make a texture, so load-texture-from-image would ;; otherwise be bound and never called, which is the same as not bound. (defvar brush-mirrored rl/Texture2D) (defvar brush-mirrored-ok bool) ;; A missing file is not a crash and not silence: LoadTexture hands back a ;; texture with an id of 0, every draw with it is a no-op, and the program ;; looks like it has a drawing bug. So it is asked and said once, here. (defn load-brush [] (set brush (rl/load-texture "brush.png")) (set brush-ok (rl/texture-valid? brush)) (unless brush-ok (print-line "sand: cannot load brush.png — drawing the cursor is off")) ;; The other route to a texture: the file into RAM, changed there, and only ;; then uploaded. An Image that failed to load has a null buffer and ;; unloading it is still safe, so there is one unload and not two. (let [sheet (rl/load-image "brush.png")] (when (rl/image-valid? sheet) (rl/image-flip-horizontal (addr sheet)) (set brush-mirrored (rl/load-texture-from-image sheet))) (rl/unload-image sheet)) (set brush-mirrored-ok (rl/texture-valid? brush-mirrored))) ;; Four draws, one per shape the call comes in, because none of them can be in ;; the acceptance table. The cursor picks one frame out of the sheet and so ;; needs a source rectangle; the three badges in the corner are the whole ;; sheet, at integer coordinates, at a Vector2 tinted with the current sand ;; colour, and scaled up — draw-texture, draw-texture-v and draw-texture-ex. (defn draw-brush [] (when brush-ok (let [m (rl/get-mouse-position) frame (f32 (if (rl/mouse-button-down? :left) 8.0 0.0))] (rl/draw-texture-rec brush (rl/Rectangle {:x frame :y 0.0 :width 8.0 :height 8.0}) (rl/Vector2 {:x (- (.x m) 4.0) :y (- (.y m) 4.0)}) rl/white) (rl/draw-texture brush 20 50 rl/white) (rl/draw-texture-v brush (rl/Vector2 {:x 44.0 :y 50.0}) (rl/get-color (nth colors current-color))) (rl/draw-texture-ex brush (rl/Vector2 {:x 72.0 :y 46.0}) 0.0 2.0 rl/white))) ;; The mirrored one beside them, scaled up so the flip is visible rather ;; than eight pixels wide. If the two badges look the same, either the flip ;; did nothing or the upload took the unedited buffer. (when brush-mirrored-ok (rl/draw-texture-ex brush-mirrored (rl/Vector2 {:x 110.0 :y 46.0}) 0.0 2.0 rl/white))) ;; ── The view ──────────────────────────────────────────────────────── ;; ;; begin-mode-2d and end-mode-2d were bound along with Camera2D and then ;; called by nothing at all, which is the same as not having bound them. They ;; are load-bearing here now: the grid is drawn through this camera, the arrow ;; keys pan it, comma and period zoom, and `paint` has to undo the transform ;; with get-screen-to-world-2d or the sand lands somewhere other than the ;; cursor. That last part is what makes this a check rather than decoration — ;; a camera plumbed in wrongly shows up as grains appearing in the wrong ;; place, at once, while zoomed. (defvar view rl/Camera2D) ;; A fresh (Camera2D {}) has a zoom of 0, which is singular: both conversions ;; hand back NaN and nothing draws. 1.0 is the identity. (defn reset-view [] (set view (rl/Camera2D {:offset (rl/Vector2 {:x 0.0 :y 0.0}) :target (rl/Vector2 {:x 0.0 :y 0.0}) :rotation 0.0 :zoom 1.0}))) (defn set-view [target-x f32 target-y f32 zoom f32] (set view (rl/Camera2D {:offset (.offset view) :target (rl/Vector2 {:x target-x :y target-y}) :rotation (.rotation view) :zoom zoom}))) ;; Panning is world units per second and zooming is a factor per second, so ;; neither changes with the frame rate. That is the whole of what ;; get-frame-time is for, and a loop that assumed it hit its target fps would ;; be a loop that moves differently on a slower machine. (defn move-view [] (let [dt (rl/get-frame-time) pan (* (f32 600.0) dt) tx (.x (.target view)) ty (.y (.target view)) zoom (.zoom view)] (when (rl/key-down? :left) (set tx (- tx pan))) (when (rl/key-down? :right) (set tx (+ tx pan))) (when (rl/key-down? :up) (set ty (- ty pan))) (when (rl/key-down? :down) (set ty (+ ty pan))) (when (rl/key-down? :comma) (set zoom (- zoom (* zoom dt)))) (when (rl/key-down? :period) (set zoom (+ zoom (* zoom dt)))) ;; Clamped away from 0 for the reason above, and away from the far end ;; because a cell is 5 pixels and there is no point past a screenful of ;; one of them. (set-view tx ty (min (f32 8.0) (max (f32 0.125) zoom))) (when (rl/key-pressed? :zero) (reset-view)))) ;; Locals are assignable places (spec-memory.md); parameters are not. ;; ;; The mouse is in screen pixels and the grid is in world cells, and with a ;; camera in the way those stopped being the same thing — so this is the one ;; place get-screen-to-world-2d is not a test case but a requirement. (defn paint [] (let [m (rl/get-screen-to-world-2d (rl/get-mouse-position) view) row (/ (i32 (.y m)) cell-size) col (/ (i32 (.x m)) cell-size)] (paint-at row col))) ;; Every cross-function call in a dev build routes through an indirection cell, ;; so redefining this from the REPL reaches the running loop on the next frame. ;; No `varfn` (Janet), no `let update = ref` (OCaml), no var-routing (jank). ;; Release builds compile the same source to direct calls. ;; ;; A cell holds an (Fn ...) — a plain function pointer, no captured environment; ;; this one is (Fn [] Unit), `settle`'s is (Fn [i32 i32] Unit). Redefining ;; `settle` while `game-update` is mid-frame is safe ;; because old code is never unloaded; changing its SIGNATURE is not, and the ;; reload rejects it. See plan.org "What redefinition cannot do". (defn game-update [] (when (rl/key-pressed? :r) (clear-grid)) (move-view) (when (rl/mouse-button-down? :left) (paint)) (when (rl/mouse-button-released? :left) (next-color)) (step)) (defn draw-grid [] (dotimes [row rows] (dotimes [col cols] (let [c (at grid row col)] (unless (= 0 c) (rl/draw-rectangle (i32 (* col cell-size)) (i32 (* row cell-size)) cell-size cell-size (rl/get-color c))))))) ;; Drawn inside the camera, in world units, so every one of these moves and ;; scales with the grid. That is the point: a shape binding that is subtly ;; wrong is easiest to see when it is supposed to sit exactly on the cursor ;; and does not. (defn draw-world-cursor [] (let [p (rl/get-screen-to-world-2d (rl/get-mouse-position) view) tint (rl/get-color (nth colors current-color)) x (.x p) y (.y p) r (f32 (* brush-size cell-size))] ;; The brush's actual reach, as a ring, plus a thinner circle outside it. (rl/draw-ring p (* r (f32 0.9)) r (f32 0.0) (f32 360.0) 48 tint) (rl/draw-circle-lines-v p (+ r (f32 6.0)) tint) ;; A crosshair: two thin lines and one thick one, which is three separate ;; raylib calls with three different shapes of argument. (rl/draw-line-v (rl/Vector2 {:x (- x r) :y y}) (rl/Vector2 {:x (+ x r) :y y}) tint) (rl/draw-line-v (rl/Vector2 {:x x :y (- y r)}) (rl/Vector2 {:x x :y (+ y r)}) tint) (rl/draw-line-ex (rl/Vector2 {:x (- x (f32 4.0)) :y y}) (rl/Vector2 {:x (+ x (f32 4.0)) :y y}) (f32 3.0) rl/white) ;; The exact world point: a filled dot, and one pixel of white on top of ;; it. Both are the Vector2 forms, so they land where the ring's centre ;; is and not somewhere an integer cast put them. (rl/draw-circle-v p (f32 5.0) tint) (rl/draw-pixel-v p rl/white) ;; A pointer above the cursor. Counter-clockwise, because raylib culls the ;; other winding and draws nothing — which looks exactly like a broken ;; binding and is why the outline is drawn over it as a control. (let [tip (rl/Vector2 {:x x :y (- y (+ r (f32 26.0)))}) left (rl/Vector2 {:x (- x (f32 12.0)) :y (- y (+ r (f32 6.0)))}) rght (rl/Vector2 {:x (+ x (f32 12.0)) :y (- y (+ r (f32 6.0)))})] (rl/draw-triangle tip left rght tint) (rl/draw-triangle-lines tip left rght rl/white)) ;; And the world's own edge, so panning has something to pan against. (rl/draw-rectangle-lines-ex (rl/Rectangle {:x 0.0 :y 0.0 :width (f32 screen-width) :height (f32 screen-height)}) (f32 2.0) (rl/get-color 0x303030FF)))) ;; Drawn outside the camera, in screen pixels, so it stays put while the world ;; moves underneath it. Nothing here can be asserted — it needs a GL context — ;; so it is built to be *looked* at: every shape binding appears once, and each ;; one is asymmetric enough that a wrapper with its arguments crossed is ;; visible rather than merely different. (defn draw-hud [] (let [title "SAND" keys "arrows pan , . zoom 0 reset r clear" ;; measure-text is what sizes the panel, so the box fits the string ;; rather than a number somebody guessed. Headless it answers 0 for ;; everything, which is why it is not in the acceptance table. w (max (rl/measure-text title 30) (rl/measure-text keys 20)) h 72 x 24 y (- (rl/get-screen-height) (+ h 24)) panel (rl/Rectangle {:x (f32 (- x 12)) :y (f32 (- y 12)) :width (f32 (+ w 24)) :height (f32 (+ h 24))})] (rl/draw-rectangle-rounded panel (f32 0.2) 8 (rl/get-color 0x101018E0)) ;; Both outline forms, one inside the other: the plain one has no ;; thickness in raylib 5.5 and the -ex one is where thickness went. (rl/draw-rectangle-rounded-lines panel (f32 0.2) 8 (rl/get-color 0x404060FF)) (rl/draw-rectangle-rounded-lines-ex panel (f32 0.2) 8 (f32 2.0) (rl/get-color 0x6060A0FF)) (rl/draw-text title x y 30 rl/white) (rl/draw-text keys x (+ y 40) 20 (rl/get-color 0xA0A0B0FF)) ;; The palette, along the bottom right. The selected colour is the one ;; with a ring round it, so `current-color` is readable off the screen. (let [sw (- (rl/get-screen-width) 40) sh (- (rl/get-screen-height) 40)] (dotimes [i (len colors)] (let [cx (- sw (* (- (len colors) (+ i 1)) 46)) c (rl/get-color (nth colors i))] (rl/draw-circle cx sh (f32 16.0) c) (when (= i current-color) (rl/draw-circle-lines cx sh (f32 22.0) rl/white)))) ;; A zoom read-out with no number in it, because there is no string ;; formatting yet: the bar's length is the zoom. draw-rectangle-rec, ;; draw-rectangle-v and draw-rectangle-lines are the three remaining ;; rectangle shapes, so all three are here rather than invented ;; elsewhere. (let [bx (f32 (- sw 220)) by (f32 (- sh 60)) fill (* (f32 200.0) (min (f32 1.0) (/ (.zoom view) (f32 8.0))))] (rl/draw-rectangle-rec (rl/Rectangle {:x bx :y by :width (f32 200.0) :height (f32 10.0)}) (rl/get-color 0x202028FF)) (rl/draw-rectangle-v (rl/Vector2 {:x bx :y by}) (rl/Vector2 {:x fill :y (f32 10.0)}) (rl/get-color 0x6060A0FF)) (rl/draw-rectangle-lines (- sw 220) (- sh 60) 200 10 (rl/get-color 0x8080C0FF)) ;; The tick at the identity zoom, and a single pixel marking its left ;; end — the integer forms of the line and pixel calls. (rl/draw-line (+ (- sw 220) 25) (- sh 66) (+ (- sw 220) 25) (- sh 46) rl/white) (rl/draw-pixel (- sw 220) (- sh 66) rl/white)) ;; An ellipse, deliberately wider than it is tall so that exchanging its ;; two radii would be obvious, and a ring whose sweep is driven by ;; get-time so that something on screen proves the clock is running. (let [ex (- sw 320) ey (- sh 20) spin (f32 (* 60.0 (rl/get-time)))] (rl/draw-ellipse ex ey (f32 26.0) (f32 12.0) (rl/get-color 0x303040FF)) (rl/draw-ellipse-lines ex ey (f32 26.0) (f32 12.0) (rl/get-color 0x8080C0FF)) (rl/draw-ring-lines (rl/Vector2 {:x (f32 ex) :y (f32 ey)}) (f32 30.0) (f32 34.0) spin (+ spin (f32 270.0)) 32 rl/white))))) (defn game-draw [] (rl/clear-background rl/black) ;; Everything between these two is in world space and moves with the camera. (rl/begin-mode-2d view) (draw-grid) (draw-world-cursor) (rl/end-mode-2d) ;; And everything after it is in screen pixels again. (draw-brush) (draw-hud) (rl/draw-fps 20 20)) (defn main [] (rl/set-trace-log-level :warning) (rl/init-window screen-width screen-height "SAND") (defer (rl/close-window)) (rl/set-target-fps 120) ;; Before anything draws: a zero zoom is singular and nothing would appear. (reset-view) ;; After the window, never before: LoadTexture uploads to the GPU and there ;; is no GPU to upload to until InitWindow has made a context. (load-brush) (defer (rl/unload-texture brush)) (defer (rl/unload-texture brush-mirrored)) ;; The dev agent listens on a socket for redefinitions and hands them over; ;; (agent/poll) below is where they are installed. Building without --dev is ;; fine — nothing has cells to install into, so a module is refused on the ;; listener thread and the loop never notices. (agent/start "/tmp/flan-sand.sock") ;; Bare (defn main []) — argv and the i32 status are both optional. ;; Nothing in this loop allocates, so context/temp is never even touched. (until (rl/window-should-close?) ;; The frame boundary, and the only place a redefinition becomes visible: ;; nothing that could be redefined is on the stack here. (agent/poll) (game-update) (rl/begin-drawing) (game-draw) (rl/end-drawing)))