Joseph Ferano
9a820d86cd
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.
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)
|