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.
161 lines
7.5 KiB
Plaintext
161 lines
7.5 KiB
Plaintext
(import rl "vendor:raylib")
|
|
|
|
;; raylib's Image family, headless. An Image is pixels in RAM: no window, no
|
|
;; GL context, and — unlike every other struct in the package — raylib will
|
|
;; *compute* with it. That is what makes this the strongest FFI case in the
|
|
;; project rather than another link check.
|
|
;;
|
|
;; Two things are being pinned here and they are different things:
|
|
;;
|
|
;; 1. **Flan's Image layout.** gen-image-color is handed two scalars and
|
|
;; answers with a struct whose four ints are 4, 2, 1 and 7 — all
|
|
;; distinct, so exchanging any two of width/height/mipmaps/format shows
|
|
;; up immediately. Scalars in, fields out: a permuted layout cannot
|
|
;; cancel itself the way store-and-return does, which is why this pins
|
|
;; more than the shapes texture ever could. It also pins `data`: drop it
|
|
;; from the defstruct and `width` reads the low half of raylib's pointer.
|
|
;;
|
|
;; 2. **The shim's argument order and raylib's own index arithmetic.**
|
|
;; get-image-color reads pixel y*width + x out of the buffer, so on a
|
|
;; 4-wide, 2-tall image the pixel at (3,0) exists and (0,3) does not.
|
|
;; Exchange x and y in the wrapper and the answer is transparent black.
|
|
;; This is the axis discriminator that no axis-aligned geometry can be:
|
|
;; the image is not square, so a reflection has nowhere to hide.
|
|
;;
|
|
;; The image is deliberately 4 x 2 throughout. A square one would let a
|
|
;; transposed read pass, and that is exactly the trap the collision cases fell
|
|
;; into.
|
|
|
|
(defconst bg (rl/Color {.r 10 .g 20 .b 30 .a 255}))
|
|
(defconst mark-a (rl/Color {.r 200 .g 0 .b 0 .a 255}))
|
|
(defconst mark-b (rl/Color {.r 0 .g 200 .b 0 .a 255}))
|
|
|
|
;; Where the export goes and comes back from. The two optimisation levels
|
|
;; write identical bytes, so sharing one path between runs is harmless.
|
|
(defconst png-path "/tmp/flan-raylib-image.png")
|
|
|
|
(defn show-image [name string i rl/Image] ()
|
|
(print name)
|
|
(print " ") (print (.width i))
|
|
(print " ") (print (.height i))
|
|
(print " ") (print (.mipmaps i))
|
|
(print " ") (print (.format i))
|
|
(println ""))
|
|
|
|
(defn show-color [name string c rl/Color] ()
|
|
(print name)
|
|
(print " ") (print (.r c))
|
|
(print " ") (print (.g c))
|
|
(print " ") (print (.b c))
|
|
(print " ") (print (.a c))
|
|
(println ""))
|
|
|
|
(defn show-bool [name string b bool] ()
|
|
(print name) (print " ")
|
|
(println (if b "yes" "no")))
|
|
|
|
;; Every pixel read names its coordinates in the label, so a failure says
|
|
;; which one moved rather than only that something did.
|
|
(defn show-pixel [name string i rl/Image x i32 y i32] ()
|
|
(show-color name (rl/get-image-color i x y)))
|
|
|
|
(defn main [] i32
|
|
(rl/set-trace-log-level :warning)
|
|
|
|
;; ── The layout, from a struct raylib built ──────────────────────────
|
|
;;
|
|
;; 4 wide, 2 tall, 1 mipmap level, format 7 (uncompressed R8G8B8A8). Four
|
|
;; different numbers in four adjacent i32 slots is the case Texture2D never
|
|
;; got: there, nothing without a GPU read width, height or mipmaps at all.
|
|
(let [img (rl/gen-image-color 4 2 bg)]
|
|
(show-image "generated" img)
|
|
|
|
;; ── The axes, from raylib's own indexing ───────────────────────────
|
|
;;
|
|
;; (3,0) is the last pixel of the first row and (0,1) the first of the
|
|
;; second. On a 4 x 2 image neither coordinate pair is valid with x and y
|
|
;; exchanged, so a wrapper with its arguments the wrong way round reads out
|
|
;; of bounds and answers 0 0 0 0.
|
|
(rl/image-draw-pixel (addr img) 3 0 mark-a)
|
|
(rl/image-draw-pixel (addr img) 0 1 mark-b)
|
|
(show-pixel "at 3,0" img 3 0)
|
|
(show-pixel "at 0,1" img 0 1)
|
|
;; And the two corners nothing was written to, because a get that ignored
|
|
;; its coordinates and returned the last-written colour would pass above.
|
|
(show-pixel "at 0,0" img 0 0)
|
|
(show-pixel "at 3,1" img 3 1)
|
|
|
|
;; ── Flip horizontal, then vertical ─────────────────────────────────
|
|
;;
|
|
;; Horizontal moves x and leaves y: (3,0) becomes (0,0) and (0,1) becomes
|
|
;; (3,1). Bind the two flips to each other's wrappers and this reads
|
|
;; unchanged at (3,0) instead, because a vertical flip of a 2-row image
|
|
;; would put the marks on the other rows entirely.
|
|
(rl/image-flip-horizontal (addr img))
|
|
(show-pixel "flipped-h at 0,0" img 0 0)
|
|
(show-pixel "flipped-h at 3,1" img 3 1)
|
|
(show-pixel "flipped-h at 3,0" img 3 0)
|
|
|
|
;; Vertical moves y and leaves x, so the two marks swap rows: (0,0) goes to
|
|
;; (0,1) and (3,1) to (3,0).
|
|
(rl/image-flip-vertical (addr img))
|
|
(show-pixel "flipped-v at 0,1" img 0 1)
|
|
(show-pixel "flipped-v at 3,0" img 3 0)
|
|
(show-pixel "flipped-v at 0,0" img 0 0)
|
|
|
|
;; ── Out to a PNG and back ──────────────────────────────────────────
|
|
;;
|
|
;; The file is external ground truth, which is what stops this being the
|
|
;; symmetric round trip the rest of the package has to avoid: the encoder
|
|
;; and the decoder are stb's, they agree with each other and not with
|
|
;; whatever field order Flan believes in. A path crosses as ptr+len and
|
|
;; the shim NUL-terminates a copy, so this exercises the string half of
|
|
;; the boundary too.
|
|
(show-bool "exported" (rl/export-image img png-path))
|
|
(let [back (rl/load-image png-path)]
|
|
(show-bool "loaded valid" (rl/image-valid? back))
|
|
(show-image "loaded" back)
|
|
(show-pixel "loaded at 0,1" back 0 1)
|
|
(show-pixel "loaded at 3,0" back 3 0)
|
|
(show-pixel "loaded at 0,0" back 0 0)
|
|
|
|
;; ── Nearest-neighbour resize ─────────────────────────────────────
|
|
;;
|
|
;; 4 x 2 to 8 x 2 doubles each pixel across, and leaves the rows alone.
|
|
;; The colours survive exactly, which bicubic's would not, so this is
|
|
;; the resize that can be asserted on content: the mark at (0,1) spreads
|
|
;; to (0,1) and (1,1), the one at (3,0) to (6,0) and (7,0), and (2,1) is
|
|
;; background between them. New width and height are 8 and 2 — distinct,
|
|
;; so a wrapper that swapped them answers 2 and 8.
|
|
(rl/image-resize-nn (addr back) 8 2)
|
|
(show-image "resized-nn" back)
|
|
(show-pixel "nn at 0,1" back 0 1)
|
|
(show-pixel "nn at 1,1" back 1 1)
|
|
(show-pixel "nn at 6,0" back 6 0)
|
|
(show-pixel "nn at 7,0" back 7 0)
|
|
(show-pixel "nn at 2,1" back 2 1)
|
|
|
|
;; Bicubic. Its pixels are interpolated and not worth asserting, but the
|
|
;; dimensions are, and 2 x 6 is asymmetric in both directions at once.
|
|
(rl/image-resize (addr back) 2 6)
|
|
(show-image "resized" back)
|
|
(rl/unload-image back))
|
|
(rl/unload-image img))
|
|
|
|
;; ── Crop, which is where Rectangle meets Image ──────────────────────
|
|
;;
|
|
;; A 6 x 3 image with one mark at (5,0), cropped to (x 4, y 0, w 2, h 1).
|
|
;; The result is 2 x 1 and the mark has moved to (1,0) — it survived, so the
|
|
;; crop's x really is 4 and not its width, and the region really is two wide
|
|
;; and one tall and not the other way about. Exchange width and height in
|
|
;; the Rectangle and the result is 1 x 2 with the mark gone.
|
|
(let [img (rl/gen-image-color 6 3 bg)]
|
|
(rl/image-draw-pixel (addr img) 5 0 mark-a)
|
|
(rl/image-crop (addr img) (rl/Rectangle {.x 4.0 .y 0.0 .width 2.0 .height 1.0}))
|
|
(show-image "cropped" img)
|
|
(show-pixel "cropped at 1,0" img 1 0)
|
|
(show-pixel "cropped at 0,0" img 0 0)
|
|
(rl/unload-image img))
|
|
|
|
0)
|