-
Notifications
You must be signed in to change notification settings - Fork 14
/
render.lisp
74 lines (65 loc) · 3.42 KB
/
render.lisp
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
(in-package :freetype2)
;; Render a bunch of glyphs
(defun default-load-render (face char vertical-p)
"=> BITMAP, ADVANCE, TOP, LEFT
This is the default `LOAD-FUNCTION` for `DO-STRING-RENDER`. It is also
called in the case that a custom `LOAD-FUNCTION` returns `NIL`, convenient
for caching.
Custom functions must be compatible, though any (non-`NIL`) value may
be returned in the place of `BITMAP`. Note that cl-freetype2 does nothing
else for you. If you want your cache populated, you must do this yourself,
for instance, within the [`DO-STRING-RENDER`](#DO-STRING-RENDER) loop."
(load-char face char (if vertical-p '(:vertical-layout) '(:default)))
(let ((glyphslot (render-glyph face)))
(values (ft-glyphslot-bitmap glyphslot)
(get-loaded-advance face vertical-p)
(ft-glyphslot-bitmap-left glyphslot)
(ft-glyphslot-bitmap-top glyphslot))))
(export 'default-load-render)
(defmacro do-string-render ((face string bitmap-var x-var y-var
&optional (direction :left-right)
(load-function 'default-load-render))
&body body)
"Load, render, and compute metrics for each character in STRING in
an optimal manner. `FACE` should be set up appropriately (e.g., size).
`BITMAP-VAR` is passed to the block as an ft-bitmap, `X-VAR` and `Y-VAR` are
coordinates for each glyph. `DIRECTION` may be specified as `:left-right`,
`:right-left`, `:up-down`, or `:down-up`. `LOAD-FUNCTION` by default loads
and renders a glyph, returning an `FT-BITMAP`. A custom function may be used
in place to assist in caching. cl-freetype2 does not do any caching itself.
See the documentation for [`DEFAULT-LOAD-RENDER`](#DEFAULT-LOAD-RENDER) for
details."
(once-only (face string)
(with-gensyms (c1 c2 x y left top
advance max-ascender len
kern vertical-p)
`(let ((,max-ascender (face-ascender-pixels ,face))
(,len (length ,string))
(,vertical-p (or (eq ,direction :up-down) (eq ,direction :down-up))))
(loop with ,x = 0.0 and ,y = 0.0
for i from 0 below ,len
as ,c1 = (aref ,string i)
as ,c2 = (if (< i (1- ,len))
(aref ,string (1+ i))
nil)
as ,kern = (if (and ,c2 (not ,vertical-p))
(get-kerning ,face ,c1 ,c2)
0.0)
do
(let (,bitmap-var ,advance ,left ,top)
(multiple-value-setq (,bitmap-var ,advance ,left ,top)
(funcall ,load-function ,face ,c1 ,vertical-p))
,(unless (eq load-function 'default-load-render)
`(unless ,bitmap-var
(multiple-value-setq (,bitmap-var ,advance ,left ,top)
(default-load-render ,face ,c1 ,vertical-p))))
(case ,direction
(:right-left (decf ,x (+ ,advance ,kern)))
(:down-up (decf ,y ,advance)))
(let ((,x-var (round (+ ,x ,left)))
(,y-var (round (+ ,y (- ,max-ascender ,top)))))
,@body)
(case ,direction
(:left-right (incf ,x (+ ,advance ,kern)))
(:up-down (incf ,y ,advance)))))))))
(export 'do-string-render)