From fdf7531c37801549c2ef5045089c2236603d7585 Mon Sep 17 00:00:00 2001 From: Joseph Ferano Date: Sun, 13 Sep 2026 23:22:37 +0700 Subject: [PATCH] Nine filters that rewrite the buffer they are handed, and the half of them a headless run can pin --- examples/textures-image-processing.flan | 261 +++++++++++++++++++++ test/programs/raylib-image-processing.flan | 132 +++++++++++ test/test_acceptance.ml | 63 +++++ 3 files changed, 456 insertions(+) create mode 100644 examples/textures-image-processing.flan create mode 100644 test/programs/raylib-image-processing.flan diff --git a/examples/textures-image-processing.flan b/examples/textures-image-processing.flan new file mode 100644 index 0000000..a509fb5 --- /dev/null +++ b/examples/textures-image-processing.flan @@ -0,0 +1,261 @@ +;;;; raylib [textures] example - image processing +;;;; +;;;; examples/textures/textures_image_processing.c. The one example in the +;;;; category where the CPU does the work: nine filters run over a pixel +;;;; buffer in RAM, and the GPU's only job is to show the answer. Every other +;;;; textures example this tree has ported either generates pixels and uploads +;;;; them once (image-generation), draws into a render target (fog-of-war, +;;;; mouse-painting), or reads one back (mouse-painting again). None of them +;;;; had ever handed raylib a buffer and asked it to rewrite the buffer. +;;;; +;;;; What that puts under load, and it is a different thing from the nine +;;;; Gen* calls in examples/textures-image-generation.flan: **in-place +;;;; mutation of an Image through a (Ptr Image)**. Eight of the nine filters +;;;; take the image by pointer and change `data` under the caller — +;;;; image-format and image-blur-gaussian *reallocate* it, so the pointer the +;;;; caller held before the call is freed by it. raylib.flan's Images section +;;;; already says that the by-value/by-pointer split is raylib's own and is +;;;; kept deliberately so a caller can see which calls change what they are +;;;; given; this is the example that depends on it being right. +;;;; +;;;; What needed adding: `PixelFormat`, a defenum in vendor/raylib/raylib.flan, +;;;; with image-format moved from the generated half to the hand-written one +;;;; and mapped in `bindings` so its twenty-four members are checked against +;;;; raylib.h. The C's line is +;;;; +;;;; ImageFormat(&imOrigin, PIXELFORMAT_UNCOMPRESSED_R8G8B8A8); +;;;; +;;;; and without the enum the Flan for it is `7`, which is a number with +;;;; nothing in it to say which of twenty-four conversions was meant. It is +;;;; the same trade TextureFilter made for the fog-of-war port. The call is +;;;; kept even though the generated image is already in that format — raylib's +;;;; Gen* calls all produce it — because it is the C's own guard and because +;;;; the reason it is there (UpdateTexture will not take anything else) has +;;;; not stopped being true. +;;;; +;;;; **The source image is generated and not loaded, and that is a licence +;;;; decision rather than a technical one.** The C loads `resources/parrots.png`, +;;;; which raylib's own examples/textures/resources/LICENSE.md lists with no +;;;; author and no licence at all, so it is not a file to copy into this +;;;; repository. The three textures examples already here generate everything +;;;; they draw and this one joins them. What the generated image has to be is +;;;; set by the filters rather than by taste: **asymmetric in both axes**, or +;;;; the vertical and the horizontal flip look identical and the port appears +;;;; broken, and carrying **sharp edges**, or the Gaussian blur has nothing to +;;;; soften. A diagonal gradient with three solid shapes dropped on it at +;;;; three different distances from three different edges is the smallest +;;;; thing that is both. +;;;; +;;;; The other deviation is the size. parrots.png is 768x512; this is 200x150, +;;;; because a blur of radius 10 is the one filter here whose cost is visible +;;;; and because the picture is a demonstration of the filter rather than the +;;;; point of the program. +;;;; +;;;; One gap, written up in PORTING.md and worked around in `reload-texture` +;;;; below: LoadImageColors answers a (Ptr Color) and UpdateTexture takes a +;;;; (Ptr u8), because the header spells its parameter `const void *` and Flan +;;;; has no cast between pointer types. The address of the first field of the +;;;; first pixel is the same address, and saying so is what the workaround is. + +(import rl "vendor:raylib") + +(defconst screen-width 800) +(defconst screen-height 450) + +(defconst num-processes 9) + +;; The C's ImageProcess enum. Flan's defenum lowers to an i32 for C's benefit +;; and these never cross to C, so they are defconsts — the same choice +;; examples/textures-image-generation.flan made for its texture index. +(defconst proc-none 0) +(defconst proc-color-grayscale 1) +(defconst proc-color-tint 2) +(defconst proc-color-invert 3) +(defconst proc-color-contrast 4) +(defconst proc-color-brightness 5) +(defconst proc-gaussian-blur 6) +(defconst proc-flip-vertical 7) +(defconst proc-flip-horizontal 8) + +(defvar process-names [num-processes string]) + +;; The nine toggle buttons down the left-hand side, laid out once at startup. +(defvar toggle-recs [num-processes rl/Rectangle]) + +;; The generated picture's size. Small on purpose — see the header comment. +(defconst source-width 200) +(defconst source-height 150) + +;; The picture the filters run over, in place of the C's parrots.png. +;; +;; The gradient runs corner to corner rather than along an axis, so a flip in +;; either direction moves it, and the three shapes are at three different +;; distances from three different edges so that no reflection of this image is +;; this image. The rectangles are what the blur has to work on: a gradient is +;; already smooth and a blur of it is very nearly itself. +;; +;; Exported rather than local because test/programs/raylib-image-processing.flan +;; runs the same nine filters over the same pixels with no window open, and a +;; headless case asserting a *different* image would be asserting nothing. +(defn make-source-image [] rl/Image + (let [img (rl/gen-image-gradient-linear source-width source-height 45 + rl/skyblue rl/darkblue)] + (rl/image-draw-rectangle (addr img) 12 10 62 34 rl/red) + (rl/image-draw-rectangle (addr img) 24 96 44 44 rl/lime) + (rl/image-draw-circle (addr img) 152 112 26 rl/gold) + img)) + +;; The C's `switch (currentProcess)`. A cond here, as in +;; examples/textures-image-generation.flan, and for the same reason: Flan has +;; no switch and the chain reads the same. +;; +;; Every arm takes the image by pointer and every arm rewrites the buffer the +;; pointer names. `proc-none` is the C's `default: break` and does nothing at +;; all, which is what makes the top entry of the list "NO PROCESSING" rather +;; than a filter that happens to be the identity. +(defn apply-process [img (Ptr rl/Image) which i32] () + (cond + (= which proc-color-grayscale) (rl/image-color-grayscale img) + (= which proc-color-tint) (rl/image-color-tint img rl/green) + (= which proc-color-invert) (rl/image-color-invert img) + (= which proc-color-contrast) (rl/image-color-contrast img -40.0) + (= which proc-color-brightness) (rl/image-color-brightness img -80) + (= which proc-gaussian-blur) (rl/image-blur-gaussian img 10) + (= which proc-flip-vertical) (rl/image-flip-vertical img) + (= which proc-flip-horizontal) (rl/image-flip-horizontal img))) + +(defvar texture rl/Texture2D) +(defvar im-origin rl/Image) +(defvar im-copy rl/Image) +(defvar current-process i32) +(defvar mouse-hover-rec i32) + +;; Throw the working copy away, take a fresh one from the original, run the +;; filter over it, and push the result at the texture that is already on the +;; GPU. +;; +;; The round trip through LoadImageColors is the C's, and it is not the +;; shortest route: after image-format the working image is already RGBA8, so +;; `(.data im-copy)` is the same bytes and is already a (Ptr u8). It is kept +;; because it is what the C does and because the pair is the only thing in the +;; corpus that exercises it — and because the awkward step in it is a finding +;; rather than an accident. LoadImageColors answers a (Ptr Color); UpdateTexture +;; takes a (Ptr u8), the header having spelled that parameter `const void *`; +;; and there is no cast between pointer types in Flan. What there is, is the +;; address of the red channel of pixel zero, which is the address of the +;; buffer said the long way round. See PORTING.md. +(defn reload-texture [] () + (rl/unload-image im-copy) + (set im-copy (rl/image-copy im-origin)) + (apply-process (addr im-copy) current-process) + (let [n (* (.width im-copy) (.height im-copy)) + pixels (rl/load-image-colors im-copy)] + (rl/update-texture texture (addr (.r (at (slice-from-ptr pixels n) 0)))) + (rl/unload-image-colors pixels))) + +(defn main [] () + (rl/init-window screen-width screen-height + "raylib [textures] example - image processing") + (defer (rl/close-window)) + + (set (at process-names 0) "NO PROCESSING") + (set (at process-names 1) "COLOR GRAYSCALE") + (set (at process-names 2) "COLOR TINT") + (set (at process-names 3) "COLOR INVERT") + (set (at process-names 4) "COLOR CONTRAST") + (set (at process-names 5) "COLOR BRIGHTNESS") + (set (at process-names 6) "GAUSSIAN BLUR") + (set (at process-names 7) "FLIP VERTICAL") + (set (at process-names 8) "FLIP HORIZONTAL") + + ;; NOTE, as the C has it: a texture can only be made after init-window, + ;; because making one needs the GL context init-window creates. The image + ;; underneath it does not — nothing above this line touches the GPU. + (set im-origin (make-source-image)) + (rl/image-format (addr im-origin) :uncompressed-r8g8b8a8) + (set texture (rl/load-texture-from-image im-origin)) + (set im-copy (rl/image-copy im-origin)) + + (defer (rl/unload-texture texture)) + (defer (rl/unload-image im-origin)) + (defer (rl/unload-image im-copy)) + + (set current-process proc-none) + (set mouse-hover-rec -1) + + (set toggle-recs (array num-processes rl/Rectangle)) + (dotimes [i num-processes] + (set (at toggle-recs i) + (rl/Rectangle {.x 40.0 .y (f32 (+ 50 (* 32 i))) + .width 150.0 .height 30.0}))) + + (rl/set-target-fps 60) + + (until (rl/window-should-close?) + ;; Update + ;; + ;; The C computes mouseHoverRec with a loop whose `else` clause resets it + ;; on every miss and whose `break` leaves it set on a hit. As in + ;; examples/textures-mouse-painting.flan the reset is lifted out in front + ;; and the loop only ever sets it, which is the same answer said plainly — + ;; the nine rectangles do not overlap, so there is no first-hit-wins rule + ;; to preserve. + (set mouse-hover-rec -1) + (let [reload false] + (dotimes [i num-processes] + (when (rl/collision-point-rec? (rl/get-mouse-position) (at toggle-recs i)) + (set mouse-hover-rec i) + (when (rl/mouse-button-released? :left) + (set current-process i) + (set reload true)))) + + ;; The keyboard half of the same toggle group. DOWN wraps at the end of + ;; the list; UP does not wrap to the end but to 7, which is the C's own + ;; off-by-one — FLIP HORIZONTAL is unreachable going up — and is left + ;; as it is because changing it here would make this file disagree with + ;; the example it claims to be. + (cond + (rl/key-pressed? :down) + (do (set current-process (+ current-process 1)) + (when (> current-process (- num-processes 1)) + (set current-process 0)) + (set reload true)) + + (rl/key-pressed? :up) + (do (set current-process (- current-process 1)) + (when (< current-process 0) (set current-process 7)) + (set reload true))) + + ;; NOTE, as the C has it: image processing is a costly thing to do per + ;; frame. It is done here only when the selection changed, and a program + ;; that needed it every frame would do it on the GPU in a shader. + (when reload (reload-texture))) + + ;; Draw + (rl/with-drawing + (rl/clear-background rl/raywhite) + + (rl/draw-text "IMAGE PROCESSING:" 40 30 10 rl/darkgray) + + (dotimes [i num-processes] + (let [on (or (= i current-process) (= i mouse-hover-rec)) + r (at toggle-recs i) + name (at process-names i)] + (rl/draw-rectangle-rec r (if on rl/skyblue rl/lightgray)) + (rl/draw-rectangle-lines (i32 (.x r)) (i32 (.y r)) + (i32 (.width r)) (i32 (.height r)) + (if on rl/blue rl/gray)) + ;; Centred in the button, so the label's own measured width is what + ;; decides where it starts. + (rl/draw-text name + (i32 (- (+ (.x r) (/ (.width r) 2.0)) + (/ (f32 (rl/measure-text name 10)) 2.0))) + (+ (i32 (.y r)) 11) + 10 + (if on rl/darkblue rl/darkgray)))) + + (let [x (- screen-width (.width texture) 60) + y (- (/ screen-height 2) (/ (.height texture) 2))] + (rl/draw-texture texture x y rl/white) + (rl/draw-rectangle-lines x y (.width texture) (.height texture) + rl/black))))) diff --git a/test/programs/raylib-image-processing.flan b/test/programs/raylib-image-processing.flan new file mode 100644 index 0000000..b90baa7 --- /dev/null +++ b/test/programs/raylib-image-processing.flan @@ -0,0 +1,132 @@ +;;;; 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))) diff --git a/test/test_acceptance.ml b/test/test_acceptance.ml index a6a4c31..cdda835 100644 --- a/test/test_acceptance.ml +++ b/test/test_acceptance.ml @@ -982,6 +982,69 @@ let () = else print_endline "acceptance: skipping the raylib Image case (no libraylib)"; + (* The nine filters of examples/textures-image-processing.flan, headless. + The example is imported, so these are the pixels that program shows — + and the filters are the half of the raylib Image surface + programs/raylib-image.flan does not reach, because every one of them + takes a (Ptr Image) and rewrites the buffer in place. Two of the rows + here are load-bearing beyond the arithmetic: grayscale's format goes + from 7 to 1, which is ImageColorGrayscale reallocating into a + one-byte-per-pixel buffer and is exactly the kind of change a + by-value declaration would hide, and the two flip rows read the OTHER + probe's colour, which is what says the reflection happened in the axis + it claimed. The blur is asserted structurally and not to the byte — + the file says why. *) + let raylib_proc_out = + "source 200 150 7\n\ + source a 230 41 55 255\n\ + source b 0 158 47 255\n\ + source c 37 122 202 255\n\ + none 200 150 7\n\ + none a 230 41 55 255\n\ + none b 0 158 47 255\n\ + none c 37 122 202 255\n\ + grayscale 200 150 1\n\ + grayscale a 99 99 99 255\n\ + grayscale b 98 98 98 255\n\ + grayscale c 105 105 105 255\n\ + tint 200 150 7\n\ + tint a 0 36 10 255\n\ + tint b 0 141 8 255\n\ + tint c 0 109 38 255\n\ + invert 200 150 7\n\ + invert a 25 214 200 255\n\ + invert b 255 97 208 255\n\ + invert c 218 133 53 255\n\ + contrast 200 150 7\n\ + contrast a 164 96 101 255\n\ + contrast b 81 138 98 255\n\ + contrast c 94 125 154 255\n\ + brightness 200 150 7\n\ + brightness a 150 1 1 255\n\ + brightness b 1 78 1 255\n\ + brightness c 1 42 122 255\n\ + flip-v 200 150 7\n\ + flip-v a 0 158 47 255\n\ + flip-v b 230 41 55 255\n\ + flip-v c 17 100 186 255\n\ + flip-h 200 150 7\n\ + flip-h a 49 135 212 255\n\ + flip-h b 255 203 0 255\n\ + flip-h c 230 41 55 255\n\ + blur 200 150 7\n\ + blur edge-reddened yes\n\ + blur inside-still-red yes\n" + in + if Sys.command "ldconfig -p 2>/dev/null | grep -q libraylib" = 0 then begin + outputs "raylib image processing, headless" + "programs/raylib-image-processing.flan" raylib_proc_out; + outputs ~opt:"-O0" "raylib image processing, headless, -O0" + "programs/raylib-image-processing.flan" raylib_proc_out + end + else + print_endline + "acceptance: skipping the raylib image-processing case (no libraylib)"; + (* raylib's Wave family, headless — and the first claim to make about it is that it exists. The received wisdom in this repository was that audio needs a device and so cannot be in this table at all. That is