JosephFerano/flan
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Nine filters that rewrite the buffer they are handed, and the half of them a headless run can pin

Browse Source
This commit is contained in:
Joseph Ferano 2026-09-13 23:22:37 +07:00
parent 1933295a70
commit fdf7531c37
3 changed files with 456 additions and 0 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

261
examples/textures-image-processing.flan Normal file
View File

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

132
test/programs/raylib-image-processing.flan Normal file
View File

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

63
test/test_acceptance.ml
View File

@ -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