201 lines
9.6 KiB
Plaintext
201 lines
9.6 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))
|
|
|
|
;; ── image-from-image, which is crop without the destruction ─────────
|
|
;;
|
|
;; The same 6 x 3 image and the same two marks, carved twice. The point that
|
|
;; matters is the one the assertions below make in three parts:
|
|
;;
|
|
;; 1. It reads the rectangle the same way image-crop does — (4,0,2,1)
|
|
;; picks two pixels of the first row and the mark at (5,0) lands at
|
|
;; (1,0) of a 2 x 1 result. Exchange width and height and the result is
|
|
;; 1 x 2 with nothing in it.
|
|
;;
|
|
;; 2. It reads `y`. The second carve is (4,2,2,1), one row lower than
|
|
;; anything image-crop's case reaches, and the mark it finds is the
|
|
;; *other* colour. A binding that ignored y would answer mark-a twice.
|
|
;;
|
|
;; 3. **The source survives.** That is the whole reason this exists beside
|
|
;; image-crop: crop mutates in place, so carving a sheet into twenty
|
|
;; tiles with it destroys the sheet on the first one. The original is
|
|
;; re-read after both carves and still reports 6 x 3 with both marks
|
|
;; where they were put. Bind this to ImageCrop by mistake and the second
|
|
;; carve reads out of a 2 x 1 image and the source check goes red.
|
|
(let [sheet (rl/gen-image-color 6 3 bg)]
|
|
(rl/image-draw-pixel (addr sheet) 5 0 mark-a)
|
|
(rl/image-draw-pixel (addr sheet) 4 2 mark-b)
|
|
(let [top (rl/image-from-image
|
|
sheet (rl/Rectangle {.x 4.0 .y 0.0 .width 2.0 .height 1.0}))]
|
|
(show-image "piece-top" top)
|
|
(show-pixel "piece-top at 1,0" top 1 0)
|
|
(show-pixel "piece-top at 0,0" top 0 0)
|
|
(rl/unload-image top))
|
|
(let [bottom (rl/image-from-image
|
|
sheet (rl/Rectangle {.x 4.0 .y 2.0 .width 2.0 .height 1.0}))]
|
|
(show-image "piece-bottom" bottom)
|
|
(show-pixel "piece-bottom at 0,0" bottom 0 0)
|
|
(show-pixel "piece-bottom at 1,0" bottom 1 0)
|
|
(rl/unload-image bottom))
|
|
(show-image "sheet after" sheet)
|
|
(show-pixel "sheet at 5,0" sheet 5 0)
|
|
(show-pixel "sheet at 4,2" sheet 4 2)
|
|
(rl/unload-image sheet))
|
|
|
|
0)
|