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.
250 lines
10 KiB
Plaintext
250 lines
10 KiB
Plaintext
;;;; raylib [textures] example - mouse painting
|
|
;;;;
|
|
;;;; examples/textures/textures_mouse_painting.c. The one example in the
|
|
;;;; category that takes a picture back OFF the GPU and writes it to disk, and
|
|
;;;; that round trip is why it is here:
|
|
;;;;
|
|
;;;; load-image-from-texture → image-flip-vertical → export-image
|
|
;;;;
|
|
;;;; Nothing in the corpus had run it. image-from-image has a headless
|
|
;;;; acceptance case and sand.flan loads images the other way, but the path
|
|
;;;; that reads a render target's pixels back into CPU memory, corrects for
|
|
;;;; GL's bottom-up rows and encodes a PNG had never been exercised at all.
|
|
;;;; All three came out of the generated half of the bindings; nothing needed
|
|
;;;; adding for this file.
|
|
;;;;
|
|
;;;; The flip is the same fact as the negative source height in
|
|
;;;; examples/textures-fog-of-war.flan, met from the other side: on screen the
|
|
;;;; canvas is drawn with a negative-height source rectangle so GL's bottom-up
|
|
;;;; rows come out the right way up, and on save there is no source rectangle
|
|
;;;; to negate, so the pixels are turned over in memory instead. A program
|
|
;;;; that did one and not the other would show a correct picture and save an
|
|
;;;; upside-down one — which is exactly the bug the C's comment warns about.
|
|
;;;;
|
|
;;;; The other thing this puts under load is the render texture as *persistent
|
|
;;;; state*. The fog-of-war target is rebuilt from nothing every frame; this
|
|
;;;; one is the document — it is cleared once before the loop and every stroke
|
|
;;;; after that accumulates in it. Between the two the corpus has both ways a
|
|
;;;; render texture gets used.
|
|
;;;;
|
|
;;;; Two deviations from the C, both in the same place and both deliberate.
|
|
;;;; The C computes colorMouseHover with a `for` whose `else` clause resets it
|
|
;;;; on every miss and whose `break` leaves it set on a hit, so the value that
|
|
;;;; survives depends on the loop exiting early — it works, but only because
|
|
;;;; of the break. Here the reset is before the loop and the loop only ever
|
|
;;;; sets it, which is the same result said plainly. And "no colour hovered"
|
|
;;;; is -1 in both, tested with `>= 0` before it is used as an index.
|
|
|
|
(import rl "vendor:raylib")
|
|
|
|
(defconst screen-width 800)
|
|
(defconst screen-height 450)
|
|
|
|
(defconst max-colors-count 23)
|
|
|
|
;; The palette strip along the top. colors[0] is also the canvas's clear
|
|
;; colour and the "eraser", which is why raywhite is first and not simply
|
|
;; another entry.
|
|
(defvar colors [23 rl/Color])
|
|
(defvar colors-recs [23 rl/Rectangle])
|
|
|
|
(defvar color-selected i32)
|
|
(defvar color-selected-prev i32)
|
|
(defvar color-mouse-hover i32)
|
|
(defvar brush-size f32)
|
|
(defvar mouse-was-pressed bool)
|
|
|
|
(defvar btn-save-rec rl/Rectangle)
|
|
(defvar btn-save-mouse-hover bool)
|
|
(defvar show-save-message bool)
|
|
(defvar save-message-counter i32)
|
|
|
|
(defvar target rl/RenderTexture2D)
|
|
|
|
(defn main [] ()
|
|
(rl/init-window screen-width screen-height
|
|
"raylib [textures] example - mouse painting")
|
|
(defer (rl/close-window))
|
|
|
|
(set colors (array max-colors-count rl/Color))
|
|
(set (at colors 0) rl/raywhite)
|
|
(set (at colors 1) rl/yellow)
|
|
(set (at colors 2) rl/gold)
|
|
(set (at colors 3) rl/orange)
|
|
(set (at colors 4) rl/pink)
|
|
(set (at colors 5) rl/red)
|
|
(set (at colors 6) rl/maroon)
|
|
(set (at colors 7) rl/green)
|
|
(set (at colors 8) rl/lime)
|
|
(set (at colors 9) rl/darkgreen)
|
|
(set (at colors 10) rl/skyblue)
|
|
(set (at colors 11) rl/blue)
|
|
(set (at colors 12) rl/darkblue)
|
|
(set (at colors 13) rl/purple)
|
|
(set (at colors 14) rl/violet)
|
|
(set (at colors 15) rl/darkpurple)
|
|
(set (at colors 16) rl/beige)
|
|
(set (at colors 17) rl/brown)
|
|
(set (at colors 18) rl/darkbrown)
|
|
(set (at colors 19) rl/lightgray)
|
|
(set (at colors 20) rl/gray)
|
|
(set (at colors 21) rl/darkgray)
|
|
(set (at colors 22) rl/black)
|
|
|
|
;; 30 wide with a 2-pixel gap, starting 10 from the left.
|
|
(set colors-recs (array max-colors-count rl/Rectangle))
|
|
(dotimes [i max-colors-count]
|
|
(set (at colors-recs i)
|
|
(rl/Rectangle {.x (+ 10.0 (* 32.0 (f32 i)))
|
|
.y 10.0 .width 30.0 .height 30.0})))
|
|
|
|
(set color-selected 0)
|
|
(set color-selected-prev 0)
|
|
(set color-mouse-hover 0)
|
|
(set brush-size 20.0)
|
|
(set mouse-was-pressed false)
|
|
|
|
(set btn-save-rec (rl/Rectangle {.x 750.0 .y 10.0 .width 40.0 .height 30.0}))
|
|
(set btn-save-mouse-hover false)
|
|
(set show-save-message false)
|
|
(set save-message-counter 0)
|
|
|
|
;; The canvas. It is the document, not a scratch buffer: nothing clears it
|
|
;; again until the user presses C.
|
|
(set target (rl/load-render-texture screen-width screen-height))
|
|
(defer (rl/unload-render-texture target))
|
|
|
|
(rl/with-texture-mode target
|
|
(rl/clear-background (at colors 0)))
|
|
|
|
;; 120 and not 60: the stroke is a circle stamped at the mouse position once
|
|
;; per frame, so the gaps between stamps during a fast drag are a function
|
|
;; of the frame rate. The C's comment says as much.
|
|
(rl/set-target-fps 120)
|
|
|
|
(until (rl/window-should-close?)
|
|
;; Update
|
|
(let [mouse-pos (rl/get-mouse-position)]
|
|
(if (rl/key-pressed? :right)
|
|
(set color-selected (+ color-selected 1))
|
|
(when (rl/key-pressed? :left)
|
|
(set color-selected (- color-selected 1))))
|
|
(set color-selected (clamp color-selected 0 (- max-colors-count 1)))
|
|
|
|
;; Which swatch the pointer is over, or -1. See the header comment: the
|
|
;; reset is here rather than in an else branch inside the loop.
|
|
(set color-mouse-hover -1)
|
|
(dotimes [i max-colors-count]
|
|
(when (rl/collision-point-rec? mouse-pos (at colors-recs i))
|
|
(set color-mouse-hover i)
|
|
(break)))
|
|
|
|
(when (and (>= color-mouse-hover 0) (rl/mouse-button-pressed? :left))
|
|
(set color-selected color-mouse-hover)
|
|
(set color-selected-prev color-selected))
|
|
|
|
(set brush-size (clamp (+ brush-size (* (rl/get-mouse-wheel-move) 5.0))
|
|
2.0 50.0))
|
|
|
|
(when (rl/key-pressed? :c)
|
|
(rl/with-texture-mode target
|
|
(rl/clear-background (at colors 0))))
|
|
|
|
;; Paint. The gesture test is what makes the example work on a
|
|
;; touchscreen, where there is no mouse button to hold.
|
|
(when (or (rl/mouse-button-down? :left)
|
|
(= (rl/get-gesture-detected) :drag))
|
|
(rl/with-texture-mode target
|
|
;; Above y=50 is the palette strip, and a stroke there would paint
|
|
;; under the toolbar where it could never be seen.
|
|
(when (> (.y mouse-pos) 50.0)
|
|
(rl/draw-circle (i32 (.x mouse-pos)) (i32 (.y mouse-pos))
|
|
brush-size (at colors color-selected)))))
|
|
|
|
;; Right button erases, which is painting in the clear colour. The
|
|
;; selected swatch is parked while the button is held so the toolbar
|
|
;; shows what is being drawn, and restored on release.
|
|
(if (rl/mouse-button-down? :right)
|
|
(do
|
|
(when (not mouse-was-pressed)
|
|
(set color-selected-prev color-selected)
|
|
(set color-selected 0))
|
|
(set mouse-was-pressed true)
|
|
(rl/with-texture-mode target
|
|
(when (> (.y mouse-pos) 50.0)
|
|
(rl/draw-circle (i32 (.x mouse-pos)) (i32 (.y mouse-pos))
|
|
brush-size (at colors 0)))))
|
|
(when (and (rl/mouse-button-released? :right) mouse-was-pressed)
|
|
(set color-selected color-selected-prev)
|
|
(set mouse-was-pressed false)))
|
|
|
|
(set btn-save-mouse-hover (rl/collision-point-rec? mouse-pos btn-save-rec))
|
|
|
|
;; The round trip. See the header comment for why the flip is here and
|
|
;; not on the draw.
|
|
(when (or (and btn-save-mouse-hover (rl/mouse-button-released? :left))
|
|
(rl/key-pressed? :s))
|
|
(let [image (rl/load-image-from-texture (.texture target))]
|
|
(rl/image-flip-vertical (addr image))
|
|
(rl/export-image image "my_amazing_texture_painting.png")
|
|
(rl/unload-image image))
|
|
(set show-save-message true))
|
|
|
|
(when show-save-message
|
|
(set save-message-counter (+ save-message-counter 1))
|
|
(when (> save-message-counter 240)
|
|
(set show-save-message false)
|
|
(set save-message-counter 0)))
|
|
|
|
;; Draw
|
|
(rl/with-drawing
|
|
(rl/clear-background rl/raywhite)
|
|
|
|
;; The canvas, flipped by the negative source height.
|
|
(rl/draw-texture-rec (.texture target)
|
|
(rl/Rectangle {.x 0.0 .y 0.0
|
|
.width (f32 (.width (.texture target)))
|
|
.height (- 0.0 (f32 (.height (.texture target))))})
|
|
(rl/Vector2 {.x 0.0 .y 0.0})
|
|
rl/white)
|
|
|
|
;; The brush preview, drawn on the screen and not into the canvas.
|
|
(when (> (.y mouse-pos) 50.0)
|
|
(if (rl/mouse-button-down? :right)
|
|
(rl/draw-circle-lines (i32 (.x mouse-pos)) (i32 (.y mouse-pos))
|
|
brush-size rl/gray)
|
|
(rl/draw-circle (rl/get-mouse-x) (rl/get-mouse-y)
|
|
brush-size (at colors color-selected))))
|
|
|
|
;; The toolbar, over the canvas.
|
|
(rl/draw-rectangle 0 0 (rl/get-screen-width) 50 rl/raywhite)
|
|
(rl/draw-line 0 50 (rl/get-screen-width) 50 rl/lightgray)
|
|
|
|
(dotimes [i max-colors-count]
|
|
(rl/draw-rectangle-rec (at colors-recs i) (at colors i)))
|
|
;; The first swatch is raywhite on raywhite, so it needs an outline to
|
|
;; be visible at all.
|
|
(rl/draw-rectangle-lines 10 10 30 30 rl/lightgray)
|
|
|
|
(when (>= color-mouse-hover 0)
|
|
(rl/draw-rectangle-rec (at colors-recs color-mouse-hover)
|
|
(rl/fade rl/white 0.6)))
|
|
|
|
(let [r (at colors-recs color-selected)]
|
|
(rl/draw-rectangle-lines-ex
|
|
(rl/Rectangle {.x (- (.x r) 2.0) .y (- (.y r) 2.0)
|
|
.width (+ (.width r) 4.0) .height (+ (.height r) 4.0)})
|
|
2.0 rl/black))
|
|
|
|
(rl/draw-rectangle-lines-ex btn-save-rec 2.0
|
|
(if btn-save-mouse-hover rl/red rl/black))
|
|
(rl/draw-text "SAVE!" 755 20 10
|
|
(if btn-save-mouse-hover rl/red rl/black))
|
|
|
|
(when show-save-message
|
|
(rl/draw-rectangle 0 0 (rl/get-screen-width) (rl/get-screen-height)
|
|
(rl/fade rl/raywhite 0.8))
|
|
(rl/draw-rectangle 0 150 (rl/get-screen-width) 80 rl/black)
|
|
(rl/draw-text "IMAGE SAVED: my_amazing_texture_painting.png"
|
|
150 180 20 rl/raywhite))))))
|