flan/test/programs/raylib-image-processing.flan

;;;; examples/textures-image-processing.flan's other half: the nine filters,
;;;; no window.
;;;;
;;;; The same split core-input-virtual-controls.flan and sand.flan already
;;;; have, and this one earns it more easily than either: an Image is pixels in
;;;; RAM, so every filter in that example runs with no GL context, and raylib
;;;; *computes* the answer rather than handing back what it was given. That is
;;;; what raylib.flan's Images section says makes this corner of the surface
;;;; assertable at all, and programs/raylib-image.flan is the case that already
;;;; leans on it.
;;;;
;;;; What this pins that raylib-image.flan does not: the **in-place** half of
;;;; the Image surface. Everything there is by value — gen, crop to a new
;;;; image, read a pixel. Every filter here takes a (Ptr Image) and rewrites
;;;; the buffer under it, and two of them (image-format, image-blur-gaussian)
;;;; free the old buffer and install a new one. A declaration that said `Image`
;;;; where raylib wants `Image *` would compile, would be handed a copy of the
;;;; struct, and would leave the caller's pixels untouched — which is a wrong
;;;; picture and not a crash.
;;;;
;;;; It imports the example, so the pixels here and the pixels on screen are
;;;; the same pixels. The example's `main` is not exported and nothing below
;;;; opens a window, so the only main is this one.
;;;;
;;;; **What is asserted and what is deliberately not.** Grayscale, invert and
;;;; the two flips are exact arithmetic — a fixed set of channel weights,
;;;; 255 minus the channel, and a coordinate reflection — so those are pinned
;;;; to the byte. The blur is not: the exact kernel ImageBlurGaussian uses is
;;;; raylib's business and a patch release may change it, so pinning a blurred
;;;; byte would buy a test that goes red when raylib improves. What is pinned
;;;; about the blur is the two things that are true of any blur — the image
;;;; keeps its size and format, and a pixel just outside a red rectangle has
;;;; moved toward red — and that is the shape of claim a filter can carry.
;;;;
;;;; Tint, contrast and brightness sit in between and are pinned exactly: all
;;;; three are per-channel arithmetic on a single pixel with no neighbourhood
;;;; at all, so there is nothing in them for an implementation to have an
;;;; opinion about.

(import ip "../../examples/textures-image-processing.flan")
(import rl "vendor:raylib")

;; Three probes, chosen so that between them every shape and the background
;; are represented, and so that no two of them are a reflection of each other
;; in either axis. That last property is what makes the flip rows mean
;; something: mirror the image and each probe lands somewhere new.
(defconst probe-a-x  40)   ; inside the red rectangle near the top
(defconst probe-a-y  20)
(defconst probe-b-x  40)   ; inside the lime rectangle near the bottom
(defconst probe-b-y 110)
(defconst probe-c-x 180)   ; background gradient, right-hand side
(defconst probe-c-y  40)

(defn show-color [name string  which string  c rl/Color] ()
  (print name)
  (print " ")  (print which)
  (print " ")  (print (.r c))
  (print " ")  (print (.g c))
  (print " ")  (print (.b c))
  (print " ")  (print (.a c))
  (println ""))

;; Size and format on the same line as the name, because two of the nine
;; filters reallocate and a filter that quietly changed either would otherwise
;; only show up as three moved pixels.
(defn show-shape [name string  i rl/Image] ()
  (print name)
  (print " ")  (print (.width i))
  (print " ")  (print (.height i))
  (print " ")  (print (.format i))
  (println ""))

(defn probe [name string  i rl/Image] ()
  (show-shape name i)
  (show-color name "a" (rl/get-image-color i probe-a-x probe-a-y))
  (show-color name "b" (rl/get-image-color i probe-b-x probe-b-y))
  (show-color name "c" (rl/get-image-color i probe-c-x probe-c-y)))

;; One filter, over a fresh copy of the source, reported and thrown away. A
;; copy per filter and not one image threaded through all nine: the example
;; restores from the original before every filter for exactly this reason, and
;; a test that stacked them would be asserting the composition rather than the
;; parts.
(defn run [name string  src rl/Image  which i32] ()
  (let [img (rl/image-copy src)]
    (ip/apply-process (addr img) which)
    (probe name img)
    (rl/unload-image img)))

(defn yes-no [b bool] string (if b "yes" "no"))

;; The blur, said in the only two ways a blur can be said without pinning
;; somebody else's kernel. The edge probe is one pixel outside the red
;; rectangle's left side: before the blur it is gradient, after it some of the
;; red next door has arrived, so its red channel is strictly higher. The
;; interior probe is well inside the rectangle and is still red-dominant,
;; which is what says the blur spread the colour rather than washed it out.
(defconst edge-x 10)
(defconst edge-y 20)

(defn blur-claims [src rl/Image] ()
  (let [img (rl/image-copy src)]
    (rl/image-blur-gaussian (addr img) 10)
    (show-shape "blur" img)
    (let [before (rl/get-image-color src edge-x edge-y)
          after  (rl/get-image-color img edge-x edge-y)
          inside (rl/get-image-color img probe-a-x probe-a-y)]
      (print "blur edge-reddened ") (println (yes-no (> (.r after) (.r before))))
      (print "blur inside-still-red ")
      (println (yes-no (and (> (.r inside) (.g inside))
                            (> (.r inside) (.b inside))))))
    (rl/unload-image img)))

(defn main [] ()
  (let [src (ip/make-source-image)]
    ;; The example formats the original before anything else touches it, and
    ;; so does this: a filter run over a differently-formatted buffer is a
    ;; different filter.
    (rl/image-format (addr src) :pixel-uncompressed-r8g8b8a8)
    (probe "source" src)

    (run "none"       src 0)
    (run "grayscale"  src 1)
    (run "tint"       src 2)
    (run "invert"     src 3)
    (run "contrast"   src 4)
    (run "brightness" src 5)
    (run "flip-v"     src 7)
    (run "flip-h"     src 8)
    (blur-claims src)

    (rl/unload-image src)))