Joseph Ferano
26c53e0a19
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.
292 lines
16 KiB
Plaintext
292 lines
16 KiB
Plaintext
(import rl "vendor:raylib")
|
|
|
|
;; The raylib boundary, headless. GetColor, the shapes texture and rectangle
|
|
;; intersection all need no window, so the whole crossing — a struct out of C
|
|
;; through an out-pointer, a struct into C through a pointer, a keyword
|
|
;; resolved against an enum — is exercised without a display.
|
|
;;
|
|
;; What is being checked is that a struct's FIELDS mean the same thing on both
|
|
;; sides. Note what does not check that: handing raylib a struct and reading it
|
|
;; back, because storing and returning is symmetric and a permuted layout
|
|
;; survives it unchanged. Every case below is asymmetric — raylib does
|
|
;; something to the fields that depends on which is which.
|
|
|
|
(defn show-texture [t rl/Texture2D] ()
|
|
(print (.id t)) (println "")
|
|
(print (.width t)) (println "")
|
|
(print (.height t)) (println "")
|
|
(print (.mipmaps t)) (println "")
|
|
(print (.format t)) (println ""))
|
|
|
|
(defn show-rect [r rl/Rectangle] ()
|
|
(print (.x r)) (println "")
|
|
(print (.y r)) (println "")
|
|
(print (.width r)) (println "")
|
|
(print (.height r)) (println ""))
|
|
|
|
;; ── Camera2D ────────────────────────────────────────────────────────
|
|
;;
|
|
;; The two conversions are pure arithmetic and need no window, which makes
|
|
;; them the strongest headless material in the package: each one reads every
|
|
;; field of a Camera2D and every field of two Vector2s.
|
|
;;
|
|
;; They are asserted in both directions separately and never as a round trip.
|
|
;; world->screen->world is the store-and-return trap wearing a different hat:
|
|
;; the inverse cancels a permuted layout exactly, so it passes for any order.
|
|
;;
|
|
;; The camera below is chosen so that no field is silently unpinned — offset
|
|
;; and target differ, zoom is 2.0 and not the identity 1.0, and every
|
|
;; component is a distinct dyadic value that prints exactly.
|
|
(defconst cam (rl/Camera2D {.offset (rl/Vector2 {.x 100.0 .y 50.0})
|
|
.target (rl/Vector2 {.x 8.0 .y 4.0})
|
|
.rotation 0.0
|
|
.zoom 2.0}))
|
|
|
|
;; Absolute values, not a round trip: screen (140,90) is world (28,24) because
|
|
;; ((140-100)/2)+8 = 28 and ((90-50)/2)+4 = 24. Swap offset and target in the
|
|
;; defstruct and this reads (143,-16); swap rotation and zoom and the zoom
|
|
;; becomes 0, the transform is singular, and both come back NaN.
|
|
(defn show-bool [name string b bool] ()
|
|
(print name) (print " ")
|
|
(println (if b "yes" "no")))
|
|
|
|
(defn show-v [v rl/Vector2] ()
|
|
(print (.x v)) (println "")
|
|
(print (.y v)) (println ""))
|
|
|
|
;; What no geometric call can pin on its own is Vector2's own two fields:
|
|
;; exchange x and y everywhere and every component-wise formula is simply
|
|
;; mirrored, so the answer comes back mirrored too and compares equal. A
|
|
;; *rotated* camera is the exception — it mixes x into y — so the case below
|
|
;; is the one thing in this file that fixes which float is which.
|
|
;;
|
|
;; It cannot be compared as text: 90 degrees goes through sinf and cosf and
|
|
;; the answer is 27.9999981, not 28, and the table compares stdout byte for
|
|
;; byte at -O0 and -O2. So the comparison happens here, with a tolerance, and
|
|
;; what is printed is the verdict. A wrong-but-close value passing is not a
|
|
;; risk worth naming: a permuted layout is out by whole units. Swapping x and
|
|
;; y in Vector2 makes this print "rotated bad" — the same camera then reads
|
|
;; back as (-12,24).
|
|
(defn near? [a f32 b f32] bool
|
|
(let [d (- a b)]
|
|
(< (if (< d 0.0) (- 0.0 d) d) 0.0001)))
|
|
|
|
(defn show-near [name string v rl/Vector2 x f32 y f32] ()
|
|
(print name)
|
|
(println (if (and (near? (.x v) x) (near? (.y v) y)) " ok" " bad")))
|
|
|
|
(defn main [] i32
|
|
(rl/set-trace-log-level :warning)
|
|
|
|
;; A Color is four bytes in RGBA order, so 0x11223344 is 17 34 51 68 and not
|
|
;; the little-endian reading of the packed integer. An identity would pass a
|
|
;; weaker test than this one.
|
|
(let [c (rl/get-color 0x11223344)]
|
|
(print (.r c)) (println "")
|
|
(print (.g c)) (println "")
|
|
(print (.b c)) (println "")
|
|
(print (.a c)) (println ""))
|
|
|
|
;; Rectangle, pinned completely. The intersection of (0,0,10,4) and
|
|
;; (6,1,10,10) is (6,1,4,3) — four different numbers, each derived from a
|
|
;; different pair of fields, so swapping any two fields changes the answer.
|
|
(show-rect (rl/get-collision-rec (rl/Rectangle {.x 0.0 .y 0.0 .width 10.0 .height 4.0})
|
|
(rl/Rectangle {.x 6.0 .y 1.0 .width 10.0 .height 10.0})))
|
|
|
|
;; Texture2D, as far as a machine with no GPU can go. raylib keeps the
|
|
;; shapes texture without touching GL, and substitutes a default when
|
|
;; `texture.id`, `source.width` or `source.height` is zero — that guard is
|
|
;; the only asymmetry a headless test gets.
|
|
(let [rect (rl/Rectangle {.x 3.5 .y 7.25 .width 11.5 .height 13.75})]
|
|
;; (A) Valid, five distinct values: they come back, so the struct crosses
|
|
;; intact in both directions and raylib stored it rather than defaulting.
|
|
(rl/set-shapes-texture (rl/Texture2D {.id 7 .width 13 .height 17 .mipmaps 2 .format 4}) rect)
|
|
(show-texture (rl/get-shapes-texture))
|
|
(show-rect (rl/get-shapes-texture-rectangle))
|
|
|
|
;; (B) id zero, everything else positive: the default 1 1 1 1 7 comes
|
|
;; back. The 7 is the only distinct field in it, so this pins `format` as
|
|
;; the last field, and the substitution happening at all pins `id` as the
|
|
;; field the guard reads.
|
|
(rl/set-shapes-texture (rl/Texture2D {.id 0 .width 13 .height 17 .mipmaps 2 .format 4}) rect)
|
|
(show-texture (rl/get-shapes-texture))
|
|
|
|
;; (C) width zero, id positive: still stored, because the guard does not
|
|
;; look at the texture's width. Without this case, (B) would pass just as
|
|
;; well with `id` and `width` swapped — the zero would land in the guarded
|
|
;; slot either way.
|
|
;;
|
|
;; That is the limit of what is checkable here: nothing raylib computes
|
|
;; without a GL context reads width, height or mipmaps, so their order
|
|
;; among themselves is not pinned by this test. A swap there shows up as a
|
|
;; visibly wrong sprite in the interactive run, and nowhere else.
|
|
(rl/set-shapes-texture (rl/Texture2D {.id 7 .width 0 .height 17 .mipmaps 2 .format 4}) rect)
|
|
(show-texture (rl/get-shapes-texture)))
|
|
|
|
;; Camera2D, each direction on its own. See the note above show-v for why
|
|
;; this is not a round trip.
|
|
(show-v (rl/get-screen-to-world-2d (rl/Vector2 {.x 140.0 .y 90.0}) cam))
|
|
(show-v (rl/get-world-to-screen-2d (rl/Vector2 {.x 28.0 .y 24.0}) cam))
|
|
|
|
;; And the rotated camera, which is what pins Vector2's own two fields.
|
|
(let [spun (rl/Camera2D {.offset (rl/Vector2 {.x 100.0 .y 50.0})
|
|
.target (rl/Vector2 {.x 8.0 .y 4.0})
|
|
.rotation 90.0
|
|
.zoom 2.0})]
|
|
(show-near "rotated screen-to-world"
|
|
(rl/get-screen-to-world-2d (rl/Vector2 {.x 140.0 .y 90.0}) spun)
|
|
28.0 -16.0)
|
|
(show-near "rotated world-to-screen"
|
|
(rl/get-world-to-screen-2d (rl/Vector2 {.x 28.0 .y 24.0}) spun)
|
|
60.0 90.0))
|
|
|
|
;; ── Collision, which is the best material a headless test gets ──────
|
|
;;
|
|
;; Every one of these is pure: raylib computes an answer out of the fields,
|
|
;; so a wrong field order gives a wrong answer rather than the same struct
|
|
;; back. Each case below is paired with one that must come out the other
|
|
;; way, because a predicate that always said yes would pass a single case.
|
|
(let [r (rl/Rectangle {.x 0.0 .y 0.0 .width 10.0 .height 4.0})]
|
|
;; Inside on both axes, then outside on y only. Swap width and height and
|
|
;; both of these flip, which is what makes the pair worth more than either.
|
|
(show-bool "point in rect" (rl/collision-point-rec? (rl/Vector2 {.x 5.0 .y 3.0}) r))
|
|
(show-bool "point below rect" (rl/collision-point-rec? (rl/Vector2 {.x 5.0 .y 5.0}) r))
|
|
;; Overlapping by one unit, then clear of it. Pins x against width.
|
|
(show-bool "rects overlap"
|
|
(rl/collision-recs? r (rl/Rectangle {.x 9.0 .y 1.0 .width 10.0 .height 10.0})))
|
|
(show-bool "rects apart"
|
|
(rl/collision-recs? r (rl/Rectangle {.x 11.0 .y 1.0 .width 10.0 .height 10.0}))))
|
|
|
|
;; Centres five apart with radii summing to six, then seven apart. The radius
|
|
;; is a scalar beside two Vector2s, so this pins it against their fields.
|
|
(show-bool "circles touch"
|
|
(rl/collision-circles? (rl/Vector2 {.x 0.0 .y 0.0}) 3.0
|
|
(rl/Vector2 {.x 5.0 .y 0.0}) 3.0))
|
|
(show-bool "circles clear"
|
|
(rl/collision-circles? (rl/Vector2 {.x 0.0 .y 0.0}) 3.0
|
|
(rl/Vector2 {.x 7.0 .y 0.0}) 3.0))
|
|
|
|
;; The one that answers with a number rather than a yes: a horizontal segment
|
|
;; at y = 7 crossed by a vertical one at x = 3, so the answer is (3 7).
|
|
;;
|
|
;; Asymmetric rather than the two diagonals of a square meeting at (5 5),
|
|
;; which would give the same answer however the fields were ordered — but be
|
|
;; clear about what that buys, because it is less than it looks.
|
|
;;
|
|
;; **Nothing in this section pins Vector2's own two fields, and nothing
|
|
;; axis-aligned can.** Exchanging x and y is a reflection: it is applied to
|
|
;; the inputs on the way in and undone on the way out, so the printed answer
|
|
;; is identical. Verified by actually swapping the shim's typedef — every
|
|
;; collision case here still passes. Distances are worse still, being
|
|
;; unchanged by the reflection in the first place.
|
|
;;
|
|
;; The rotated camera above is what pins them, and it works precisely because
|
|
;; a 90-degree rotation is not axis-aligned, so the reflection does not
|
|
;; commute with it. That case is load-bearing; do not delete it because the
|
|
;; collision ones look like they cover the same ground.
|
|
;;
|
|
;; What this section *does* pin is Rectangle, completely — swapping width and
|
|
;; height turns three of the four predicates below the wrong way.
|
|
(match (rl/collision-lines (rl/Vector2 {.x 0.0 .y 7.0}) (rl/Vector2 {.x 10.0 .y 7.0})
|
|
(rl/Vector2 {.x 3.0 .y 0.0}) (rl/Vector2 {.x 3.0 .y 10.0}))
|
|
(Some p) (show-v p)
|
|
None (println "no crossing"))
|
|
;; The rest of the collision family, each with the case that must come out
|
|
;; the other way. Bound and linking is not the same as working: a wrapper
|
|
;; whose arguments are in the wrong order links perfectly and answers
|
|
;; nonsense, and until something calls it nothing says so.
|
|
(let [r (rl/Rectangle {.x 0.0 .y 0.0 .width 10.0 .height 4.0})]
|
|
;; Circle against rect: just touching at the right edge, then clear of it.
|
|
(show-bool "circle meets rect"
|
|
(rl/collision-circle-rec? (rl/Vector2 {.x 12.0 .y 2.0}) 3.0 r))
|
|
(show-bool "circle clears rect"
|
|
(rl/collision-circle-rec? (rl/Vector2 {.x 14.0 .y 2.0}) 3.0 r)))
|
|
|
|
;; Circle against a segment, which is the one that pins the radius against
|
|
;; the two endpoints rather than against a single centre.
|
|
(show-bool "circle meets line"
|
|
(rl/collision-circle-line? (rl/Vector2 {.x 5.0 .y 2.0}) 3.0
|
|
(rl/Vector2 {.x 0.0 .y 0.0})
|
|
(rl/Vector2 {.x 10.0 .y 0.0})))
|
|
(show-bool "circle clears line"
|
|
(rl/collision-circle-line? (rl/Vector2 {.x 5.0 .y 4.0}) 3.0
|
|
(rl/Vector2 {.x 0.0 .y 0.0})
|
|
(rl/Vector2 {.x 10.0 .y 0.0})))
|
|
|
|
(show-bool "point in circle"
|
|
(rl/collision-point-circle? (rl/Vector2 {.x 2.0 .y 0.0})
|
|
(rl/Vector2 {.x 0.0 .y 0.0}) 3.0))
|
|
(show-bool "point outside circle"
|
|
(rl/collision-point-circle? (rl/Vector2 {.x 4.0 .y 0.0})
|
|
(rl/Vector2 {.x 0.0 .y 0.0}) 3.0))
|
|
|
|
;; A right triangle with the square corner at the origin. The inside point is
|
|
;; inside for one vertex order and not the other, so this is one of the few
|
|
;; here that notices which vertex is which.
|
|
(show-bool "point in triangle"
|
|
(rl/collision-point-triangle? (rl/Vector2 {.x 1.0 .y 1.0})
|
|
(rl/Vector2 {.x 0.0 .y 0.0})
|
|
(rl/Vector2 {.x 8.0 .y 0.0})
|
|
(rl/Vector2 {.x 0.0 .y 6.0})))
|
|
(show-bool "point outside triangle"
|
|
(rl/collision-point-triangle? (rl/Vector2 {.x 7.0 .y 5.0})
|
|
(rl/Vector2 {.x 0.0 .y 0.0})
|
|
(rl/Vector2 {.x 8.0 .y 0.0})
|
|
(rl/Vector2 {.x 0.0 .y 6.0})))
|
|
|
|
;; On the segment, then beside it. The threshold is the last argument, so a
|
|
;; wrapper that lost it among the four coordinates answers with whatever was
|
|
;; in that register.
|
|
(show-bool "point on line"
|
|
(rl/collision-point-line? (rl/Vector2 {.x 5.0 .y 0.0})
|
|
(rl/Vector2 {.x 0.0 .y 0.0})
|
|
(rl/Vector2 {.x 10.0 .y 0.0}) 1))
|
|
(show-bool "point off line"
|
|
(rl/collision-point-line? (rl/Vector2 {.x 5.0 .y 4.0})
|
|
(rl/Vector2 {.x 0.0 .y 0.0})
|
|
(rl/Vector2 {.x 10.0 .y 0.0}) 1))
|
|
|
|
;; The only one that crosses a *slice*, so it is the only one where ptr+len
|
|
;; has to arrive as raylib's pointer-and-count. A wrong length reads past the
|
|
;; array or stops short, and either way the square stops being a square.
|
|
(let [square [(rl/Vector2 {.x 0.0 .y 0.0}) (rl/Vector2 {.x 8.0 .y 0.0})
|
|
(rl/Vector2 {.x 8.0 .y 8.0}) (rl/Vector2 {.x 0.0 .y 8.0})]]
|
|
(show-bool "point in poly"
|
|
(rl/collision-point-poly? (rl/Vector2 {.x 4.0 .y 4.0}) (slice square 0 4)))
|
|
(show-bool "point outside poly"
|
|
(rl/collision-point-poly? (rl/Vector2 {.x 12.0 .y 4.0}) (slice square 0 4)))
|
|
;; The same point against the same array, three corners instead of four:
|
|
;; inside the square, outside the triangle the first three make. This is
|
|
;; the case that proves the *length* crosses — everything above would pass
|
|
;; with a hardcoded count, or with the pointer alone.
|
|
(show-bool "in square, four corners"
|
|
(rl/collision-point-poly? (rl/Vector2 {.x 2.0 .y 6.0}) (slice square 0 4)))
|
|
(show-bool "out of triangle, three"
|
|
(rl/collision-point-poly? (rl/Vector2 {.x 2.0 .y 6.0}) (slice square 0 3))))
|
|
|
|
;; Parallel, so they never meet: None rather than a point nobody wrote.
|
|
(match (rl/collision-lines (rl/Vector2 {.x 0.0 .y 0.0}) (rl/Vector2 {.x 1.0 .y 2.0})
|
|
(rl/Vector2 {.x 5.0 .y 0.0}) (rl/Vector2 {.x 6.0 .y 2.0}))
|
|
(Some p) (show-v p)
|
|
None (println "no crossing"))
|
|
|
|
;; An enum reaching a declare-c parameter through (Enum n): the axis is a
|
|
;; loop variable, which is what nothing could express before. No pad is
|
|
;; attached, so raylib answers its own resting value per axis — 0.0 for the
|
|
;; four stick axes and -1.0 for the two triggers, which rest at the negative
|
|
;; end. That split is what makes this pin worth having: it shows six
|
|
;; distinct i32s arriving as six distinct GamepadAxis members rather than
|
|
;; one constant answered six times.
|
|
(print "axes")
|
|
(dotimes [i 6]
|
|
(print " ")
|
|
(print (rl/get-gamepad-axis-movement 0 (rl/GamepadAxis i))))
|
|
;; And an axis that is no declared member. raylib bounds-checks it itself and
|
|
;; answers 0.0; the conversion does not refuse it, for the same reason the
|
|
;; printer shows an out-of-range enum as its number.
|
|
(print " past-end ")
|
|
(print (rl/get-gamepad-axis-movement 0 (rl/GamepadAxis 9)))
|
|
(println "")
|
|
|
|
0)
|