;;;; 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 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 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) (at 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)) some-point (rl/Vector2 {.x 15.0 .y 12}) 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?) (pause) (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) ;; The sheet itself, baked into the binary at compile time. This used to be ;; (rl/load-texture "brush.png") against a bare relative path, and that is the ;; one line that kept this program off the browser: a relative path has no ;; meaning on a target with no filesystem, so raylib would have opened nothing ;; and the cursor would have been missing with no way to say why. ;; ;; The path is resolved relative to *this file*, not to wherever flan was ;; invoked from, which is what lets test/programs/sand-headless.flan import ;; this file as a package from _build and still find the PNG. Nothing is read ;; at run time on either target, so there is one code path and not two. (defconst brush-png (embed "brush.png")) ;; A brush that does not load is not a crash and not silence: an Image that ;; failed to decode has a null buffer, LoadTextureFromImage 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. ;; ;; Note what this can no longer mean: the file is missing. A missing ;; brush.png is a compile error now, at the embed, which is the whole point of ;; embedding it. What is left is a decode that failed or an upload with no GL ;; context behind it. ;; ;; One decode serves both textures. The unflipped upload happens first, ;; because ImageFlipHorizontal rewrites the buffer in place and the second ;; upload has to see the changed pixels — if the two badges look the same, ;; either the flip did nothing or the order here was swapped. (defn load-brush [] (let [sheet (rl/load-image-from-memory ".png" brush-png)] (when (rl/image-valid? sheet) (set brush (rl/load-texture-from-image sheet)) (rl/image-flip-horizontal (addr sheet)) (set brush-mirrored (rl/load-texture-from-image sheet))) ;; An Image that failed to decode has a null buffer and unloading it is ;; still safe, so there is one unload and not two. (rl/unload-image sheet)) (set brush-ok (rl/texture-valid? brush)) (unless brush-ok (println "sand: brush.png would not decode — drawing the cursor is off")) (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 (at 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))) ;; ── Sound ────────────────────────────────────────────────────────── ;; ;; Nothing in this section can be in the acceptance table and the reason is ;; sharper than "it needs a GL context": a Sound is a buffer the miniaudio ;; mixer owns, so it does not exist until init-audio-device has found a ;; device, and a machine with no sound server gets a zeroed struct and a ;; warning. What CAN be asserted headlessly is the Wave the sound is made ;; from — test/programs/raylib-audio.flan does exactly that — so the split ;; here is real and not an excuse: the samples are checked, the playing is ;; only listened to. ;; ;; The tone is generated rather than loaded because a .wav in the repository ;; would be an asset to maintain for one plink, and because generating it is ;; what gives load-sound-from-wave and export-wave a call site that is not a ;; test. (defconst tone-rate 22050) (defconst tone-frames 4410) ; 0.2 s (defconst tone-path "/tmp/flan-sand-tone.wav") ;; Little-endian signed 16-bit PCM, two bytes per frame, written as bytes ;; because that is what a Wave's `data` is: the element width is `sample-size`, ;; a run-time number, and no Flan type says what the buffer holds. (defvar tone-pcm [8820 u8]) (defn write-sample [i i32 v i32] (set (at tone-pcm (* i 2)) (u8 (bit-and v 255))) (set (at tone-pcm (+ (* i 2) 1)) (u8 (bit-and (>> v 8) 255)))) ;; A square wave that decays to nothing over its length, which is the ;; cheapest thing that sounds like a plink rather than a click. `period` is ;; the half-period in frames, so a smaller one is a higher note. (defn build-tone [period i32] (dotimes [i tone-frames] (let [amp (/ (* 9000 (- tone-frames i)) tone-frames)] (write-sample i (if (= 0 (% (/ i period) 2)) amp (- 0 amp)))))) (defvar audio-ok bool) (defvar tone rl/Sound) (defvar tone-ok bool) (defvar music rl/Music) (defvar music-ok bool) (defvar music-on bool) (defn start-audio [] (rl/init-audio-device) (set audio-ok (rl/audio-device-ready?)) (unless audio-ok (println "sand: no audio device — the grains are silent")) (build-tone 40) (let [w (rl/Wave {.frame-count (u32 tone-frames) .sample-rate (u32 tone-rate) .sample-size 16 .channels 1 .data (addr (at tone-pcm 0))})] (when audio-ok (set tone (rl/load-sound-from-wave w)) (set tone-ok (rl/sound-valid? tone)) (rl/set-sound-volume tone 0.25) (rl/set-sound-pan tone 0.5) ;; The same samples out to a file and straight back in as a stream, so ;; the Music side has a call site without an asset in the repository. ;; A Sound is resident and a Music is decoded as it plays, which is the ;; whole difference, and update-music-stream in the loop below is the ;; visible consequence of it. (when (rl/export-wave w tone-path) (set music (rl/load-music-stream tone-path)) (set music-ok (rl/music-valid? music)) (when music-ok (set (.looping music) true) (rl/set-music-volume music 0.15) (rl/set-music-pitch music 0.5))))) (rl/set-master-volume 0.6)) (defn stop-audio [] (when music-ok (rl/unload-music-stream music)) (when tone-ok (rl/unload-sound tone)) (rl/close-audio-device)) ;; Every plink goes through here, so a silent build — no device, or a wave ;; that would not load — is one branch and not a guard at every call site. (defn plink [pitch f32] (when tone-ok (rl/set-sound-pitch tone pitch) (rl/play-sound tone))) (defn toggle-music [] (when music-ok (set music-on (not music-on)) (if music-on (rl/play-music-stream music) (rl/pause-music-stream music)))) ;; ── The scene, off-screen ─────────────────────────────────────────── ;; ;; The world is drawn into a render texture and the render texture is drawn to ;; the screen, which is what a post-process pass or a pixel-perfect upscale ;; would hang off. There is nothing to assert here either — LoadRenderTexture ;; makes a GL framebuffer object and answers an id of 0 with no context — so ;; the fallback below is not defensive padding, it is what keeps the program ;; honest when the framebuffer is not there. ;; ;; The source rectangle's height is NEGATIVE on purpose. raylib renders into a ;; framebuffer bottom-up, so drawing the result the right way up needs the ;; flip, and getting it wrong is a world that is upside down rather than an ;; error. (defvar scene rl/RenderTexture2D) (defvar scene-ok bool) (defn load-scene [] (set scene (rl/load-render-texture screen-width screen-height)) (set scene-ok (rl/render-texture-valid? scene)) (unless scene-ok (println "sand: no render texture — drawing straight to the screen"))) ;; ── The font ──────────────────────────────────────────────────────── ;; ;; get-font-default needs a window: the default font is loaded as part of ;; init-window and LoadFontDefault is not exported, which is the same fact ;; that makes the plain measure-text answer 0 headless. The Font family IS ;; assertable — test/programs/raylib-font.flan builds one by hand and has ;; raylib measure with it — so what is left here is the drawing, and the ;; drawing is looked at. (defvar hud-font rl/Font) (defvar hud-font-ok bool) (defn load-hud-font [] (set hud-font (rl/get-font-default)) (set hud-font-ok (rl/font-valid? hud-font))) ;; ── 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) ;; key-released? and mouse-button-pressed? were bound and called by nothing ;; at all, which is the same as not having bound them. They are the two ;; halves nothing else here uses: space cycles the colour when it comes back ;; UP, and the right button resets the view the instant it goes DOWN, so the ;; two edges are told apart by eye rather than only in the source. (when (rl/key-released? :space) (next-color) (plink 1.4)) (when (rl/mouse-button-pressed? :right) (reset-view) (plink 0.6)) (when (rl/mouse-button-pressed? :left) (plink 1.0)) (when (rl/key-pressed? :m) (toggle-music)) ;; The pad, when there is one. Pressed and released are separate events here ;; too, for the same reason. (when (rl/gamepad-available? 0) (when (rl/gamepad-button-pressed? 0 :right-face-down) (plink 1.2)) (when (rl/gamepad-button-released? 0 :right-face-down) (next-color)) (when (rl/gamepad-button-down? 0 :middle-right) (clear-grid))) (when (rl/mouse-button-down? :left) (paint)) (when (rl/mouse-button-released? :left) (next-color)) ;; Once a frame, every frame, or the stream runs dry and the music stops ;; without saying anything. This is the whole difference between a Music and ;; a Sound. (when music-on (rl/update-music-stream music)) (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 (at 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 space colour m music" ;; 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. ;; ;; The title is measured with the Font form instead, which takes a ;; float size and a spacing the integer form has no way to express — ;; and then drawn with the matching draw-text-ex, so the box and the ;; letters agree. That agreement is the check: measure with one and ;; draw with the other and the panel is visibly the wrong width. title-w (if hud-font-ok (i32 (.x (rl/measure-text-ex hud-font title 30.0 4.0))) (rl/measure-text title 30)) w (max title-w (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)) (if hud-font-ok (rl/draw-text-ex hud-font title (rl/Vector2 {.x (f32 x) .y (f32 y)}) 30.0 4.0 rl/white) (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 (at 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)))) ;; The selected index as a digit, drawn one codepoint at a time. There ;; is no string formatting in the language yet, so this is the only way ;; a number reaches the screen at all — and get-glyph-index is what says ;; whether the default font has the digit before it is asked for. (when hud-font-ok (let [cp (+ 48 current-color)] (when (> (rl/get-glyph-index hud-font cp) 0) (rl/draw-text-codepoint hud-font cp (rl/Vector2 {.x (f32 (- sw 24)) .y (f32 (- sh 96))}) 30.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))))) ;; ── Gamepads, touch and gestures ──────────────────────────────────── ;; ;; None of this can be asserted anywhere, and the reason is worth stating ;; rather than assuming. With no pad attached, gamepad-available? is false, ;; every button predicate is false and every axis reads 0.0 — which is exactly ;; what a wrapper with its two int arguments exchanged would report. Touch and ;; gestures are the same: they are fed by raylib's own event polling inside a ;; frame loop, so they answer nothing at all headless. A test would be ;; asserting that two zeroes are equal. ;; ;; So they are drawn, and the only check they get is that moving a stick moves ;; the marker. Every read-out below is asymmetric on purpose — the stick dot ;; is offset by x and y separately, and the trigger bars are different lengths ;; — so a crossed wrapper is visible rather than merely different. (defn draw-input-state [] (let [ox (f32 200.0) oy (f32 90.0) r (f32 34.0)] (when (rl/gamepad-available? 0) ;; The ring only appears when raylib says a pad is there, which is what ;; separates "centred stick" from "no pad" — both of which are a dot in ;; the middle otherwise. (rl/draw-circle-lines (i32 ox) (i32 oy) r (rl/get-color 0x6060A0FF)) (let [p (rl/Vector2 {.x (+ ox (* (rl/get-gamepad-axis-movement 0 :left-x) r)) .y (+ oy (* (rl/get-gamepad-axis-movement 0 :left-y) r))})] (rl/draw-circle-v p (f32 5.0) rl/white)) ;; The two triggers as bars of different lengths, so exchanging them is ;; visible. They rest at -1 and not at 0, which raylib does not ;; normalise and neither does this — hence the +1. (let [lt (+ (f32 1.0) (rl/get-gamepad-axis-movement 0 :left-trigger)) rt (+ (f32 1.0) (rl/get-gamepad-axis-movement 0 :right-trigger))] (rl/draw-rectangle-v (rl/Vector2 {.x (+ ox (f32 46.0)) .y (- oy (f32 12.0))}) (rl/Vector2 {.x (* lt (f32 30.0)) .y (f32 8.0)}) (rl/get-color 0x8080C0FF)) (rl/draw-rectangle-v (rl/Vector2 {.x (+ ox (f32 46.0)) .y (+ oy (f32 4.0))}) (rl/Vector2 {.x (* rt (f32 50.0)) .y (f32 8.0)}) (rl/get-color 0x8080C0FF))) ;; One pip per axis the pad reports, and one per face button that is ;; NOT up — gamepad-button-up? rather than -down? so the negative form ;; has a call site of its own. (dotimes [i (rl/get-gamepad-axis-count 0)] (rl/draw-pixel (+ (i32 ox) (* i 4)) (+ (i32 oy) 44) rl/white)) (unless (rl/gamepad-button-up? 0 :right-face-down) (rl/draw-circle (+ (i32 ox) 110) (i32 oy) (f32 6.0) rl/white)) ;; -1 when nothing is pressed, which is why this is an i32 and not a ;; GamepadButton: the answer is outside the enum. (when (>= (rl/get-gamepad-button-pressed) 0) (rl/draw-circle (+ (i32 ox) 130) (i32 oy) (f32 6.0) (rl/get-color 0xFFC000FF)))) ;; Touch. On a desktop the count is 0 but point 0 still follows the ;; mouse, so the ring below is what says a real touchscreen is there. (dotimes [i (rl/get-touch-point-count)] (rl/draw-circle-lines-v (rl/get-touch-position i) (f32 18.0) (rl/get-color 0xA0A0FFFF)) (rl/draw-pixel (rl/get-touch-x) (rl/get-touch-y) rl/white) (rl/draw-pixel-v (rl/Vector2 {.x (f32 (rl/get-touch-point-id i)) .y (f32 4.0)}) rl/white)) ;; And the gesture, if any: a bar as long as the hold has lasted, and the ;; drag vector drawn from the centre of the ring. (unless (= (rl/get-gesture-detected) :none) (rl/draw-rectangle (i32 ox) (+ (i32 oy) 54) (i32 (* (f32 60.0) (rl/get-gesture-hold-duration))) 8 rl/white) (when (rl/gesture-detected? :drag) (let [d (rl/get-gesture-drag-vector)] (rl/draw-line-v (rl/Vector2 {.x ox .y oy}) (rl/Vector2 {.x (+ ox (* (.x d) (f32 200.0))) .y (+ oy (* (.y d) (f32 200.0)))}) (rl/get-color 0xFFC000FF)))) (when (rl/gesture-detected? :pinch-in) (let [q (rl/get-gesture-pinch-vector)] (rl/draw-circle-v (rl/Vector2 {.x (+ ox (* (.x q) (f32 200.0))) .y (+ oy (* (.y q) (f32 200.0)))}) (f32 4.0) rl/white)))))) (defn draw-world [] ;; 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)) (defn game-draw [] ;; The world goes into the render texture first, if there is one. Note the ;; clear inside the texture mode: the framebuffer keeps last frame's pixels ;; otherwise, which looks like a trail and not like a bug. (when scene-ok (rl/begin-texture-mode scene) (rl/clear-background rl/black) (draw-world) (rl/end-texture-mode)) (rl/clear-background rl/black) ;; Then the texture, upside down on purpose: raylib renders into a ;; framebuffer bottom-up, so a negative source height is the correction and ;; not a trick. Without a framebuffer the world is drawn straight to the ;; screen and nothing else changes. (if scene-ok (rl/draw-texture-rec (.texture scene) (rl/Rectangle {.x 0.0 .y 0.0 .width (f32 screen-width) .height (f32 (- 0 screen-height))}) (rl/Vector2 {.x 0.0 .y 0.0}) rl/white) (draw-world)) ;; And everything after it is in screen pixels again. (draw-brush) (draw-hud) (draw-input-state) (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 same rule for the framebuffer and the default font, and a third one ;; for the mixer: the audio device is its own subsystem and does not come ;; with the window, so it is opened and closed on its own. (load-scene) (defer (rl/unload-render-texture scene)) (load-hud-font) (start-audio) (defer (stop-audio)) ;; Gestures are off until something asks for them. Everything, because the ;; read-out draws whichever one arrives, and because the parameter is a set ;; of flags rather than one member — see the note on the Gesture enum. (rl/set-gestures-enabled rl/gesture-all) ;; 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. (restart-case (do (agent/poll) (game-update)) (continue [] (do))) (rl/begin-drawing) (game-draw) (rl/end-drawing)))