;;;; 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. ;;;; ;;;; 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 (defconst screen-width 1400) (defconst screen-height 1000) (defconst cell-size 5) (defconst gravity 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]]) (defvar current-color u32) (defn clear-grid [] (set grid (zeroed)) (set velocity (zeroed))) (defn empty-at? [row i32 col i32] bool (= 0 (at grid row col))) ;; Locals are assignable places (spec-memory.md); parameters are not. (defn paint [] (let [m (rl/get-mouse-position) row (/ (i32 (.y m)) cell-size) col (/ (i32 (.x m)) cell-size) 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))) ;; 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)) (when (rl/key-down? :space) (paint)) (when (rl/key-released? :space) (set current-color (% (+ current-color 1) (len colors)))) ;; Bottom-up, so a grain settles at most once per frame. (let [row (- rows 2)] (while (>= row 0) (dotimes [col cols] (unless (empty-at? row col) (settle row col))) (set row (- row 1))))) (defn game-draw [] (rl/clear-background rl/black) (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)))))) (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) ;; 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?) (game-update) (rl/begin-drawing) (game-draw) (rl/end-drawing)))