123 lines
5.1 KiB
Plaintext
123 lines
5.1 KiB
Plaintext
;;;; The falling-sand simulation, with no raylib in it.
|
|
;;;;
|
|
;;;; It is a package of its own because milestone 4 asks for sand to be tested
|
|
;;;; twice — interactive at 120 fps, and headless over N frames with the grid
|
|
;;;; hashed (plan.org, Build sequence). The headless run is the one CI does on
|
|
;;;; wasm32, and a program that imports the raylib package links the raylib
|
|
;;;; shared library on *every* target, whatever its main does. So the headless
|
|
;;;; artifact cannot import raylib at all, and the only way to have both
|
|
;;;; without two copies of the simulation is for both to import this.
|
|
;;;;
|
|
;;;; The directory is the package (plan.org, Modules): sand.flan imports it as
|
|
;;;; sim/, test/programs/sand-headless.flan imports it as sim/ too.
|
|
|
|
(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))
|