Joseph Ferano
a90badbcd5
begin-mode-2d and end-mode-2d have been bound since Camera2D went in and called by nothing, which is the same as not having bound them. The grid now draws through a camera the arrow keys pan and comma and period zoom, and paint has to undo that transform with get-screen-to-world-2d — so a camera plumbed in wrongly is visible at once as grains landing somewhere other than the cursor, rather than as nothing at all. The shapes, the text and the timing come with it, and none of them can be asserted: every one needs a GL context, and measure-text needs init-window too — the default font is loaded there and nowhere else, so headless it answers 0 for every string. Measured against libraylib.so.550, not assumed, which is why it is absent from the acceptance table despite looking exactly like a call that belongs in it. So the HUD is built to be looked at instead: each shape binding appears once and each is asymmetric enough that crossed arguments show. The ellipse is wider than it is tall, the ring's sweep comes from get-time, the triangle has its counter-clockwise winding with an outline over it as a control, and the panel is sized by measure-text rather than by a guess. draw-rectangle-rounded-lines takes no thickness in raylib 5.5 — it moved to the -ex form, and both are here. The 5.1 header on this machine still shows the five-argument version; nm -D on the library is what settled it. Font loading stays unbound and says so: a Font carries a Texture2D, a Rectangle* and a GlyphInfo*, and a GlyphInfo carries an Image.
299 lines
15 KiB
Plaintext
299 lines
15 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. This file is the
|
|
;;;; interactive half; the simulation itself lives in sand-sim/ so the headless
|
|
;;;; half can have it without linking raylib. See sand-sim/sim.flan for why that
|
|
;;;; split exists, and test/programs/sand-headless.flan for the other driver.
|
|
;;;;
|
|
;;;; 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 sim "sand-sim") ; no collection prefix: relative to this file
|
|
(import agent "vendor:agent") ; the dev agent: redefinitions, installed below
|
|
|
|
;; 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)
|
|
|
|
;; 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")))
|
|
|
|
;; 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 sim/colors sim/current-color)))
|
|
(rl/draw-texture-ex brush (rl/Vector2 {:x 72.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)) sim/cell-size)
|
|
col (/ (i32 (.x m)) sim/cell-size)]
|
|
(sim/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) (sim/clear-grid))
|
|
(move-view)
|
|
(when (rl/mouse-button-down? :left) (paint))
|
|
(when (rl/mouse-button-released? :left) (sim/next-color))
|
|
(sim/step))
|
|
|
|
(defn draw-grid []
|
|
(dotimes [row sim/rows]
|
|
(dotimes [col sim/cols]
|
|
(let [c (at sim/grid row col)]
|
|
(unless (= 0 c)
|
|
(rl/draw-rectangle (i32 (* col sim/cell-size))
|
|
(i32 (* row sim/cell-size))
|
|
sim/cell-size sim/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 sim/colors sim/current-color))
|
|
x (.x p)
|
|
y (.y p)
|
|
r (f32 (* sim/brush-size sim/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, one pixel of it.
|
|
(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 sim/screen-width)
|
|
:height (f32 sim/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 sim/colors)]
|
|
(let [cx (- sw (* (- (len sim/colors) (+ i 1)) 46))
|
|
c (rl/get-color (nth sim/colors i))]
|
|
(rl/draw-circle cx sh (f32 16.0) c)
|
|
(when (= i sim/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 sim/screen-width sim/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))
|
|
;; 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)))
|