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

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