Joseph Ferano
fd873bb9d7
NEXT.md had the new box as a sibling heading next to "Queued:", so a reader scanning headings saw the same item twice and still queued. Folded into one section with a Bound box, the way PORTING.md §1 does it. And the example's header claimed the GetCodepoint tail "costs a scan rather than nothing". The shim's stack buffer is 256 bytes and this message is 284, so the first thirty glyphs of each pass malloc. Said so, because that is the kind of number the comments around it are precise about.
245 lines
11 KiB
Plaintext
245 lines
11 KiB
Plaintext
;;;; raylib [text] example - Rectangle bounds
|
|
;;;;
|
|
;;;; examples/text/text_rectangle_bounds.c. This is the example that could not
|
|
;;;; be ported at all until `slice-from-ptr` existed, and it is the reason the
|
|
;;;; form was built rather than an application found for it afterwards.
|
|
;;;;
|
|
;;;; Its inner loop reads `font.recs[index]` and `font.glyphs[index]`. Both
|
|
;;;; fields are `(Ptr T)` — that is what raylib hands back and there is nothing
|
|
;;;; else it could hand back — and a pointer from C carries no length, so
|
|
;;;; `(at (.recs font) i)` answered `(Ptr rl/Rectangle) cannot be indexed` and
|
|
;;;; the whole example stopped there. Element 0 through `deref` was the entire
|
|
;;;; readable surface of a two-hundred-glyph array.
|
|
;;;;
|
|
;;;; The count is not missing; it is in the struct, one field over, as
|
|
;;;; `glyph-count`. What was missing was a way to say so. `slice-from-ptr` is
|
|
;;;; that way, and `rl/font-recs` and `rl/font-glyphs` in the bindings are
|
|
;;;; where this example says it — once, beside the invariant, rather than at
|
|
;;;; every call site. Note which shape this is: the count is a sibling *field*,
|
|
;;;; not an out-parameter, so a per-binding declaration naming a count argument
|
|
;;;; (the alternative NEXT.md weighed) could not have reached it.
|
|
;;;;
|
|
;;;; This is also the only *procedural* font example upstream — every other one
|
|
;;;; in examples/text needs a TTF on disk — so until now the hand-written `Font`
|
|
;;;; surface (`get-font-default`, `get-glyph-index`, `draw-text-codepoint`, the
|
|
;;;; `GlyphInfo` and `Font` structs) had no example that called it.
|
|
;;;;
|
|
;;;; Two departures from the C, both deliberate:
|
|
;;;;
|
|
;;;; - `DrawTextBoxedSelectable` is not ported. The C defines it and then calls
|
|
;;;; it from `DrawTextBoxed` with `selectStart = 0`, `selectLength = 0` and
|
|
;;;; two `WHITE`s, so the selection half is dead code in this example: no
|
|
;;;; glyph is ever selected and no selection background is ever drawn. With
|
|
;;;; it goes the `k`/`lastk` pair, which exists only to keep a *codepoint*
|
|
;;;; index for the selection while `i` walks bytes. What is left is the word
|
|
;;;; wrap, which is the thing the example is about.
|
|
;;;;
|
|
;;;; - `GetCodepoint` wants a pointer into the middle of the text, and Flan has
|
|
;;;; the operation the C is spelling by hand: `(string (slice b i n))` is the
|
|
;;;; tail from `i` with no copy and no pointer arithmetic. It is not free:
|
|
;;;; the shim NUL-terminates a copy on the way into C, into a 256-byte stack
|
|
;;;; buffer or a malloc when the tail is longer — and this message is 284
|
|
;;;; bytes, so the first thirty glyphs of each pass do allocate. Fine for one
|
|
;;;; string drawn once a frame; worth knowing before reaching for the same
|
|
;;;; shape in a hot loop.
|
|
|
|
(import rl "vendor:raylib")
|
|
|
|
(defconst screen-width 800)
|
|
(defconst screen-height 450)
|
|
|
|
(defconst message
|
|
"Text cannot escape\tthis container\t...word wrap also works when active so here's a long text for testing.\n\nLorem ipsum dolor sit amet, consectetur adipiscing elit, sed do eiusmod tempor incididunt ut labore et dolore magna aliqua. Nec ullamcorper sit amet risus nullam eget felis eget.")
|
|
|
|
;; The two halves of the wrap state machine. wordWrap on starts in `measure`,
|
|
;; which finds where the line has to break and then replays the same bytes in
|
|
;; `draw`; wordWrap off never leaves `draw`.
|
|
(defconst measure 0)
|
|
(defconst draw 1)
|
|
|
|
;; Draw `text` inside `rec`, breaking lines on words when `word-wrap?`.
|
|
;;
|
|
;; The two `slice-from-ptr` uses are inside rl/font-recs and rl/font-glyphs;
|
|
;; from here they are ordinary slices, bounds-checked like any other, and the
|
|
;; index comes from raylib's own get-glyph-index so it is in range by
|
|
;; construction.
|
|
(defn draw-text-boxed [font rl/Font text [u8] rec rl/Rectangle
|
|
font-size f32 spacing f32 word-wrap? bool
|
|
tint rl/Color] ()
|
|
(let [glyphs (rl/font-glyphs font)
|
|
recs (rl/font-recs font)
|
|
length (i32 (len text))
|
|
scale (/ font-size (f32 (.base-size font)))
|
|
line-h (* (f32 (+ (.base-size font) (/ (.base-size font) 2))) scale)
|
|
off-x (f32 0.0)
|
|
off-y (f32 0.0)
|
|
state (if word-wrap? measure draw)
|
|
;; Byte offsets: where the current line begins and where it must end.
|
|
;; -1 is "not decided yet", which is why end-line is compared against 1
|
|
;; rather than 0 below — the C's `(endLine < 1)`.
|
|
start-line -1
|
|
end-line -1
|
|
i 0]
|
|
(while (< i length)
|
|
(let [size 0
|
|
cp (rl/get-codepoint (string (slice text i length)) (addr size))]
|
|
;; A byte that decodes to nothing answers '?' and raylib would normally
|
|
;; stop; this walks on one byte at a time so the bad bytes get drawn.
|
|
(when (= cp (i32 \?)) (set size 1))
|
|
(set i (+ i (- size 1)))
|
|
|
|
(let [gi (rl/get-glyph-index font cp)
|
|
w (f32 0.0)]
|
|
(when (!= cp (i32 \newline))
|
|
;; advance-x is how far the pen moves; 0 means "use the atlas
|
|
;; rectangle's width instead". This is the line that needed the
|
|
;; slices — two parallel arrays, indexed by the same glyph index.
|
|
(set w (if (= (.advance-x (at glyphs gi)) 0)
|
|
(* (.width (at recs gi)) scale)
|
|
(* (f32 (.advance-x (at glyphs gi))) scale)))
|
|
;; Spacing is added per gap, not per glyph, so the last one on the
|
|
;; line does not get it.
|
|
(when (< (+ i 1) length) (set w (+ w spacing))))
|
|
|
|
(if (= state measure)
|
|
(do
|
|
;; Any of these three is a legal place to break.
|
|
(when (or (= cp (i32 \space)) (= cp (i32 \tab))
|
|
(= cp (i32 \newline)))
|
|
(set end-line i))
|
|
(cond
|
|
(> (+ off-x w) (.width rec))
|
|
(do
|
|
(when (< end-line 1) (set end-line i))
|
|
(when (= i end-line) (set end-line (- end-line size)))
|
|
(when (= (+ start-line size) end-line)
|
|
(set end-line (- i size)))
|
|
(set state draw))
|
|
|
|
(= (+ i 1) length)
|
|
(do (set end-line i) (set state draw))
|
|
|
|
(= cp (i32 \newline))
|
|
(set state draw))
|
|
;; Having decided where the line ends, rewind to where it began
|
|
;; and walk the same bytes again, drawing this time.
|
|
(when (= state draw)
|
|
(set off-x 0.0)
|
|
(set i start-line)
|
|
(set w 0.0)))
|
|
|
|
(do
|
|
(if (= cp (i32 \newline))
|
|
(when (not word-wrap?)
|
|
(set off-y (+ off-y line-h))
|
|
(set off-x 0.0))
|
|
(do
|
|
(when (and (not word-wrap?) (> (+ off-x w) (.width rec)))
|
|
(set off-y (+ off-y line-h))
|
|
(set off-x 0.0))
|
|
;; Out of vertical room: stop, rather than drawing outside.
|
|
(when (> (+ off-y (* (f32 (.base-size font)) scale))
|
|
(.height rec))
|
|
(break))
|
|
(when (and (!= cp (i32 \space)) (!= cp (i32 \tab)))
|
|
(rl/draw-text-codepoint
|
|
font cp
|
|
(rl/Vector2 {.x (+ (.x rec) off-x)
|
|
.y (+ (.y rec) off-y)})
|
|
font-size tint))))
|
|
(when (and word-wrap? (= i end-line))
|
|
(set off-y (+ off-y line-h))
|
|
(set off-x 0.0)
|
|
(set start-line end-line)
|
|
(set end-line -1)
|
|
(set w 0.0)
|
|
(set state measure))))
|
|
|
|
;; Leading spaces do not push the pen along; everything else does.
|
|
(when (or (!= off-x 0.0) (!= cp (i32 \space)))
|
|
(set off-x (+ off-x w)))))
|
|
(set i (+ i 1)))))
|
|
|
|
(defn main [] ()
|
|
(rl/init-window screen-width screen-height
|
|
"raylib [text] example - draw text inside a rectangle")
|
|
(defer (rl/close-window))
|
|
|
|
(let [text (bytes message)
|
|
resizing? false
|
|
word-wrap? true
|
|
container (rl/Rectangle {.x 25.0 .y 25.0
|
|
.width (- (f32 screen-width) 50.0)
|
|
.height (- (f32 screen-height) 250.0)})
|
|
resizer (rl/Rectangle {.x 0.0 .y 0.0 .width 14.0 .height 14.0})
|
|
min-width (f32 60.0)
|
|
min-height (f32 60.0)
|
|
max-width (- (f32 screen-width) 50.0)
|
|
max-height (- (f32 screen-height) 160.0)
|
|
last-mouse (rl/Vector2 {.x 0.0 .y 0.0})
|
|
border rl/maroon
|
|
;; Needs the window: the default font is loaded as part of init-window.
|
|
font (rl/get-font-default)]
|
|
|
|
(rl/set-target-fps 60)
|
|
|
|
(until (rl/window-should-close?)
|
|
(when (rl/key-pressed? :space) (set word-wrap? (not word-wrap?)))
|
|
|
|
(let [mouse (rl/get-mouse-position)]
|
|
;; The border fades while the pointer is over the container.
|
|
(cond
|
|
(rl/collision-point-rec? mouse container)
|
|
(set border (rl/fade rl/maroon 0.4))
|
|
(not resizing?) (set border rl/maroon))
|
|
|
|
(if resizing?
|
|
(do
|
|
(when (rl/mouse-button-released? :left) (set resizing? false))
|
|
(let [w (+ (.width container) (- (.x mouse) (.x last-mouse)))
|
|
h (+ (.height container) (- (.y mouse) (.y last-mouse)))]
|
|
(set (.width container)
|
|
(clamp w min-width max-width))
|
|
(set (.height container)
|
|
(clamp h min-height max-height))))
|
|
(when (and (rl/mouse-button-down? :left)
|
|
(rl/collision-point-rec? mouse resizer))
|
|
(set resizing? true)))
|
|
|
|
(set (.x resizer) (- (+ (.x container) (.width container)) 17.0))
|
|
(set (.y resizer) (- (+ (.y container) (.height container)) 17.0))
|
|
(set last-mouse mouse))
|
|
|
|
(rl/begin-drawing)
|
|
(rl/clear-background rl/raywhite)
|
|
|
|
(rl/draw-rectangle-lines-ex container 3.0 border)
|
|
|
|
;; The container with a little padding, which is where the wrap runs.
|
|
(draw-text-boxed font text
|
|
(rl/Rectangle {.x (+ (.x container) 4.0)
|
|
.y (+ (.y container) 4.0)
|
|
.width (- (.width container) 4.0)
|
|
.height (- (.height container) 4.0)})
|
|
20.0 2.0 word-wrap? rl/gray)
|
|
|
|
(rl/draw-rectangle-rec resizer border)
|
|
|
|
(rl/draw-rectangle 0 (- screen-height 54) screen-width 54 rl/gray)
|
|
(rl/draw-rectangle-rec
|
|
(rl/Rectangle {.x 382.0 .y (- (f32 screen-height) 34.0)
|
|
.width 12.0 .height 12.0})
|
|
rl/maroon)
|
|
|
|
(rl/draw-text "Word Wrap: " 313 (- screen-height 115) 20 rl/black)
|
|
(if word-wrap?
|
|
(rl/draw-text "ON" 447 (- screen-height 115) 20 rl/red)
|
|
(rl/draw-text "OFF" 447 (- screen-height 115) 20 rl/black))
|
|
|
|
(rl/draw-text "Press [SPACE] to toggle word wrap"
|
|
218 (- screen-height 86) 20 rl/gray)
|
|
(rl/draw-text "Click hold & drag the to resize the container"
|
|
155 (- screen-height 38) 20 rl/raywhite)
|
|
|
|
(rl/end-drawing))))
|