-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathfontsloth-raster.el
265 lines (239 loc) · 10.4 KB
/
fontsloth-raster.el
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
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
;;; fontsloth-raster.el --- Elisp otf/ttf font renderer -*- lexical-binding: t -*-
;; Copyright (C) 2021 Jo Gay <[email protected]>
;; Author: Jo Gay <[email protected]>
;; Version: 0.17.0
;; Homepage: https://github.com/jollm/fontsloth
;; Keywords: data, font, rasterization, ttf, otf
;; This program is free software: you can redistribute it and/or modify it
;; under the terms of the GNU General Public License as published by the Free
;; Software Foundation, either version 3 of the License, or (at your option)
;; any later version.
;; This program is distributed in the hope that it will be useful, but WITHOUT
;; ANY WARRANTY; without even the implied warranty of MERCHANTABILITY or
;; FITNESS FOR A PARTICULAR PURPOSE. See the GNU General Public License for
;; more details.
;; You should have received a copy of the GNU General Public License along with
;; this program. If not, see <https://www.gnu.org/licenses/>.
;; This file is NOT part of GNU Emacs.
;; GNU Emacs is free software: you can redistribute it and/or modify
;; it under the terms of the GNU General Public License as published by
;; the Free Software Foundation, either version 3 of the License, or
;; (at your option) any later version.
;; GNU Emacs is distributed in the hope that it will be useful,
;; but WITHOUT ANY WARRANTY; without even the implied warranty of
;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
;; GNU General Public License for more details.
;; You should have received a copy of the GNU General Public License
;; along with this program. If not, see <http://www.gnu.org/licenses/>.
;;; Commentary:
;; Part of fontsloth
;; fontsloth-raster (this file): for now a rip off of fontdue raster
;;; Code:
(require 'cl-lib)
(require 'fontsloth--common-types)
(require 'fontsloth-log)
(cl-defstruct
(fontsloth-raster
(:copier nil))
"A struct to hold the raster output."
(width nil :type 'fixed :documentation "expected width")
(height nil :type 'fixed :documentation "expected height")
(canvas nil :type 'vector :documentation "output goes here"))
(defun fontsloth-raster-create (width height)
"Create a new raster with the given width and height.
WIDTH the expected width
HEIGHT the expected height"
(make-fontsloth-raster :width width :height height
:canvas (make-vector (+ 3 (* width height)) 0)))
(defun fontsloth-raster-fract (f)
"Return the fractional part of float `f'.
F float to fract"
(- f (truncate f)))
(defun fontsloth-raster-add (raster index height mid-x)
"Add a raster output at the given index and coordinates.
RASTER the raster to update
INDEX the raster index
HEIGHT the computed height of the output
MID-X the computed mid x coord of the output"
(let ((c (fontsloth-raster-canvas raster))
(m (* height mid-x)))
(aset c index (+ (- height m) (aref c index)))
(aset c (1+ index) (+ (aref c (1+ index)) m))))
(defun fontsloth-raster-v-line (raster line coords)
"Rasterize a v-line.
RASTER the raster to update
LINE the v-line
COORDS the scaled coordinates"
(let* ((x0 (aref coords 0)) (y0 (aref coords 1)) (y1 (aref coords 3))
(nudge (fontsloth-line-nudge line))
(temp `(,(truncate (- (aref coords 0) (aref nudge 0)))
,(truncate (- (aref coords 1) (aref nudge 1)))
,(truncate (- (aref coords 2) (aref nudge 2)))
,(truncate (- (aref coords 3) (aref nudge 3)))))
(stx (car temp)) (sty (cadr temp)) (ex (caddr temp)) (ey (cadddr temp))
(adj (fontsloth-line-adjustment line))
(target-y (+ (aref adj 1) (cadr temp)))
(sy (copysign 1.0 (- y1 y0)))
(y-prev y0)
(index (truncate (+ stx (* sty (fontsloth-raster-width raster) 1.0))))
(index-y-inc (truncate
(copysign (* 1.0 (fontsloth-raster-width raster)) sy)))
(dist (truncate (abs (- sty ey))))
(mid-x (fontsloth-raster-fract x0)))
(fontsloth:debug* fontsloth-log
(concat
"start v-line: "
"dist %s stx %s sty %s ex %s ey %s
"
"index %s index-y-inc %s")
dist stx sty ex ey
index index-y-inc)
(dotimes (_ dist)
(fontsloth-raster-add raster index (- y-prev target-y) mid-x)
(setf index (+ index index-y-inc))
(setf y-prev target-y)
(setf target-y (+ target-y sy))
(fontsloth:debug* fontsloth-log "index %s index-y-inc %s"
index index-y-inc))
(fontsloth-raster-add
raster (truncate (+ ex (* ey (fontsloth-raster-width raster))))
(- y-prev y1) mid-x))
(fontsloth:debug* fontsloth-log "end v-line"))
(defun fontsloth-raster-m-line (raster line coords params)
"Rasterize an m-line.
RASTER the raster to update
LINE the m-line
COORDS the scaled coordinates
PARAMS the scaled parameters"
(let* ((x0 (aref coords 0)) (y0 (aref coords 1))
(x1 (aref coords 2)) (y1 (aref coords 3))
(nudge (fontsloth-line-nudge line))
(temp `(,(truncate (- (aref coords 0) (aref nudge 0)))
,(truncate (- (aref coords 1) (aref nudge 1)))
,(truncate (- (aref coords 2) (aref nudge 2)))
,(truncate (- (aref coords 3) (aref nudge 3)))))
(stx (car temp)) (sty (cadr temp)) (ex (caddr temp)) (ey (cadddr temp))
(tdx (aref params 0)) (tdy (aref params 1))
(dx (aref params 2)) (dy (aref params 3))
(adj (fontsloth-line-adjustment line))
(target-x (+ (aref adj 0) (car temp)))
(target-y (+ (aref adj 1) (cadr temp)))
(sx (copysign 1.0 tdx))
(sy (copysign 1.0 tdy))
(tmx (* tdx (- target-x x0))) (tmy (* tdy (- target-y y0)))
(tdx (abs tdx)) (tdy (abs tdy))
(x-prev x0) (y-prev y0)
(index (truncate (+ stx (* sty (fontsloth-raster-width raster)))))
(index-x-inc (truncate sx))
(index-y-inc (truncate
(copysign (* 1.0 (fontsloth-raster-width raster)) sy)))
(dist (+ (abs (- stx ex)) (abs (- sty ey)))))
(fontsloth:debug*
fontsloth-log
(concat "start m-line: "
"x0 %.6f y0 %.6f x1 %.6f y1 %.6f
"
"dist %s stx %s sty %s ex %s ey %s
"
"tdx %.6f tdy %.6f dx %.6f dy %.6f tmx %.6f tmy %.6f
"
"index %s index-x-inc %s index-y-inc %s")
x0 y0 x1 y1
dist stx sty ex ey
tdx tdy dx dy tmx tmy
index index-x-inc index-y-inc)
(dotimes (_ dist)
(let ((prev-index index)
(y-next) (x-next))
(if (< tmx tmy)
(setf y-next (+ y0 (* dy tmx))
x-next target-x
tmx (+ tmx tdx)
target-x (+ target-x sx)
index (+ index index-x-inc))
(setf y-next target-y
x-next (+ x0 (* dx tmy))
tmy (+ tmy tdy)
target-y (+ target-y sy)
index (+ index index-y-inc)))
(fontsloth-raster-add raster prev-index (- y-prev y-next)
(fontsloth-raster-fract (/ (+ x-prev x-next)
2.0)))
(setf x-prev x-next y-prev y-next)
(fontsloth:debug* fontsloth-log "index %s index-x-inc %s index-y-inc %s"
index index-x-inc index-y-inc)))
(fontsloth-raster-add raster
(truncate (+ ex
(* (fontsloth-raster-width raster) ey)))
(- y-prev y1)
(fontsloth-raster-fract (/ (+ x-prev x1) 2.0)))
(fontsloth:debug* fontsloth-log "end m-line")))
(declare-function fontsloth-glyph-v-lines "fontsloth-geometry")
(declare-function fontsloth-glyph-m-lines "fontsloth-geometry")
(defun fontsloth-raster-draw (raster glyph scale-x scale-y offset-x offset-y)
"Enter into the raster with a given outlined GLYPH and scaling/offset.
RASTER the raster in which to draw
SCALE-X x scale
SCALE-Y y scale
OFFSET-X x offset
OFFSET-Y y offset"
(let ((params `(,(/ 1.0 scale-x) ,(/ 1.0 scale-y) ,scale-x ,scale-y)))
(cl-flet ((scale-off (coords)
(vector (+ offset-x (* scale-x (aref coords 0)))
(+ offset-y (* scale-y (aref coords 1)))
(+ offset-x (* scale-x (aref coords 2)))
(+ offset-y (* scale-y (aref coords 3)))))
(parameterize (lparams)
(vector (* (car params) (aref lparams 0))
(* (cadr params) (aref lparams 1))
(* (caddr params) (aref lparams 2))
(* (cadddr params) (aref lparams 3)))))
(cl-loop for ln across (fontsloth-glyph-v-lines glyph) do
(fontsloth-raster-v-line
raster ln (scale-off (fontsloth-line-coords ln))))
(cl-loop for ln across (fontsloth-glyph-m-lines glyph) do
(fontsloth-raster-m-line
raster ln
(scale-off (fontsloth-line-coords ln))
(parameterize (fontsloth-line-params ln)))))))
(defun fontsloth-raster-get-pixel (raster length)
"Get the pixelated output of the raster.
RASTER the raster
LENGTH the expected length"
(cl-flet ((clamp (in min max)
(cond ((> min in) min)
((< max in) max)
(t in))))
(let ((canvas (fontsloth-raster-canvas raster))
(output (make-vector length 0))
(height 0.0))
(dotimes (i length)
(setf height (+ height (elt canvas i)))
(aset output i (truncate (clamp (* (abs height) 255.9) 0.0 255.0))))
output)))
(cl-defun fontsloth-raster-npbm (pixel width height &optional (format 'pgm))
"Insert the pixelated raster output into a NetPBM format.
PIXEL vector of pixel bytes
WIDTH the glyph outline width
HEIGHT the glyph outline height
FORMAT optional 'ppm, 'pgm, or 'pbm, default 'pgm"
(let ((formats '((ppm . "P6
")
(pgm . "P5
")
(pbm . "P4
"))))
(cl-flet ((vec->str (v s)
(dotimes (i (length v))
(aset s i (aref v i)))
s))
(let* ((pixel-str (make-string (length pixel) 0 nil))
(npbm (concat (alist-get format formats)
(number-to-string width)
" "
(number-to-string height) "
255
")))
(concat npbm (vec->str pixel pixel-str))))))
(provide 'fontsloth-raster)
;;; fontsloth-raster.el ends here