Joseph Ferano
259cf3b3e2
The simulation was in a package of its own for one reason: importing raylib linked libraylib on every target, so the headless run could not name the package the interactive one needs. That reason is gone, and the split was never anything else — the physics is the same code either way. So sim.flan is back inside sand.flan, and test/programs/sand-headless.flan imports sand.flan itself: window, raylib bindings, dev agent and all. It builds for wasm32 anyway. Nothing it calls reaches raylib, so no shim is compiled, no -lraylib is passed, and the front-end's functions are never emitted; sand.flan's main is not exported, so the only main is the headless one. The hash is unchanged on both targets at both optimisation levels, which is the point — a refactor that moved the number would have moved the simulation. The new cases cover what made it possible rather than only the result: a package nothing calls into, native and wasm32; raylib reached both directly and through sand.flan and read once; and the three refusals — sand/main, one directory under two aliases, and two mains. test_session's package-qualification case moves to vendor/agent, which is now the package in the tree with a defn in it.
448 lines
22 KiB
Plaintext
448 lines
22 KiB
Plaintext
;;;; 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. Both halves are one file
|
|
;;;; now. The simulation lived in a package of its own for a while, not because
|
|
;;;; it wanted to but because importing raylib linked libraylib whatever main
|
|
;;;; did, and on wasm32 that link cannot succeed. The link follows what the
|
|
;;;; program reaches now, 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 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
|
|
(import agent "vendor:agent") ; the dev agent: redefinitions, installed below
|
|
|
|
;;;; ── 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 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))
|
|
|
|
;;;; ── 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.
|
|
|
|
;; The brush sprite: a 16x8 sheet of two 8x8 frames, the ring drawn while the
|
|
;; mouse is idle and the blob while it is painting. It is here because the
|
|
;; texture calls cannot be in the acceptance table at all — loading one needs a
|
|
;; GL context — so the only way they are exercised is by running this.
|
|
(defvar brush rl/Texture2D)
|
|
(defvar brush-ok bool)
|
|
|
|
;; The same sheet a second time, mirrored on the CPU before the GPU ever sees
|
|
;; it. That is what the Image family is for, and this is its only call site:
|
|
;; nothing headless can make a texture, so load-texture-from-image would
|
|
;; otherwise be bound and never called, which is the same as not bound.
|
|
(defvar brush-mirrored rl/Texture2D)
|
|
(defvar brush-mirrored-ok bool)
|
|
|
|
;; A missing file is not a crash and not silence: LoadTexture hands back a
|
|
;; texture with an id of 0, every draw with it is a no-op, and the program
|
|
;; looks like it has a drawing bug. So it is asked and said once, here.
|
|
(defn load-brush []
|
|
(set brush (rl/load-texture "brush.png"))
|
|
(set brush-ok (rl/texture-valid? brush))
|
|
(unless brush-ok
|
|
(print-line "sand: cannot load brush.png — drawing the cursor is off"))
|
|
;; The other route to a texture: the file into RAM, changed there, and only
|
|
;; then uploaded. An Image that failed to load has a null buffer and
|
|
;; unloading it is still safe, so there is one unload and not two.
|
|
(let [sheet (rl/load-image "brush.png")]
|
|
(when (rl/image-valid? sheet)
|
|
(rl/image-flip-horizontal (addr sheet))
|
|
(set brush-mirrored (rl/load-texture-from-image sheet)))
|
|
(rl/unload-image sheet))
|
|
(set brush-mirrored-ok (rl/texture-valid? brush-mirrored)))
|
|
|
|
;; Four draws, one per shape the call comes in, because none of them can be in
|
|
;; the acceptance table. The cursor picks one frame out of the sheet and so
|
|
;; needs a source rectangle; the three badges in the corner are the whole
|
|
;; sheet, at integer coordinates, at a Vector2 tinted with the current sand
|
|
;; colour, and scaled up — draw-texture, draw-texture-v and draw-texture-ex.
|
|
(defn draw-brush []
|
|
(when brush-ok
|
|
(let [m (rl/get-mouse-position)
|
|
frame (f32 (if (rl/mouse-button-down? :left) 8.0 0.0))]
|
|
(rl/draw-texture-rec brush
|
|
(rl/Rectangle {:x frame :y 0.0 :width 8.0 :height 8.0})
|
|
(rl/Vector2 {:x (- (.x m) 4.0) :y (- (.y m) 4.0)})
|
|
rl/white)
|
|
(rl/draw-texture brush 20 50 rl/white)
|
|
(rl/draw-texture-v brush (rl/Vector2 {:x 44.0 :y 50.0})
|
|
(rl/get-color (nth colors current-color)))
|
|
(rl/draw-texture-ex brush (rl/Vector2 {:x 72.0 :y 46.0}) 0.0 2.0 rl/white)))
|
|
;; The mirrored one beside them, scaled up so the flip is visible rather
|
|
;; than eight pixels wide. If the two badges look the same, either the flip
|
|
;; did nothing or the upload took the unedited buffer.
|
|
(when brush-mirrored-ok
|
|
(rl/draw-texture-ex brush-mirrored (rl/Vector2 {:x 110.0 :y 46.0})
|
|
0.0 2.0 rl/white)))
|
|
|
|
;; ── The view ────────────────────────────────────────────────────────
|
|
;;
|
|
;; begin-mode-2d and end-mode-2d were bound along with Camera2D and then
|
|
;; called by nothing at all, which is the same as not having bound them. They
|
|
;; are load-bearing here now: the grid is drawn through this camera, the arrow
|
|
;; keys pan it, comma and period zoom, and `paint` has to undo the transform
|
|
;; with get-screen-to-world-2d or the sand lands somewhere other than the
|
|
;; cursor. That last part is what makes this a check rather than decoration —
|
|
;; a camera plumbed in wrongly shows up as grains appearing in the wrong
|
|
;; place, at once, while zoomed.
|
|
(defvar view rl/Camera2D)
|
|
|
|
;; A fresh (Camera2D {}) has a zoom of 0, which is singular: both conversions
|
|
;; hand back NaN and nothing draws. 1.0 is the identity.
|
|
(defn reset-view []
|
|
(set view (rl/Camera2D {:offset (rl/Vector2 {:x 0.0 :y 0.0})
|
|
:target (rl/Vector2 {:x 0.0 :y 0.0})
|
|
:rotation 0.0
|
|
:zoom 1.0})))
|
|
|
|
(defn set-view [target-x f32 target-y f32 zoom f32]
|
|
(set view (rl/Camera2D {:offset (.offset view)
|
|
:target (rl/Vector2 {:x target-x :y target-y})
|
|
:rotation (.rotation view)
|
|
:zoom zoom})))
|
|
|
|
;; Panning is world units per second and zooming is a factor per second, so
|
|
;; neither changes with the frame rate. That is the whole of what
|
|
;; get-frame-time is for, and a loop that assumed it hit its target fps would
|
|
;; be a loop that moves differently on a slower machine.
|
|
(defn move-view []
|
|
(let [dt (rl/get-frame-time)
|
|
pan (* (f32 600.0) dt)
|
|
tx (.x (.target view))
|
|
ty (.y (.target view))
|
|
zoom (.zoom view)]
|
|
(when (rl/key-down? :left) (set tx (- tx pan)))
|
|
(when (rl/key-down? :right) (set tx (+ tx pan)))
|
|
(when (rl/key-down? :up) (set ty (- ty pan)))
|
|
(when (rl/key-down? :down) (set ty (+ ty pan)))
|
|
(when (rl/key-down? :comma) (set zoom (- zoom (* zoom dt))))
|
|
(when (rl/key-down? :period) (set zoom (+ zoom (* zoom dt))))
|
|
;; Clamped away from 0 for the reason above, and away from the far end
|
|
;; because a cell is 5 pixels and there is no point past a screenful of
|
|
;; one of them.
|
|
(set-view tx ty (min (f32 8.0) (max (f32 0.125) zoom)))
|
|
(when (rl/key-pressed? :zero) (reset-view))))
|
|
|
|
;; Locals are assignable places (spec-memory.md); parameters are not.
|
|
;;
|
|
;; The mouse is in screen pixels and the grid is in world cells, and with a
|
|
;; camera in the way those stopped being the same thing — so this is the one
|
|
;; place get-screen-to-world-2d is not a test case but a requirement.
|
|
(defn paint []
|
|
(let [m (rl/get-screen-to-world-2d (rl/get-mouse-position) view)
|
|
row (/ (i32 (.y m)) cell-size)
|
|
col (/ (i32 (.x m)) cell-size)]
|
|
(paint-at row col)))
|
|
|
|
;; 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))
|
|
(move-view)
|
|
(when (rl/mouse-button-down? :left) (paint))
|
|
(when (rl/mouse-button-released? :left) (next-color))
|
|
(step))
|
|
|
|
(defn draw-grid []
|
|
(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)))))))
|
|
|
|
;; Drawn inside the camera, in world units, so every one of these moves and
|
|
;; scales with the grid. That is the point: a shape binding that is subtly
|
|
;; wrong is easiest to see when it is supposed to sit exactly on the cursor
|
|
;; and does not.
|
|
(defn draw-world-cursor []
|
|
(let [p (rl/get-screen-to-world-2d (rl/get-mouse-position) view)
|
|
tint (rl/get-color (nth colors current-color))
|
|
x (.x p)
|
|
y (.y p)
|
|
r (f32 (* brush-size cell-size))]
|
|
;; The brush's actual reach, as a ring, plus a thinner circle outside it.
|
|
(rl/draw-ring p (* r (f32 0.9)) r (f32 0.0) (f32 360.0) 48 tint)
|
|
(rl/draw-circle-lines-v p (+ r (f32 6.0)) tint)
|
|
;; A crosshair: two thin lines and one thick one, which is three separate
|
|
;; raylib calls with three different shapes of argument.
|
|
(rl/draw-line-v (rl/Vector2 {:x (- x r) :y y})
|
|
(rl/Vector2 {:x (+ x r) :y y}) tint)
|
|
(rl/draw-line-v (rl/Vector2 {:x x :y (- y r)})
|
|
(rl/Vector2 {:x x :y (+ y r)}) tint)
|
|
(rl/draw-line-ex (rl/Vector2 {:x (- x (f32 4.0)) :y y})
|
|
(rl/Vector2 {:x (+ x (f32 4.0)) :y y}) (f32 3.0) rl/white)
|
|
;; The exact world point: a filled dot, and one pixel of white on top of
|
|
;; it. Both are the Vector2 forms, so they land where the ring's centre
|
|
;; is and not somewhere an integer cast put them.
|
|
(rl/draw-circle-v p (f32 5.0) tint)
|
|
(rl/draw-pixel-v p rl/white)
|
|
;; A pointer above the cursor. Counter-clockwise, because raylib culls the
|
|
;; other winding and draws nothing — which looks exactly like a broken
|
|
;; binding and is why the outline is drawn over it as a control.
|
|
(let [tip (rl/Vector2 {:x x :y (- y (+ r (f32 26.0)))})
|
|
left (rl/Vector2 {:x (- x (f32 12.0)) :y (- y (+ r (f32 6.0)))})
|
|
rght (rl/Vector2 {:x (+ x (f32 12.0)) :y (- y (+ r (f32 6.0)))})]
|
|
(rl/draw-triangle tip left rght tint)
|
|
(rl/draw-triangle-lines tip left rght rl/white))
|
|
;; And the world's own edge, so panning has something to pan against.
|
|
(rl/draw-rectangle-lines-ex
|
|
(rl/Rectangle {:x 0.0 :y 0.0
|
|
:width (f32 screen-width)
|
|
:height (f32 screen-height)})
|
|
(f32 2.0) (rl/get-color 0x303030FF))))
|
|
|
|
;; Drawn outside the camera, in screen pixels, so it stays put while the world
|
|
;; moves underneath it. Nothing here can be asserted — it needs a GL context —
|
|
;; so it is built to be *looked* at: every shape binding appears once, and each
|
|
;; one is asymmetric enough that a wrapper with its arguments crossed is
|
|
;; visible rather than merely different.
|
|
(defn draw-hud []
|
|
(let [title "SAND"
|
|
keys "arrows pan , . zoom 0 reset r clear"
|
|
;; measure-text is what sizes the panel, so the box fits the string
|
|
;; rather than a number somebody guessed. Headless it answers 0 for
|
|
;; everything, which is why it is not in the acceptance table.
|
|
w (max (rl/measure-text title 30) (rl/measure-text keys 20))
|
|
h 72
|
|
x 24
|
|
y (- (rl/get-screen-height) (+ h 24))
|
|
panel (rl/Rectangle {:x (f32 (- x 12)) :y (f32 (- y 12))
|
|
:width (f32 (+ w 24)) :height (f32 (+ h 24))})]
|
|
(rl/draw-rectangle-rounded panel (f32 0.2) 8 (rl/get-color 0x101018E0))
|
|
;; Both outline forms, one inside the other: the plain one has no
|
|
;; thickness in raylib 5.5 and the -ex one is where thickness went.
|
|
(rl/draw-rectangle-rounded-lines panel (f32 0.2) 8 (rl/get-color 0x404060FF))
|
|
(rl/draw-rectangle-rounded-lines-ex panel (f32 0.2) 8 (f32 2.0)
|
|
(rl/get-color 0x6060A0FF))
|
|
(rl/draw-text title x y 30 rl/white)
|
|
(rl/draw-text keys x (+ y 40) 20 (rl/get-color 0xA0A0B0FF))
|
|
|
|
;; The palette, along the bottom right. The selected colour is the one
|
|
;; with a ring round it, so `current-color` is readable off the screen.
|
|
(let [sw (- (rl/get-screen-width) 40)
|
|
sh (- (rl/get-screen-height) 40)]
|
|
(dotimes [i (len colors)]
|
|
(let [cx (- sw (* (- (len colors) (+ i 1)) 46))
|
|
c (rl/get-color (nth colors i))]
|
|
(rl/draw-circle cx sh (f32 16.0) c)
|
|
(when (= i current-color)
|
|
(rl/draw-circle-lines cx sh (f32 22.0) rl/white))))
|
|
|
|
;; A zoom read-out with no number in it, because there is no string
|
|
;; formatting yet: the bar's length is the zoom. draw-rectangle-rec,
|
|
;; draw-rectangle-v and draw-rectangle-lines are the three remaining
|
|
;; rectangle shapes, so all three are here rather than invented
|
|
;; elsewhere.
|
|
(let [bx (f32 (- sw 220))
|
|
by (f32 (- sh 60))
|
|
fill (* (f32 200.0) (min (f32 1.0) (/ (.zoom view) (f32 8.0))))]
|
|
(rl/draw-rectangle-rec (rl/Rectangle {:x bx :y by :width (f32 200.0)
|
|
:height (f32 10.0)})
|
|
(rl/get-color 0x202028FF))
|
|
(rl/draw-rectangle-v (rl/Vector2 {:x bx :y by})
|
|
(rl/Vector2 {:x fill :y (f32 10.0)})
|
|
(rl/get-color 0x6060A0FF))
|
|
(rl/draw-rectangle-lines (- sw 220) (- sh 60) 200 10
|
|
(rl/get-color 0x8080C0FF))
|
|
;; The tick at the identity zoom, and a single pixel marking its left
|
|
;; end — the integer forms of the line and pixel calls.
|
|
(rl/draw-line (+ (- sw 220) 25) (- sh 66) (+ (- sw 220) 25) (- sh 46)
|
|
rl/white)
|
|
(rl/draw-pixel (- sw 220) (- sh 66) rl/white))
|
|
|
|
;; An ellipse, deliberately wider than it is tall so that exchanging its
|
|
;; two radii would be obvious, and a ring whose sweep is driven by
|
|
;; get-time so that something on screen proves the clock is running.
|
|
(let [ex (- sw 320)
|
|
ey (- sh 20)
|
|
spin (f32 (* 60.0 (rl/get-time)))]
|
|
(rl/draw-ellipse ex ey (f32 26.0) (f32 12.0) (rl/get-color 0x303040FF))
|
|
(rl/draw-ellipse-lines ex ey (f32 26.0) (f32 12.0)
|
|
(rl/get-color 0x8080C0FF))
|
|
(rl/draw-ring-lines (rl/Vector2 {:x (f32 ex) :y (f32 ey)})
|
|
(f32 30.0) (f32 34.0) spin (+ spin (f32 270.0)) 32
|
|
rl/white)))))
|
|
|
|
(defn game-draw []
|
|
(rl/clear-background rl/black)
|
|
;; Everything between these two is in world space and moves with the camera.
|
|
(rl/begin-mode-2d view)
|
|
(draw-grid)
|
|
(draw-world-cursor)
|
|
(rl/end-mode-2d)
|
|
;; And everything after it is in screen pixels again.
|
|
(draw-brush)
|
|
(draw-hud)
|
|
(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)
|
|
;; Before anything draws: a zero zoom is singular and nothing would appear.
|
|
(reset-view)
|
|
;; After the window, never before: LoadTexture uploads to the GPU and there
|
|
;; is no GPU to upload to until InitWindow has made a context.
|
|
(load-brush)
|
|
(defer (rl/unload-texture brush))
|
|
(defer (rl/unload-texture brush-mirrored))
|
|
;; 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:
|
|
;; nothing that could be redefined is on the stack here.
|
|
(agent/poll)
|
|
(game-update)
|
|
(rl/begin-drawing)
|
|
(game-draw)
|
|
(rl/end-drawing)))
|