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