Joseph Ferano
a4c6b996ff
The trio the author decided on 2026-09-20 is now all built: def is CL's defparameter — its initialiser runs on every daemon re-run, unguarded, so an edited initialiser repaints the same storage on C-c C-c plus re-run — defonce (Clojure's name for CL's defvar, per the author) initialises once behind the .init~once. flag, and defconst stays the image. One parse arm reads both forms; the difference is Ast.reinit, carried to Tast.global's grerun. Emit.startup_plan gives a def no guard flag, and Check.check_global lifts every def initialiser — zero and literal included — into global/<n>, so the host's startup reaches it through the function cell and a re-evaluated def swaps it (Session's def_inits; Emit.redefinition declares the cell for a non-sibling target). The old defvar spelling is refused with the rename and both compiling spellings, and every program, test, doc and editor list is swept — except sand.flan, the author's live WIP, whose seven defvar lines are flagged in FIX.org and keep its three dependent tests red on this branch.
129 lines
6.2 KiB
Plaintext
129 lines
6.2 KiB
Plaintext
;;;; 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)
|
|
|
|
(defonce textures [9 rl/Texture2D])
|
|
(defonce 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? :mouse-left) (rl/key-pressed? :key-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)))))
|