133 lines
5.9 KiB
Plaintext
133 lines
5.9 KiB
Plaintext
;;;; 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) :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)))
|