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))))
|