Joseph Ferano
7f9017bb3e
That commit is about C-M-x and touches three files; the third is a snapshot of an editing session caught mid-thought: (defvar frame Allocator (arena-new 262144)) (defvar game-data (embed (with-allocator frame ))) The second does not check — embed takes a path, and there is no path there — so the acceptance corpus fails to build and `dune test` has been red at the tip on its own account. Removed rather than repaired, because what it was going to say is the author's to finish.
211 lines
9.5 KiB
Plaintext
211 lines
9.5 KiB
Plaintext
;;;; Falling sand — Flan port of the Odin/Janet/Lisp/jank versions in ~/Development/fnm.
|
|
;;;;
|
|
;;;; Kept at parity with lisp/sand.lisp, clojure/src/fnm/sand.clj and
|
|
;;;; src/fnm/sand.jank: the same constants, the same eight functions, and
|
|
;;;; nothing else. Anything a reference version does not have does not belong
|
|
;;;; here — this file is the acceptance program for the language, not a
|
|
;;;; showcase for raylib bindings.
|
|
;;;;
|
|
;;;; 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 link follows what the program reaches, 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 deliberately does not use: no Vec, no Map, no generics, no
|
|
;;;; macros of its own, no allocator other than the stack and static storage.
|
|
;;;; It does call rl/with-drawing, which is the raylib package's macro over
|
|
;;;; the BeginDrawing/EndDrawing pair — the parity rule is what the reference
|
|
;;;; versions do, and lisp/sand.lisp writes rl:with-drawing there.
|
|
;;;;
|
|
;;;; 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`
|
|
;;;; a return type of () means the function returns nothing
|
|
|
|
(import rl "vendor:raylib") ; directory = package; declaration optional
|
|
(import agent "vendor:agent") ; the dev agent: redefinitions, installed below
|
|
(import edn "vendor:edn")
|
|
|
|
;;;; ── 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 900)
|
|
(defconst screen-height 600)
|
|
(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] [0xFFF00FFF 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 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))
|
|
(= 0 (at grid r c))
|
|
(< (rand-f32) 0.5))
|
|
(set (at grid r c) (at colors current-color))
|
|
(set (at velocity r c) 1.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 (= 0 (at grid y col))
|
|
(set (at grid y col) (at grid row col))
|
|
(set (at grid row col) 0)
|
|
(set (at velocity y col) vel)
|
|
(set (at velocity row col) 0.0)
|
|
(return))
|
|
(let [left? (and (> col 0) (= 0 (at grid y (- col 1))))
|
|
right? (and (< col (- cols 1)) (= 0 (at grid y (+ col 1))))]
|
|
(when (or left? right?)
|
|
(let [side (cond
|
|
(not left?) 1
|
|
(not right?) -1
|
|
:else (if (< (rand-f32) 0.5) 1 -1))]
|
|
(set (at grid y (+ col side)) (at grid row col))
|
|
(set (at grid row col) 0)
|
|
(set (at velocity y (+ col side)) vel)
|
|
(set (at velocity row col) 0.0)
|
|
(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 (= 0 (at grid 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.
|
|
|
|
;; 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 [] ()), `settle`'s is (Fn [i32 i32] ()). 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/mouse-button-down? :left)
|
|
(let [m (rl/get-mouse-position)]
|
|
(paint-at (/ (i32 (.y m)) cell-size)
|
|
(/ (i32 (.x m)) cell-size))))
|
|
(when (rl/mouse-button-released? :left) (next-color))
|
|
(step))
|
|
|
|
;; (defconst the-data (Vec u8) (slurp "game-data.edn"))
|
|
|
|
(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)
|
|
;; 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.
|
|
;; An error while installing/evaluating a dev form, or during the update,
|
|
;; leaves one CL-style escape hatch: choose `continue' in the editor to
|
|
;; abandon this frame and return to the next one with the game still live.
|
|
;; Keep drawing outside it. Skipping between BeginDrawing and EndDrawing
|
|
;; would leave raylib's frame unbalanced, and rl/with-drawing does not
|
|
;; change that — it guarantees the two calls stay together and stay
|
|
;; matched, not that a transfer out of the body reaches the second one.
|
|
;; The restart being out here is still what makes `continue' safe.
|
|
(restart-case
|
|
(do (agent/poll)
|
|
(game-update))
|
|
(continue [] (do)))
|
|
(rl/with-drawing
|
|
(game-draw))))
|