Browse Source

Create new path for typesetting

* With the typesetting path, a buffer of render rectangles is used
rather than rendering immediately. This allows me to save the
redundant typesetting that occurs when getting the size and then
rendering by re-typesetting. It is consistently faster this way,
though uses more stack space.
* Use cached space width rather than having to look it up every time
Macoy Madson 11 months ago
  1. 10
  2. 346


@ -102,6 +102,8 @@
;; Default line spacing (baseline-to-baseline)
font-height uint16_t
;; The advance of a single space character
space-width uint16_t
subpixel-antialiasing-enabled bool
@ -309,6 +311,14 @@
(dict-set-struct (path font-atlas-out > kerning-lookup-table)
;; Cache width of a space for quick lookup
(var space-key char ' ')
(var glyph (addr glyph-entry)
(dict-ptr-at (path font-atlas-out > glyph-lookup-table) space-key))
(when glyph
(set (path font-atlas-out > space-width) (path glyph > advance-x))))
(return 0))
;; Returns 0 if succeeded


@ -7,7 +7,7 @@
&with-decls "FreeType.cake")
(c-import &with-decls "<stdbool.h>")
(c-import "<assert.h>" &with-decls "<stdbool.h>")
(forward-declare (struct SDL_Renderer)
(struct SDL_Texture)
@ -26,6 +26,195 @@
(var-global c-string-null-terminated (unsigned int) UINT32_MAX)
;; Create our own associations to save space and keep SDL separate
(defstruct typeset-render-glyph
source-x uint16_t
source-y uint16_t
destination-x int16_t
destination-y int16_t
width uint16_t
height uint16_t)
(defstruct typeset-string-parameters
;; Mandatory
font (addr font-atlas-texture)
render-glyphs-out (addr typeset-render-glyph)
max-num-render-glyphs int
used-num-render-glyphs-out int
atlas-texture-dirty bool
;; Optional
characters-to-rects-out (addr uint32_t) ;; must be >= max-num-render-glyphs. Offset into string.
write-x int ;; In and out
write-y int
;; The bounds of the entire run
min-x int
min-y int
max-x int
max-y int)
;; TODO: If I used OpenGL instead, this could be a single buffer update for the whole run and a
;; shader could blow through it.
(defun-local sdl-render-typeset-glyphs (renderer (addr SDL_Renderer)
font-texture (addr SDL_Texture)
offset-x int offset-y int
glyphs (addr typeset-render-glyph)
num-glyphs int)
(each-in-range num-glyphs glyph-index
(var glyph (addr typeset-render-glyph) (addr (at glyph-index glyphs)))
(var source-rectangle SDL_Rect
(array (path glyph > source-x)
(path glyph > source-y)
(path glyph > width)
(path glyph > height)))
(var destination-rectangle SDL_Rect
(+ offset-x (path glyph > destination-x))
(+ offset-y (path glyph > destination-y))
(path glyph > width)
(path glyph > height)))
(SDL_RenderCopy renderer font-texture (addr source-rectangle)
(addr destination-rectangle))))
;; The min and max arguments are expected to be initialized to reasonable values, e.g. positive
;; infinity and negative infinity, respectively. You can render several strings separately and keep
;; the same running bounds.
;; When length-limit is c-string-null-terminated, render until null terminator
;; Returns the number of characters that were typeset into render-glyphs-out. This is NOT the same
;; as used-num-render-glyphs-out because some glyphs are built from more than one character.
(defun typeset-string (args (addr typeset-string-parameters)
str-utf-8 (addr (const char)) length-limit (unsigned int)
&return int)
(assert (and args
(path args > font)
(path args > render-glyphs-out)))
(var num-characters-typeset int 0)
(var font (addr font-atlas-texture) (path args > font))
(var space-width int (path font > atlas . space-width))
(var tab-width int (* space-width 4))
(var line-height int (path font > atlas . font-height))
;; Assumes that we're always starting a line. Don't use this function to layout blocks of text.
(var start-x int (path args > write-x))
;; If the string begins with a long series of indentation, we want to count it in its dimensions
;; (for other dimensions, we count actual rendered glyph size)
(when (and (< (path args > min-x) start-x))
(set (path args > min-x) start-x))
(each-char-in-string-const str-utf-8 current-char
;; Note that the kerning has already been applied for the next character, so it's fine to break
;; right in the middle of the string and resume on another call
(when (or (>= (- current-char str-utf-8) length-limit)
(>= (path args > used-num-render-glyphs-out)
(path args > max-num-render-glyphs)))
(set num-characters-typeset (- current-char str-utf-8 1))
((= (deref current-char) '\r')
((= (deref current-char) '\n')
(set (path args > write-y) (+ line-height (path args > write-y)))
(set (path args > write-x) start-x)
((= (deref current-char) '\t')
(set (path args > write-x) (+ (path args > write-x) tab-width))
;; Ensure we don't try to read past the end of our length limit even if the UTF-8 character
;; requests more bytes than the limit
(var max-num-characters-to-decode int 4)
(each-in-range 4 lookahead
(unless (at lookahead current-char)
(set max-num-characters-to-decode lookahead)
(var advance-by (unsigned char) 1)
(var is-valid-codepoint bool false)
(var codepoint uint32_t
(decode-utf-8-code-point current-char max-num-characters-to-decode (addr advance-by)
(addr is-valid-codepoint)))
(unless is-valid-codepoint
;; We won't even render anything because we might have started in-between codepoints, which
;; is different from a valid codepoint with a missing glyph
(var glyph (addr glyph-entry)
(dict-ptr-at (path font > atlas . glyph-lookup-table) codepoint))
(unless glyph ;; fallback
(when (path font > texture)
;; Let's try to render the glyph
(if (= 0 (font-atlas-attempt-add-glyph (addr (path font > atlas)) codepoint))
(scope ;; Successfully added it
(set glyph (dict-ptr-at (path font > atlas . glyph-lookup-table) codepoint))
(set (path args > atlas-texture-dirty) true))
;; This font doesn't have this glyph; Let's assign it to a missing character
;; indicator ("tofu" etc.)
(var-cast-to replacement-codepoint uint32_t '?')
(set glyph (dict-ptr-at (path font > atlas . glyph-lookup-table) replacement-codepoint))
(when glyph
(var replacement-glyph glyph-entry (deref glyph))
(set (field replacement-glyph key) codepoint)
(dict-set-struct (path font > atlas . glyph-lookup-table) replacement-glyph)))))
(unless glyph
(set codepoint '?')
(set glyph (dict-ptr-at (path font > atlas . glyph-lookup-table) codepoint)))
(unless glyph ;; even the fallback is missing!
(when (path args > characters-to-rects-out)
(set (at (path args > used-num-render-glyphs-out) (path args > characters-to-rects-out))
(- current-char str-utf-8)))
(var write-glyph (addr typeset-render-glyph)
(addr (at (path args > used-num-render-glyphs-out)
(path args > render-glyphs-out))))
(set-fields (deref write-glyph)
source-x (path glyph > x)
source-y (path glyph > y)
destination-x (+ (path args > write-x) (path glyph > to-origin-left))
destination-y (- (path args > write-y) (path glyph > to-origin-top))
width (path glyph > width)
height (path glyph > height))
(incr (path args > used-num-render-glyphs-out))
(set (path args > write-x) (+ (path args > write-x) (path glyph > advance-x)))
(when (< (path write-glyph > destination-x) (path args > min-x))
(set (path args > min-x) (path write-glyph > destination-x)))
(when (< (path write-glyph > destination-y) (path args > min-y))
(set (path args > min-y) (path write-glyph > destination-y)))
(when (> (+ (path write-glyph > destination-x)
(path write-glyph > width))
(path args > max-x))
(set (path args > max-x)
(+ (path write-glyph > destination-x)
(path write-glyph > width))))
(when (> (+ (path write-glyph > destination-y)
(path write-glyph > height))
(path args > max-y))
(set (path args > max-y) (+ (path write-glyph > destination-y)
(path write-glyph > height))))
;; TODO: UTF-8 kerning!
;; TODO: Think how length limit interacts with this +1
(when (and s-enable-kerning (+ 1 current-char))
(var character-pair uint64_t (font-atlas-make-character-pair
(type-cast (deref current-char) uint32_t)
(type-cast (at 1 current-char) uint32_t)))
(var kerning (addr kerning-entry)
(dict-ptr-at (path font > atlas . kerning-lookup-table) character-pair))
(when kerning
(set (path args > write-x) (+ (path args > write-x) (path kerning > x)))))
;; For multi-byte characters: skip the partial codes
;; -1 because we're just about to increment current-char in our loop
(set current-char (+ current-char (- advance-by 1))))
;; Include any spaces or tabs in the dimensions
(when (> (path args > write-x)
(path args > max-x))
(set (path args > max-x)
(path args > write-x)))
(return num-characters-typeset))
;; If renderer or font-texture are null, this will still traverse the string
;; The min and max arguments can be null. Otherwise, they are expected to be initialized to
;; reasonable values, e.g. positive infinity and negative infinity, respectively. This way, you can
@ -37,12 +226,8 @@
min-x-out (addr int) min-y-out (addr int)
max-x-out (addr int) max-y-out (addr int)
str-utf-8 (addr (const char)) length-limit (unsigned int))
(var tab-width int 100)
(scope ;; Get tab width based on space advance
(var space-key char ' ')
(var glyph (addr glyph-entry) (dict-ptr-at (path font > atlas . glyph-lookup-table) space-key))
(when glyph
(set tab-width (* 4 (path glyph > advance-x)))))
(var space-width int (path font > atlas . space-width))
(var tab-width int (* space-width 4))
(var line-height int (path font > atlas . font-height))
@ -361,6 +546,153 @@
x (+ (path state > x) prospective-write-x)
y (+ (path state > y) prospective-write-y))))))
(defun layout-typeset-render-string (render-settings (addr font-render-settings)
state (addr font-layout-state)
str (addr (const char)) str-length-limit (unsigned int))
;; We need to add some wiggle room otherwise the words with descenders will start appearing
;; before ones without, because we're checking clipping per word instead of per line
(var clip-rect-with-tolerance font-render-rectangle (path render-settings > clip-rect))
(var font-height int (path render-settings > font > atlas . font-height))
(set-fields clip-rect-with-tolerance
y (- (field clip-rect-with-tolerance y) font-height)
height (+ (field clip-rect-with-tolerance height) (* 2 font-height)))
(path render-settings > font > texture)
(path render-settings > r) (path render-settings > g) (path render-settings > b))
;; Used to efficiently trim spaces after wrapping so we don't re-typeset
(var space-width int (path render-settings > font > atlas . space-width))
(var wrap-at-pixel int (+ (path render-settings > start-x)
(path render-settings > wrap-width-pixels)))
(var render-glyphs (array 1024 typeset-render-glyph) (array 0))
(var characters-to-rects (array 1024 uint32_t) (array 0))
(var typeset-args typeset-string-parameters (array 0))
(set-fields typeset-args
font (path render-settings > font)
render-glyphs-out render-glyphs
max-num-render-glyphs (array-size render-glyphs)
used-num-render-glyphs-out 0
atlas-texture-dirty false
characters-to-rects-out characters-to-rects
write-x 0
write-y 0
min-x INT_MAX
min-y INT_MAX
max-x INT_MIN
max-y INT_MIN)
(var read-head (addr (const char)) str)
(while (and (< (- read-head str) str-length-limit)
(deref read-head))
(var current-start (addr (const char)) read-head)
(var word-length (unsigned int) str-length-limit)
;; Find good break point (word boundary etc.)
(each-char-in-string-const current-start current-char
(when (>= (- current-char str) str-length-limit)
(set word-length (- current-char current-start))
(set read-head current-char)
(when (= (deref (+ 1 current-char)) 0)
(set word-length (- (+ 1 current-char) current-start))
(set read-head (+ 1 current-char))
(when (and (!= current-char read-head)
(or (= (deref current-char) '\n')
(= (deref current-char) '\t')
(= (deref current-char) ' ')))
(set word-length (- current-char current-start))
(set read-head current-char)
;; Always typeset from zero and offset at render time, for simplicity's sake
(set-fields typeset-args
used-num-render-glyphs-out 0
write-x 0
write-y 0
min-x INT_MAX
min-y INT_MAX
max-x INT_MIN
max-y INT_MIN)
(typeset-string (addr typeset-args)
current-start word-length)
;; We may have lazily rendered some new glyphs in get-string-render-size; let's check and
;; update the texture if necessary.
(when (field typeset-args atlas-texture-dirty)
(update-font-atlas-texture (path render-settings > font))
(set (field typeset-args atlas-texture-dirty) false))
;; Handle wrapping
(when (= '\n' (at 0 current-start))
(set (path state > x) (path render-settings > start-x)))
;; This one word is longer than an entire line
;; TODO: Force breaks
((> (field typeset-args max-x) (path render-settings > wrap-width-pixels))
(set (path state > x) (path render-settings > start-x))
(set (path state > y) (+ (path state > y) (path render-settings > font > atlas . font-height))))
;; Word will go over. Wrap to the next line
((> (+ (field typeset-args max-x) (path state > x)) wrap-at-pixel)
(set (path state > x) (path render-settings > start-x))
(set (path state > y) (+ (path state > y) (path render-settings > font > atlas . font-height)))
;; I *think* for tabs you want to keep the tab visible if it wraps
;; For space, we'll trim it off.
(when (= ' ' (deref current-start))
(incr current-start)
(decr word-length)
;; Offset the string to the left so that it appears as if it had no space. We won't bother
;; changing the render rects because space should be non-printing anyways
(set (path state > x) (- (path state > x) space-width)))))
;; Calculate clip
(var string-bounds font-render-rectangle
(+ (field typeset-args min-x) (path state > x))
(+ (field typeset-args min-y) (path state > y))
(- (field typeset-args max-x) (field typeset-args min-x))
(- (field typeset-args max-y) (field typeset-args min-y))))
(var word-within-clip-rect bool
(or (not (path render-settings > clip-rect . width))
(not (path render-settings > clip-rect . height))
(font-rects-overlap (addr clip-rect-with-tolerance) (addr string-bounds))))
;; If the string ends with a space and happens to wrap exactly on that space, we can end up
;; trying to render a zero-length word. Instead, we will absorb the space completely. If it was
;; "significant", the alignment would have been messed up anyways due to wrapping.
(when (and word-length
(path render-settings > renderer)
(path render-settings > font > texture)
(path state > x) (path state > y)
(field typeset-args render-glyphs-out)
(field typeset-args used-num-render-glyphs-out))
(scope ;; Pointer
(var mouse-x int 0)
(var mouse-y int 0)
(SDL_GetMouseState (addr mouse-x) (addr mouse-y))
(when (and (>= mouse-x (field string-bounds x))
(>= mouse-y (field string-bounds y))
(< mouse-x (+ (field string-bounds x) (field string-bounds width)))
(< mouse-y (+ (field string-bounds y) (field string-bounds height))))
(var string-rect SDL_Rect
(array (field string-bounds x)
(field string-bounds y)
(field string-bounds width)
(field string-bounds height)))
(SDL_SetRenderDrawColor (path render-settings > renderer) 255 0 0 255)
(SDL_RenderDrawRect (path render-settings > renderer) (addr string-rect)))))
;; Regardless of whether we clip or not, advance the write head
;; Note that if we trimmed the prefixed space, we already moved state > x back such that adding
;; write-x (which includes the space) will end up with state > x in the correct position
(set-fields (deref state)
x (+ (path state > x) (field typeset-args write-x))
y (+ (path state > y) (field typeset-args write-y)))))
(defun make-font-atlas-and-texture (renderer (addr SDL_Renderer)
font-atlas-out (addr font-atlas-texture)
font-data (addr (const (unsigned char))) font-data-size (unsigned int)