The mechanical half, ahead of the parser change that needs it. tools/unit-return.py
fills the empty slot with () and rewrites Unit as () wherever a type is spelled --
(Fn [i32] Unit), (Map i32 Unit), a return type written out.
Deciding whether a defn already had a return type is the whole difficulty, and
the script does it the way parse.ml did: is_type_form is transcribed rather than
improved, because being identical to the parser it replaces is what makes the
sweep meaning-preserving. It is re-runnable, so the lanes that branched before
this can have the same pass at merge:
python3 tools/unit-return.py .
python3 tools/unit-return.py --in-strings test/test_flan.ml test/test_acceptance.ml \
test/test_session.ml emacs/test-flan-dev.el emacs/test-flan-mode.el
python3 tools/unit-return.py --raw-ml lib/prelude.ml
python3 tools/unit-return.py --in-html web/index.html
-v logs every defn it saw and what it decided, which is how a sweep of 440 sites
gets reviewed at all. Embedded modes pool a file's type declarations across all
its fragments, because a snippet split across concatenation -- decls ^ "(defn f
[s [u8]] Cursor ...)" -- cannot see the names the other half declared; pooled
names count only in bare-symbol position, for the same reason the prelude's do.
A fragment that cuts off mid-form is skipped rather than guessed at. Five sites
in test_flan.ml still needed a hand, and they are in this commit.
Two things ride along because the sweep needs them: parse.ml reads a lone () as
the return type of a function with no body, which was not a shape the old
optional slot could produce; and the map refusals name () rather than Unit, since
that is now the spelling a caller wrote.
196 lines
8.4 KiB
Plaintext
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))))
|