Joseph Ferano
25f56c24a8
vendor/raylib/modes.flan: five macros over the five pairs the package binds -- with-drawing, with-mode-2d, with-mode-3d, with-texture-mode, with-scissor-mode. A second file with no declare-c in it, split out on vector.flan's reasoning: raylib.flan is the package's statement about C and nothing here names C, so nothing here can be made wrong by raylib changing. Each expands to (do (begin-... args) body... (end-...)) -- the calls the author used to type, in the order they typed them. No let, no gensym: nothing binds a name, so there is nothing for a caller's name to collide with. What it removes is the End* that is missing, wrong, or no longer beside its Begin*. What it cannot remove is a body leaving through the unwind path: a return or an invoke-restart skips the rest of the do and the End* with it. defer is the obvious fix and is refused inside a loop body, which is where a pair always lives -- checked, not assumed. So sand.flan's discipline stays: keep the restart boundary outside the pair. 35 call sites converted across examples/ and sand.flan. The one left is core-scissor-test.flan, whose Begin and End sit in two separate `when`s with the drawing between them -- a conditional pair is a shape a bracketing macro cannot express. test/programs/rl-with.flan covers with-scissor-mode, which no example can, with a frame function unreachable from main so it needs no libraylib; rl-with-reject.flan is the arity half.
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)
|
|
|
|
(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)))))
|