flan/examples/core-input-virtual-controls.flan
Joseph Ferano 9a820d86cd Sweep every field label from the colon spelling to the dot
The script is in tools/ rather than thrown away, because two lanes are
writing Flan in the old spelling right now and their files need the same
pass at merge.

It works on forms, not on text: a keyword becomes a dot only where it sits
in a field-label position inside a brace, so an enum member in value
position, a map key inside an EDN string and a type-position {K V} are all
left alone. :keys keeps its colon -- it names no field.
2026-09-12 14:47:54 +07:00

196 lines
8.4 KiB
Plaintext

;;;; raylib [core] example - input virtual controls
;;;;
;;;; examples/core/core_input_virtual_controls.c. No new bindings.
;;;;
;;;; Split the way sand.flan is split: everything above the second banner is
;;;; arithmetic with no raylib calls in it, so test/programs/virtual-controls-
;;;; headless.flan can import this file as a package, drive the pointer over a
;;;; scripted path and hash where the player ended up. That is the only one of
;;;; the ten examples with a headless half, and it has one because it is the
;;;; only one whose interesting part — which D-pad button is under the pointer,
;;;; and what that does to the player — is a function of numbers rather than of
;;;; a frame buffer. The link follows what the program reaches, so the headless
;;;; driver pulls in neither a window nor libraylib.
;;;;
;;;; Two language notes, both visible below.
;;;;
;;;; **No `break`.** The C's nearest-button search is
;;;;
;;;; for (i = 0; i < BUTTON_MAX; i++) { if (...) { pressedButton = i; break; } }
;;;;
;;;; and `(break)` is refused: "break is not implemented yet (see the build
;;;; sequence in plan.org)". `return` from the function works and is what this
;;;; uses — which is why the search is its own `defn` and not written inline
;;;; the way the C has it. That is not a loss: the function is the thing the
;;;; headless case wants to call anyway. Where a loop genuinely cannot be a
;;;; function, the shape left is a flag and a compound loop condition.
;;;;
;;;; **No `fabsf`.** The prelude has sqrt-f32 and sign-f32 but no absolute
;;;; value for floats, and the comment there says why for integers. `(max v
;;;; (- 0.0 v))` is it, and unlike the integer case it has no edge: there is no
;;;; float whose negation is itself except -0.0, whose absolute value is 0.0
;;;; either way.
;;;;
;;;; The button geometry is `defconst` arrays of struct literals. That works —
;;;; and it is the only way a fixed array can be made inside anything but a
;;;; top-level `defvar`, since a `let` binding takes no type annotation.
(import rl "vendor:raylib")
(defconst screen-width 800)
(defconst screen-height 450)
;; The C's PadButton enum. -1 is BUTTON_NONE and the four directions are 0..3,
;; in the order the arrays below are written. A `defenum` would not help: the
;; value is used as an index and an enum does not convert to an integer
;; ("i32 converts a number, found ..."), so it would have to be turned back
;; into one at every use.
(defconst button-none -1)
(defconst button-up 0)
(defconst button-left 1)
(defconst button-right 2)
(defconst button-down 3)
(defconst button-max 4)
(defconst button-radius f32 30.0)
;; padPosition is {100, 350} and the buttons sit a radius and a half away from
;; it on each axis. The C computes these at run time from padPosition; they are
;; written out here because a defconst is compile-time and the numbers are.
(defconst button-positions [button-max rl/Vector2]
[(rl/Vector2 {.x 100.0 .y 305.0}) ; up
(rl/Vector2 {.x 55.0 .y 350.0}) ; left
(rl/Vector2 {.x 145.0 .y 350.0}) ; right
(rl/Vector2 {.x 100.0 .y 395.0})]) ; down
(defconst player-speed f32 75.0)
;;;; ── The part with no raylib in it ──────────────────────────────────
(defvar player rl/Vector2)
(defn reset-player []
(set player (rl/Vector2 {.x (/ (f32 screen-width) 2.0)
.y (/ (f32 screen-height) 2.0)})))
(defn abs-f32 [v f32] f32
(max v (- 0.0 v)))
;; The C's search, with `return` where it had `break`. Manhattan distance and
;; not Euclidean — the C adds the two axis distances and compares against the
;; radius — so the hit area is a diamond, which is deliberate: it makes the
;; four buttons tile without overlapping.
(defn nearest-button [pos rl/Vector2] i32
(dotimes [i button-max]
(let [b (at button-positions i)
dist-x (abs-f32 (- (.x b) (.x pos)))
dist-y (abs-f32 (- (.y b) (.y pos)))]
(when (< (+ dist-x dist-y) button-radius)
(return i))))
button-none)
;; The C's switch on the pressed button. Nothing moves for button-none, which
;; is the `default: break`.
(defn move-player [button i32 dt f32]
(let [step (* player-speed dt)]
(cond
(= button button-up) (set (.y player) (- (.y player) step))
(= button button-left) (set (.x player) (- (.x player) step))
(= button button-right) (set (.x player) (+ (.x player) step))
(= button button-down) (set (.y player) (+ (.y player) step))
:else (do))))
;; FNV-1a over the player's two floats, so the headless driver has one number
;; to compare. The floats are read through their bit patterns rather than
;; rounded to integers: rounding would hide exactly the kind of drift — a
;; crossed x and y, a step applied twice — the case exists to catch.
(defconst fnv-offset u64 0xcbf29ce484222325)
(defconst fnv-prime u64 1099511628211)
(defn hash-f32 [h u64 v f32] u64
;; No float-to-bits cast in the language, so the value is scaled and
;; truncated instead. 1024 keeps three decimal places of a screen
;; coordinate, which is finer than any real difference between two correct
;; runs and coarser than the last bit of an f32 — so this is reproducible
;; across targets where a raw bit pattern would depend on the FPU.
(let [n (i64 (* v 1024.0))
g h]
(dotimes [b 8]
(set g (bit-xor g (u64 (bit-and (>> n (i64 (* b 8))) 255))))
(set g (* g fnv-prime)))
g))
(defn hash-player [] u64
(hash-f32 (hash-f32 fnv-offset (.x player)) (.y player)))
;;;; ── The raylib front-end ───────────────────────────────────────────
;; The arrowheads, one triangle of three points per button, in the winding
;; raylib wants — counter-clockwise, or it culls them and draws nothing. A
;; [4 [3 rl/Vector2]]: a fixed array of fixed arrays of a struct, which is the
;; deepest shape any of these ten examples asks for and which works.
(defconst arrow-tris [button-max [3 rl/Vector2]]
[[(rl/Vector2 {.x 100.0 .y 293.0})
(rl/Vector2 {.x 91.0 .y 314.0})
(rl/Vector2 {.x 109.0 .y 314.0})]
[(rl/Vector2 {.x 64.0 .y 341.0})
(rl/Vector2 {.x 43.0 .y 350.0})
(rl/Vector2 {.x 64.0 .y 359.0})]
[(rl/Vector2 {.x 157.0 .y 350.0})
(rl/Vector2 {.x 136.0 .y 341.0})
(rl/Vector2 {.x 136.0 .y 359.0})]
[(rl/Vector2 {.x 91.0 .y 386.0})
(rl/Vector2 {.x 100.0 .y 407.0})
(rl/Vector2 {.x 109.0 .y 386.0})]])
(defconst label-colors [button-max rl/Color]
[(rl/Color {.r 253 .g 249 .b 0 .a 255}) ; yellow, up
(rl/Color {.r 0 .g 121 .b 241 .a 255}) ; blue, left
(rl/Color {.r 230 .g 41 .b 55 .a 255}) ; red, right
(rl/Color {.r 0 .g 228 .b 48 .a 255})]) ; green, down
(defn main []
(rl/init-window screen-width screen-height
"raylib [core] example - input virtual controls")
(defer (rl/close-window))
(reset-player)
(rl/set-target-fps 60)
(until (rl/window-should-close?)
;; Update. Touch first, mouse as the desktop stand-in — and on the desktop
;; the left button has to be held, or the player would follow the cursor
;; wherever it went.
(let [touching (> (rl/get-touch-point-count) 0)
input (if touching
(rl/get-touch-position 0)
(rl/get-mouse-position))
pressed (if (or touching (rl/mouse-button-down? :left))
(nearest-button input)
button-none)]
(move-player pressed (rl/get-frame-time))
;; Draw
(rl/begin-drawing)
(rl/clear-background rl/raywhite)
(rl/draw-circle-v player 50.0 rl/maroon)
(dotimes [i button-max]
(rl/draw-circle-v (at button-positions i) button-radius
(if (= i pressed) rl/darkgray rl/black))
(let [t (at arrow-tris i)]
(rl/draw-triangle (at t 0) (at t 1) (at t 2)
(at label-colors i))))
(rl/draw-text "move the player with D-Pad buttons" 10 10 20 rl/darkgray)
;; Not in the C: which button the search picked, as a number, so the
;; headless case and the window agree about the same thing.
(rl/draw-text "button: " 10 34 20 rl/lightgray)
(rl/draw-text (string (i64->bytes (i64 pressed)))
(+ 10 (rl/measure-text "button: " 20)) 34 20
rl/lightgray)
(rl/end-drawing))))