Recipes
Complete examples. Each runs on its own once the systems it uses are loaded:
(asdf:load-system :cl-textrender)
(asdf:load-system :cl-textrender/raster)
(asdf:load-system :cl-textrender/sdf)
(defparameter *sans* "/usr/share/fonts/truetype/dejavu/DejaVuSans.ttf")
(defparameter *sans-bold* "/usr/share/fonts/truetype/dejavu/DejaVuSans-Bold.ttf")
- Measuring text
- A label that fits a box
- Text in an image
- Colored text in an image
- Text as SVG
- Outlines for a curve renderer
- Drawing from a distance field
- A text field
For text placed in a world with y up, see Coordinates and Units.
Measuring text
The size of a string is the size of its layout. Without :width, the text
is not wrapped, so the layout is as wide as its widest line:
(defun text-size (string font)
"Return the width and height STRING takes in FONT, unwrapped."
(let ((layout (tr:layout-text string font)))
(values (tr:layout-width layout) (tr:layout-height layout))))
(tr:with-font (font *sans* :size 16)
(text-size "Hello, world" font))
;; => 94.78125, 18.625
To know how tall text is at a given width, lay it out with :width and read
layout-height. For the advance of a single glyph, font-glyph-advance is
cheaper.
A label that fits a box
A label centered in a box, cut with an ellipsis after as many lines as fit:
(defun fit-label (string font width height)
"Lay out STRING centered in a WIDTH by HEIGHT box, cut with an ellipsis
after as many lines as fit."
(let ((lines (max 1 (floor height (tr:font-line-height font)))))
(tr:layout-text string font :width width :align :center :max-lines lines)))
(tr:with-font (font *sans* :size 16)
(let ((label (fit-label "Settings for the selected node and all of its children"
font 120 40)))
(list (map 'list (lambda (line)
(subseq (tr:layout-string label)
(tr:line-start line) (tr:line-end line)))
(tr:layout-lines label))
(tr:layout-truncated-p label))))
;; => (("Settings for " "the selected") T)
The box holds two lines; the second reads "the selected…". Since
layout-truncated-p is true, show the whole text in a tooltip. To center the
label vertically as well, offset it by half of (- height (layout-height label)).
For a label of one line, such as the cell of a table or a tree, lay it out
with :wrap nil instead: it cuts within a word, where :max-lines 1 cuts
after the last word that fits. See
Typography.
Text in an image
Draw a layout with the raster backend and write it as a binary PGM, a grayscale image any viewer opens:
(defun write-pgm (image path)
"Write IMAGE, a 2D array of octets indexed by row and column, as a binary PGM."
(destructuring-bind (rows columns) (array-dimensions image)
(with-open-file (out path :direction :output :if-exists :supersede)
(format out "P5~%~D ~D~%255~%" columns rows))
(with-open-file (out path :direction :output :element-type '(unsigned-byte 8)
:if-exists :append)
(dotimes (r rows)
(dotimes (c columns)
(write-byte (aref image r c) out))))
path))
(tr:with-font (font *sans* :size 24)
(let ((r (cl-textrender/raster:make-rasterizer))
(layout (tr:layout-text "Pyssel: שלום, world" font :width 160)))
(write-pgm (cl-textrender/raster:render-layout r layout) "hello.pgm")))
The image is white text on black: coverage is 255 where the text is. Write
(- 255 coverage) instead for black on white.
Colored text in an image
Composite each glyph yourself with map-layout-glyphs, in the color its
span gives as :data:
(defun render-rgb (layout rasterizer &key (scale 1) (default '(0 0 0)))
"Return LAYOUT drawn on white as rows of RGB octets, each glyph in the
color its span gives as :DATA, a list (R G B), or in DEFAULT."
(let* ((rows (ceiling (* scale (tr:layout-height layout))))
(columns (ceiling (* scale (tr:layout-width layout))))
(image (make-array (list rows columns 3) :element-type '(unsigned-byte 8)
:initial-element 255)))
(cl-textrender/raster:map-layout-glyphs
(lambda (coverage x y glyph)
(let ((color (or (tr:glyph-data glyph) default)))
(dotimes (r (array-dimension coverage 0))
(dotimes (c (array-dimension coverage 1))
(let ((row (+ y r))
(column (+ x c))
(alpha (/ (aref coverage r c) 255)))
(when (and (< -1 row rows) (< -1 column columns) (plusp alpha))
(loop for k below 3
for ink in color
do (setf (aref image row column k)
(round (+ (* alpha ink)
(* (- 1 alpha) (aref image row column k))))))))))))
rasterizer layout :scale scale)
image))
(defun write-ppm (image path)
"Write IMAGE, rows of RGB octets, as a binary PPM."
(destructuring-bind (rows columns channels) (array-dimensions image)
(declare (ignore channels))
(with-open-file (out path :direction :output :if-exists :supersede)
(format out "P6~%~D ~D~%255~%" columns rows))
(with-open-file (out path :direction :output :element-type '(unsigned-byte 8)
:if-exists :append)
(dotimes (r rows)
(dotimes (c columns)
(dotimes (k 3)
(write-byte (aref image r c k) out)))))
path))
(tr:with-font (font *sans* :size 24)
(tr:with-font (bold *sans-bold* :size 24)
(let ((r (cl-textrender/raster:make-rasterizer))
(layout (tr:layout-text "Error: disk full" font
:spans `((0 6 :font ,bold :data (200 0 0))))))
(write-ppm (render-rgb layout r) "error.ppm"))))
"Error:" comes out bold and red, the rest black. Blending in sRGB values, as here, is the common shortcut; blend in linear light for the most accurate edges.
Text as SVG
Glyph outlines map directly onto SVG path commands. In a :y-axis :down
layout, an outline point (ox, oy) goes at (glyph-x + ox, glyph-y - oy):
(defun glyph-path-data (outline x y)
"Return OUTLINE as SVG path data, with its origin at X, Y in a y-down page."
(with-output-to-string (out)
(dolist (contour (tr:outline-contours outline))
(destructuring-bind (kind x0 y0 &rest more) (first contour)
(declare (ignore kind more))
(format out "M~,2F ~,2F" (+ x x0) (- y y0)))
(dolist (segment contour)
(destructuring-bind (kind &rest c) segment
(ecase kind
(:line (format out "L~,2F ~,2F" (+ x (third c)) (- y (fourth c))))
(:quadratic (format out "Q~,2F ~,2F ~,2F ~,2F"
(+ x (third c)) (- y (fourth c))
(+ x (fifth c)) (- y (sixth c))))
(:cubic (format out "C~,2F ~,2F ~,2F ~,2F ~,2F ~,2F"
(+ x (third c)) (- y (fourth c))
(+ x (fifth c)) (- y (sixth c))
(+ x (seventh c)) (- y (eighth c)))))))
(write-string "Z" out))))
(defun layout-svg (layout)
"Return LAYOUT, a :Y-AXIS :DOWN layout of horizontal text, as an SVG document."
(with-output-to-string (out)
(format out "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"~,2F\" height=\"~,2F\">~%"
(tr:layout-width layout) (tr:layout-height layout))
(tr:do-glyphs (g layout)
(let ((outline (tr:glyph-outline (tr:glyph-font g)
(tr:glyph-id g))))
(unless (tr:outline-empty-p outline)
(format out "<path d=\"~A\"/>~%"
(glyph-path-data outline (tr:glyph-x g) (tr:glyph-y g))))))
(format out "</svg>~%")))
(tr:with-font (font *sans* :size 32)
(layout-svg (tr:layout-text "Lisp" font)))
;; => "<svg xmlns=\"http://www.w3.org/2000/svg\" width=\"63.70\" height=\"37.25\">
;; <path d=\"M3.14 6.38L6.30 6.38L6.30 27.05L17.66 27.05L17.66 29.70L3.14 29.70L3.14 6.38Z\"/>
;; ..."
Each segment's start point is the previous one's end, so path commands need only the rest. SVG's default nonzero fill rule draws holes correctly in both TrueType and CFF fonts.
Outlines for a curve renderer
A Slug-style renderer wants each glyph's curves as quadratics, and where to
put them. cached-quadratics computes each glyph's curves once, and the
font keeps them:
(defun glyph-curves (layout)
"Return a list of (CURVES X Y SIZE) for each inked glyph of LAYOUT: its
packed quadratics in layout units of its font, and where its origin goes."
(let ((result '()))
(tr:do-glyphs (g layout)
(let ((curves (tr:cached-quadratics (tr:glyph-font g)
(tr:glyph-id g))))
(when (plusp (length curves))
(push (list curves (tr:glyph-x g) (tr:glyph-y g)
(tr:font-size (tr:glyph-font g)))
result))))
(nreverse result)))
(tr:with-font (font *sans* :size 16)
(mapcar (lambda (entry) (list (/ (length (first entry)) 6) (second entry) (third entry)))
(glyph-curves (tr:layout-text "Hi" font))))
;; => ((12 0.0 14.8515625) (8 12.03125 14.8515625))
DejaVu Sans draws the H with twelve lines and the i with eight, in two
contours; each line is packed as a quadratic with its control point at its
middle. cl-slug
builds Slug's curve and band textures from shapes like these. A renderer
that shares shapes between sizes takes the curves of the face's font at
size 1, (tr:face-font face 1), so they are in ems, and scales
them by the glyph's font size.
Drawing from a distance field
A distance-field renderer does its work in a shader. This draws one glyph from the distance field atlas on the CPU, sampling the nearest texel, to show the arithmetic the shader does:
(defun median (a b c)
(max (min a b) (min (max a b) c)))
(defun draw-from-field (fields font char pixels-per-em)
"Return CHAR drawn from its field at PIXELS-PER-EM, as rows of octets."
(let* ((region (cl-textrender/sdf:glyph-region fields font
(tr:font-glyph-id font char)))
(page (cl-atlas:region-page region))
(size (cl-atlas:page-size page))
(texels (cl-atlas:copy-page-region page 0 0 size size))
(spread (cl-textrender/sdf:field-atlas-spread fields))
(texels-per-em (cl-textrender/sdf:field-atlas-texels-per-em fields)))
(flet ((channel (x y k)
(/ (aref texels (+ k (* 4 (+ x (* y size))))) 255.0)))
(multiple-value-bind (left bottom right top) (cl-textrender/sdf:glyph-field-bounds region)
(let* ((columns (ceiling (* pixels-per-em (- right left))))
(rows (ceiling (* pixels-per-em (- top bottom))))
(image (make-array (list rows columns) :element-type '(unsigned-byte 8))))
(dotimes (row rows image)
(dotimes (column columns)
;; The pixel's centre in ems, then the texel under it.
(let* ((ex (+ left (/ (+ column 0.5) pixels-per-em)))
(ey (- top (/ (+ row 0.5) pixels-per-em)))
(x (+ (cl-atlas:region-x region)
(min (1- (cl-atlas:region-width region))
(floor (* texels-per-em (- ex left))))))
(y (+ (cl-atlas:region-y region)
(min (1- (cl-atlas:region-height region))
(floor (* texels-per-em (- top ey))))))
(value (median (channel x y 0) (channel x y 1) (channel x y 2)))
;; From 0..1 to ems, then to pixels; positive inside.
(distance (* (- value 0.5) 2 spread pixels-per-em))
(coverage (max 0.0 (min 1.0 (+ distance 0.5)))))
(setf (aref image row column) (round (* 255 coverage)))))))))))
(tr:with-font (font *sans* :size 16)
(write-pgm (draw-from-field (cl-textrender/sdf:make-field-atlas) font #\g 96)
"field.pgm")) ; WRITE-PGM from "Text in an image"
The field is 32 texels to the em, and the glyph is drawn three times as large, at 96 pixels per em, with clean edges. A shader does the same per fragment, with linear filtering instead of the nearest texel.
A text field
A single-font text field: typing, Backspace, arrow keys that keep their column, Shift to select, and clicking. The field keeps the string and the caret, and lays the text out again after each edit:
(defclass text-field ()
((text :initform "" :accessor field-text)
(font :initarg :font :reader field-font)
(width :initarg :width :reader field-width)
(caret :initform 0 :accessor field-caret
:documentation "The caret's text index.")
(anchor :initform nil :accessor field-anchor
:documentation "The other end of the selection, or NIL.")
(goal :initform nil :accessor field-goal
:documentation "The goal MOVE-CARET returned, kept for up and down.")
(layout :initform nil :accessor field-cached-layout)))
(defun field-layout (field)
"Return FIELD's layout, laying its text out again if it changed."
(or (field-cached-layout field)
(setf (field-cached-layout field)
(tr:layout-text (field-text field) (field-font field)
:width (field-width field)))))
(defun field-insert (field string)
"Insert STRING at the caret."
(let ((text (field-text field))
(at (field-caret field)))
(setf (field-text field) (concatenate 'string (subseq text 0 at) string (subseq text at))
(field-caret field) (+ at (length string))
(field-anchor field) nil
(field-goal field) nil
(field-cached-layout field) nil)))
(defun field-backspace (field)
"Delete the grapheme before the caret."
(let* ((end (field-caret field))
(start (tr:previous-caret-index (field-layout field) end))
(text (field-text field)))
(setf (field-text field) (concatenate 'string (subseq text 0 start) (subseq text end))
(field-caret field) start
(field-goal field) nil
(field-cached-layout field) nil)))
(defun field-arrow (field direction &key shift)
"Move the caret as an arrow key does; with SHIFT, extend the selection."
(if shift
(unless (field-anchor field)
(setf (field-anchor field) (field-caret field)))
(setf (field-anchor field) nil))
(multiple-value-bind (index goal)
(tr:move-caret (field-layout field) (field-caret field) direction
(when (member direction '(:up :down)) (field-goal field)))
(setf (field-caret field) index
(field-goal field) goal)))
(defun field-click (field x y)
"Put the caret where the point X, Y is."
(setf (field-caret field) (tr:hit-test (field-layout field) x y)
(field-anchor field) nil
(field-goal field) nil))
(defun field-selection (field)
"Return the rectangles to highlight for the selection."
(let ((anchor (field-anchor field)))
(when anchor
(tr:selection-rectangles (field-layout field) anchor (field-caret field)))))
Drawing it each frame takes the layout's glyphs, field-selection for the
highlight, and caret-segment of the caret for the caret line:
(tr:with-font (font *sans* :size 16)
(let ((field (make-instance 'text-field :font font :width 100)))
(field-insert field "Hello wide world") ; wraps after "wide "
(field-arrow field :up) ; caret 16 -> 6, above it
(field-arrow field :right :shift t) ; select "wi"
(field-arrow field :right :shift t)
(list (field-caret field)
(field-selection field)
(multiple-value-list
(tr:caret-segment (field-layout field) (field-caret field))))))
;; => (8
;; (#S(CL-TEXTRENDER:RECT :X 45.640625 :Y 0.0 :WIDTH 17.53125 :HEIGHT 18.625))
;; (63.171875 0.0 63.171875 18.625))
A real editor also deletes the selection when typing over it, handles
Delete with next-caret-index, and keeps the caret visible by scrolling to
caret-position. Laying the text out after each edit is fine for the text
of a field; for a document, lay out each paragraph on its own and keep the
layouts of the ones that did not change.