flan/examples/textures-image-processing.fln

250 lines
12 KiB
Plaintext

;;;; 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.fln: **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.fln'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 enum in vendor/raylib/raylib.fln,
;;;; 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 docs/PORTING.md and since closed: LoadImageColors
;;;; answers a (Ptr Color) and UpdateTexture used to take only a (Ptr u8),
;;;; because the header spells its parameter `const void *` and the importer
;;;; had to render that as something. `reload-texture` below spelled the cast
;;;; by hand — the address of the first field of the first pixel, which is the
;;;; same address said at length. It does not any more: the header check
;;;; accepts a pointer to anything where the header says `void *`, so the
;;;; package binds the call twice and the caller names the type it has.
import rl "vendor:raylib"
const screen-width = 800
const screen-height = 450
const num-processes = 9
;; The C's ImageProcess enum. Flan's enum lowers to an i32 for C's benefit
;; and these never cross to C, so they are consts — the same choice
;; examples/textures-image-generation.fln made for its texture index.
const proc-none = 0
const proc-color-grayscale = 1
const proc-color-tint = 2
const proc-color-invert = 3
const proc-color-contrast = 4
const proc-color-brightness = 5
const proc-gaussian-blur = 6
const proc-flip-vertical = 7
const proc-flip-horizontal = 8
once process-names: [num-processes str]
;; The nine toggle buttons down the left-hand side, laid out once at startup.
once toggle-recs: [num-processes rl/Rectangle]
;; The generated picture's size. Small on purpose — see the header comment.
const source-width = 200
const 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.
fn 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.fln, 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.
fn apply-process(img: Ptr(rl/Image), which: i32) -> ()
if which == proc-color-grayscale
rl/image-color-grayscale(img)
elif which == proc-color-tint
rl/image-color-tint(img, rl/green)
elif which == proc-color-invert
rl/image-color-invert(img)
elif which == proc-color-contrast
rl/image-color-contrast(img, -40.0)
elif which == proc-color-brightness
rl/image-color-brightness(img, -80)
elif which == proc-gaussian-blur
rl/image-blur-gaussian(img, 10)
elif which == proc-flip-vertical
rl/image-flip-vertical(img)
elif which == proc-flip-horizontal
rl/image-flip-horizontal(img)
once texture: rl/Texture2D
once im-origin: rl/Image
once im-copy: rl/Image
once current-process: i32
once 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.
;;
;; LoadImageColors answers a (Ptr Color) and UpdateTexture's parameter is
;; `const void *`, which the importer renders as (Ptr const u8). The cast says
;; the same address is bytes.
fn reload-texture() -> ()
rl/unload-image(im-copy)
im-copy = rl/image-copy(im-origin)
apply-process(addr(im-copy), current-process)
let pixels = rl/load-image-colors(im-copy)
rl/update-texture(texture, Ptr(u8)(pixels))
rl/unload-image-colors(pixels)
fn main() -> ()
rl/init-window(screen-width, screen-height,
"raylib [textures] example - image processing")
defer rl/close-window()
process-names[0] = "NO PROCESSING"
process-names[1] = "COLOR GRAYSCALE"
process-names[2] = "COLOR TINT"
process-names[3] = "COLOR INVERT"
process-names[4] = "COLOR CONTRAST"
process-names[5] = "COLOR BRIGHTNESS"
process-names[6] = "GAUSSIAN BLUR"
process-names[7] = "FLIP VERTICAL"
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.
im-origin = make-source-image()
rl/image-format(addr(im-origin), :pixel-uncompressed-r8g8b8a8)
texture = rl/load-texture-from-image(im-origin)
im-copy = rl/image-copy(im-origin)
defer rl/unload-texture(texture)
defer rl/unload-image(im-origin)
defer rl/unload-image(im-copy)
current-process = proc-none
mouse-hover-rec = -1
toggle-recs = array(num-processes, rl/Rectangle)
for i in range(num-processes)
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.fln 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.
mouse-hover-rec = -1
let reload = false
for i in range(num-processes)
if rl/check-collision-point-rec(rl/get-mouse-position(), toggle-recs[i])
mouse-hover-rec = i
if rl/is-mouse-button-released(:mouse-left)
current-process = i
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.
if rl/is-key-pressed(:key-down)
current-process += 1
if current-process > num-processes - 1
current-process = 0
reload = true
elif rl/is-key-pressed(:key-up)
current-process -= 1
if current-process < 0
current-process = 7
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.
if reload
reload-texture()
;; Draw
rl/with-drawing:
rl/clear-background(rl/raywhite)
rl/draw-text("IMAGE PROCESSING:", 40, 30, 10, rl/darkgray)
for i in range(num-processes)
let (on) = i == current-process or i == mouse-hover-rec
let r = toggle-recs[i]
name = process-names[i]
rl/draw-rectangle-rec(r, if on then rl/skyblue else rl/lightgray)
rl/draw-rectangle-lines(i32(r.x), i32(r.y), i32(r.width), i32(r.height),
if on then rl/blue else rl/gray)
;; Centred in the button, so the label's own measured width is what
;; decides where it starts.
rl/draw-text(name,
i32(r.x + r.width / 2.0 - f32(rl/measure-text(name, 10)) / 2.0),
i32(r.y) + 11, 10, if on then rl/darkblue else rl/darkgray)
let x = screen-width - texture.width - 60
y = screen-height / 2 - texture.height / 2
rl/draw-texture(texture, x, y, rl/white)
rl/draw-rectangle-lines(x, y, texture.width, texture.height, rl/black)