flan/test/programs/raylib-image.flan

(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 :log-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)