flan/sand.flan

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