;;;; raylib [textures] example - procedural images generation ;;;; ;;;; examples/textures/textures_image_generation.c. The strongest single pick ;;;; in the textures category and the reason is arithmetic: eight of the nine ;;;; textures come from a Gen* call that no program in this tree had ever ;;;; made, and none of the nine needs a file on disk. Every other textures ;;;; example loads a .png out of its resources directory; this one builds all ;;;; of its pixels. ;;;; ;;;; What it puts under load that nothing else does. An Image is the one ;;;; struct in raylib.flan that carries a pointer to memory raylib owns — ;;;; `data (Ptr u8)` — and it is returned by value, so every one of these nine ;;;; calls hands back a 24-byte aggregate through the shim's out-pointer with ;;;; a live heap block inside it. The corpus had crossed an Image before ;;;; (image-from-image has a headless acceptance case) but never nine in a row ;;;; and never on the load-then-upload-then-free path a real program uses: ;;;; gen, load-texture-from-image to get it onto the GPU, unload-image to give ;;;; the CPU copy back. Getting that order wrong is a leak rather than a ;;;; crash, which is exactly the sort of thing a ported example is for. ;;;; ;;;; Nothing needed adding. All nine generators and load-texture-from-image ;;;; came out of the generated half of the bindings; the only parameter that ;;;; looks like it wants an enum is gen-image-gradient-linear's `direction`, ;;;; which is an angle in degrees and not a flag, so an i32 is its true face. ;;;; ;;;; The C's `switch (currentTexture)` is a `cond` here. Flan has no switch ;;;; and the chain reads the same; the C's `default: break` is the `else` ;;;; branch (`:else`), unreachable because the index is taken modulo the count. (import rl "vendor:raylib") (defconst screen-width 800) (defconst screen-height 450) ;; Nine and not eight: the linear gradient appears three times, at three ;; angles, because a vertical, a horizontal and a diagonal gradient are the ;; same generator with a different `direction`. (defconst num-textures 9) (defvar textures [9 rl/Texture2D]) (defvar current-texture i32) ;; Generate on the CPU, upload, drop the pixels. The texture holds a GL name ;; and nothing of the Image, so the CPU copy can go as soon as the upload is ;; done — which is why the C frees all nine in a block immediately after the ;; nine uploads and this does it one at a time. Holding all nine 800x450 RGBA ;; images at once would be 14 MB for no reason. ;; ;; A top-level defn and not a local closure: Flan's `fn` takes its types from ;; the position it is written in, so it needs a parameter of (Fn [T ...] R) to ;; land in, and a `let` binding is not one. (defn upload [img rl/Image] rl/Texture2D (let [t (rl/load-texture-from-image img)] (rl/unload-image img) t)) (defn main [] () (rl/init-window screen-width screen-height "raylib [textures] example - procedural images generation") (defer (rl/close-window)) (set textures (array num-textures rl/Texture2D)) ;; 0 degrees runs the gradient top to bottom, 90 left to right, 45 corner ;; to corner. (set (at textures 0) (upload (rl/gen-image-gradient-linear screen-width screen-height 0 rl/red rl/blue))) (set (at textures 1) (upload (rl/gen-image-gradient-linear screen-width screen-height 90 rl/red rl/blue))) (set (at textures 2) (upload (rl/gen-image-gradient-linear screen-width screen-height 45 rl/red rl/blue))) ;; density 0 means the falloff reaches the edge of the image. (set (at textures 3) (upload (rl/gen-image-gradient-radial screen-width screen-height 0.0 rl/white rl/black))) (set (at textures 4) (upload (rl/gen-image-gradient-square screen-width screen-height 0.0 rl/white rl/black))) ;; 32 checks each way, so each square is 25 by 14 pixels. (set (at textures 5) (upload (rl/gen-image-checked screen-width screen-height 32 32 rl/red rl/blue))) ;; `factor` is the fraction of pixels that come out white. (set (at textures 6) (upload (rl/gen-image-white-noise screen-width screen-height 0.5))) (set (at textures 7) (upload (rl/gen-image-perlin-noise screen-width screen-height 50 50 4.0))) ;; `tile-size` is the cell spacing, in pixels. (set (at textures 8) (upload (rl/gen-image-cellular screen-width screen-height 32))) (defer (dotimes [i num-textures] (rl/unload-texture (at textures i)))) (set current-texture 0) (rl/set-target-fps 60) (until (rl/window-should-close?) ;; Update (when (or (rl/mouse-button-pressed? :left) (rl/key-pressed? :right)) (set current-texture (% (+ current-texture 1) num-textures))) ;; Draw (rl/with-drawing (rl/clear-background rl/raywhite) (rl/draw-texture (at textures current-texture) 0 0 rl/white) (rl/draw-rectangle 30 400 325 30 (rl/fade rl/skyblue 0.5)) (rl/draw-rectangle-lines 30 400 325 30 (rl/fade rl/white 0.5)) (rl/draw-text "MOUSE LEFT BUTTON to CYCLE PROCEDURAL TEXTURES" 40 410 10 rl/white) ;; The C's switch. Each label is positioned so its right edge lands in the ;; same place, which is why the x differs per line. (cond (= current-texture 0) (rl/draw-text "VERTICAL GRADIENT" 560 10 20 rl/raywhite) (= current-texture 1) (rl/draw-text "HORIZONTAL GRADIENT" 540 10 20 rl/raywhite) (= current-texture 2) (rl/draw-text "DIAGONAL GRADIENT" 540 10 20 rl/raywhite) (= current-texture 3) (rl/draw-text "RADIAL GRADIENT" 580 10 20 rl/lightgray) (= current-texture 4) (rl/draw-text "SQUARE GRADIENT" 580 10 20 rl/lightgray) (= current-texture 5) (rl/draw-text "CHECKED" 680 10 20 rl/raywhite) (= current-texture 6) (rl/draw-text "WHITE NOISE" 640 10 20 rl/red) (= current-texture 7) (rl/draw-text "PERLIN NOISE" 640 10 20 rl/red) :else (rl/draw-text "CELLULAR" 670 10 20 rl/raywhite)))))