262 lines
12 KiB
Plaintext
262 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.flan: **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.flan'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 defenum in vendor/raylib/raylib.flan,
|
|
;;;; 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 worked around in `reload-texture`
|
|
;;;; below: LoadImageColors answers a (Ptr Color) and UpdateTexture takes a
|
|
;;;; (Ptr u8), because the header spells its parameter `const void *` and Flan
|
|
;;;; has no cast between pointer types. The address of the first field of the
|
|
;;;; first pixel is the same address, and saying so is what the workaround is.
|
|
|
|
(import rl "vendor:raylib")
|
|
|
|
(defconst screen-width 800)
|
|
(defconst screen-height 450)
|
|
|
|
(defconst num-processes 9)
|
|
|
|
;; The C's ImageProcess enum. Flan's defenum lowers to an i32 for C's benefit
|
|
;; and these never cross to C, so they are defconsts — the same choice
|
|
;; examples/textures-image-generation.flan made for its texture index.
|
|
(defconst proc-none 0)
|
|
(defconst proc-color-grayscale 1)
|
|
(defconst proc-color-tint 2)
|
|
(defconst proc-color-invert 3)
|
|
(defconst proc-color-contrast 4)
|
|
(defconst proc-color-brightness 5)
|
|
(defconst proc-gaussian-blur 6)
|
|
(defconst proc-flip-vertical 7)
|
|
(defconst proc-flip-horizontal 8)
|
|
|
|
(defvar process-names [num-processes string])
|
|
|
|
;; The nine toggle buttons down the left-hand side, laid out once at startup.
|
|
(defvar toggle-recs [num-processes rl/Rectangle])
|
|
|
|
;; The generated picture's size. Small on purpose — see the header comment.
|
|
(defconst source-width 200)
|
|
(defconst 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.
|
|
(defn 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.flan, 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.
|
|
(defn apply-process [img (Ptr rl/Image) which i32] ()
|
|
(cond
|
|
(= which proc-color-grayscale) (rl/image-color-grayscale img)
|
|
(= which proc-color-tint) (rl/image-color-tint img rl/green)
|
|
(= which proc-color-invert) (rl/image-color-invert img)
|
|
(= which proc-color-contrast) (rl/image-color-contrast img -40.0)
|
|
(= which proc-color-brightness) (rl/image-color-brightness img -80)
|
|
(= which proc-gaussian-blur) (rl/image-blur-gaussian img 10)
|
|
(= which proc-flip-vertical) (rl/image-flip-vertical img)
|
|
(= which proc-flip-horizontal) (rl/image-flip-horizontal img)))
|
|
|
|
(defvar texture rl/Texture2D)
|
|
(defvar im-origin rl/Image)
|
|
(defvar im-copy rl/Image)
|
|
(defvar current-process i32)
|
|
(defvar 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 — and because the awkward step in it is a finding
|
|
;; rather than an accident. LoadImageColors answers a (Ptr Color); UpdateTexture
|
|
;; takes a (Ptr u8), the header having spelled that parameter `const void *`;
|
|
;; and there is no cast between pointer types in Flan. What there is, is the
|
|
;; address of the red channel of pixel zero, which is the address of the
|
|
;; buffer said the long way round. See docs/PORTING.md.
|
|
(defn reload-texture [] ()
|
|
(rl/unload-image im-copy)
|
|
(set im-copy (rl/image-copy im-origin))
|
|
(apply-process (addr im-copy) current-process)
|
|
(let [n (* (.width im-copy) (.height im-copy))
|
|
pixels (rl/load-image-colors im-copy)]
|
|
(rl/update-texture texture (addr (.r (at (slice-from-ptr pixels n) 0))))
|
|
(rl/unload-image-colors pixels)))
|
|
|
|
(defn main [] ()
|
|
(rl/init-window screen-width screen-height
|
|
"raylib [textures] example - image processing")
|
|
(defer (rl/close-window))
|
|
|
|
(set (at process-names 0) "NO PROCESSING")
|
|
(set (at process-names 1) "COLOR GRAYSCALE")
|
|
(set (at process-names 2) "COLOR TINT")
|
|
(set (at process-names 3) "COLOR INVERT")
|
|
(set (at process-names 4) "COLOR CONTRAST")
|
|
(set (at process-names 5) "COLOR BRIGHTNESS")
|
|
(set (at process-names 6) "GAUSSIAN BLUR")
|
|
(set (at process-names 7) "FLIP VERTICAL")
|
|
(set (at 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.
|
|
(set im-origin (make-source-image))
|
|
(rl/image-format (addr im-origin) :uncompressed-r8g8b8a8)
|
|
(set texture (rl/load-texture-from-image im-origin))
|
|
(set im-copy (rl/image-copy im-origin))
|
|
|
|
(defer (rl/unload-texture texture))
|
|
(defer (rl/unload-image im-origin))
|
|
(defer (rl/unload-image im-copy))
|
|
|
|
(set current-process proc-none)
|
|
(set mouse-hover-rec -1)
|
|
|
|
(set toggle-recs (array num-processes rl/Rectangle))
|
|
(dotimes [i num-processes]
|
|
(set (at 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.flan 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.
|
|
(set mouse-hover-rec -1)
|
|
(let [reload false]
|
|
(dotimes [i num-processes]
|
|
(when (rl/collision-point-rec? (rl/get-mouse-position) (at toggle-recs i))
|
|
(set mouse-hover-rec i)
|
|
(when (rl/mouse-button-released? :left)
|
|
(set current-process i)
|
|
(set 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.
|
|
(cond
|
|
(rl/key-pressed? :down)
|
|
(do (set current-process (+ current-process 1))
|
|
(when (> current-process (- num-processes 1))
|
|
(set current-process 0))
|
|
(set reload true))
|
|
|
|
(rl/key-pressed? :up)
|
|
(do (set current-process (- current-process 1))
|
|
(when (< current-process 0) (set current-process 7))
|
|
(set 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.
|
|
(when reload (reload-texture)))
|
|
|
|
;; Draw
|
|
(rl/with-drawing
|
|
(rl/clear-background rl/raywhite)
|
|
|
|
(rl/draw-text "IMAGE PROCESSING:" 40 30 10 rl/darkgray)
|
|
|
|
(dotimes [i num-processes]
|
|
(let [on (or (= i current-process) (= i mouse-hover-rec))
|
|
r (at toggle-recs i)
|
|
name (at process-names i)]
|
|
(rl/draw-rectangle-rec r (if on rl/skyblue rl/lightgray))
|
|
(rl/draw-rectangle-lines (i32 (.x r)) (i32 (.y r))
|
|
(i32 (.width r)) (i32 (.height r))
|
|
(if on rl/blue rl/gray))
|
|
;; Centred in the button, so the label's own measured width is what
|
|
;; decides where it starts.
|
|
(rl/draw-text name
|
|
(i32 (- (+ (.x r) (/ (.width r) 2.0))
|
|
(/ (f32 (rl/measure-text name 10)) 2.0)))
|
|
(+ (i32 (.y r)) 11)
|
|
10
|
|
(if on rl/darkblue rl/darkgray))))
|
|
|
|
(let [x (- screen-width (.width texture) 60)
|
|
y (- (/ screen-height 2) (/ (.height texture) 2))]
|
|
(rl/draw-texture texture x y rl/white)
|
|
(rl/draw-rectangle-lines x y (.width texture) (.height texture)
|
|
rl/black)))))
|