-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathfontsloth-otf-kern.el
167 lines (146 loc) · 6.33 KB
/
fontsloth-otf-kern.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
;;; fontsloth-otf-kern.el --- Kern table portion of an Elisp otf/ttf bindat parser -*- 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, bindat, ttf, otf, parsing
;; 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: the slowest font renderer in the world written in pure
;; elisp. inspired by fontdue
;; fontsloth-otf-typo (this file): uses bindat to parse kern table portion of
;; ttf files
;;; Code:
(require 'bindat)
(require 'cl-lib)
(defun fontsloth-otf-kern--format0-mappings (pairs)
"Index TTF kern table format0 PAIRS."
(let ((mappings (make-hash-table :test 'eq)))
(cl-loop for p across pairs do
(puthash (alist-get 'id p) (alist-get 'value p) mappings))
mappings))
(defun fontsloth-otf-kern--format3-mappings
(glyph-count
left-hand-classes right-hand-classes
left-hand-classes-count right-hand-classes-count
indices kerning-values)
"Index TTF kern table format3 classes.
GLYPH-COUNT number of glyphs
LEFT-HAND-CLASSES sequence of left glyph classes
RIGHT-HAND-CLASSES sequence of right glyph classes
LEFT-HAND-CLASSES-COUNT number of left glyph classes
RIGHT-HAND-CLASSES-COUNT number of right glyph classes
INDICES kerning indices by class pair
KERNING-VALUES the actual kerning values"
(let ((mappings (make-hash-table :test 'eq)))
(dotimes (left glyph-count)
(dotimes (right glyph-count)
(let ((left-class
(elt left-hand-classes left))
(right-class
(elt right-hand-classes right)))
(unless (and (< left-class
left-hand-classes-count)
(< right-class
right-hand-classes-count))
(let* ((index (+ right-class
(* left-class
right-hand-classes-count)))
(index (elt indices index))
(id (logior (ash left 16) right))
(value (elt kerning-values index)))
(puthash id value mappings))))))
mappings))
(defvar fontsloth-otf-kern--format0-spec
(bindat-type
(num-pairs uint 16)
(_ fill 6)
(pairs vec num-pairs type
(bindat-type
(left uint 16)
(right uint 16)
(id unit (logior (ash left 16) right))
(value sint 16 nil)))
(mappings unit (fontsloth-otf-kern--format0-mappings pairs)))
"A spec for kern table format0 pairwise kerning.
see URL `https://developer.apple.com/fonts/TrueType-Reference-Manual/RM06/Chap6kern.html'")
(defvar fontsloth-otf-kern--format3-spec
(bindat-type
(glyph-count uint 16)
(kerning-values-count uint 8)
(left-hand-classes-count uint 8)
(right-hand-classes-count uint 8)
(_ fill 1)
(indices-count unit (* left-hand-classes-count
right-hand-classes-count))
(kerning-values vec kerning-values-count
sint 16 nil)
(left-hand-classes vec glyph-count uint 8)
(right-hand-classes vec glyph-count uint 8)
(indices vec indices-count uint 8)
(mappings
unit
(fontsloth-otf-kern--format3-mappings
glyph-count
left-hand-classes right-hand-classes
left-hand-classes-count
right-hand-classes-count
indices kerning-values)))
"A spec for kern table format3 class based kerning.
see URL `https://developer.apple.com/fonts/TrueType-Reference-Manual/RM06/Chap6kern.html'")
(defvar fontsloth-otf-kern-spec
(bindat-type
(major-version uint 16)
(minor-version type
(if (= 0 major-version)
(bindat-type unit nil)
(bindat-type uint 16)))
(num-sub-tables type
(if (= 0 major-version)
(bindat-type uint 16)
(bindat-type uint 32)))
(sub-tables type
(if (= 0 major-version)
(bindat-type vec num-sub-tables type
(bindat-type
(version uint 16)
(length uint 16)
(format uint 8)
(coverage uint 8)
(tuple-index unit 0)))
(bindat-type vec num-sub-tables type
(bindat-type
(length uint 32)
(coverage uint 8)
(format uint 8)
(tuple-index uint 16)))))
;; only read the first subtable for now
(_ type
(cl-case (alist-get 'format (elt sub-tables 0))
(0 fontsloth-otf-kern--format0-spec)
(3 fontsloth-otf-kern--format3-spec)
(t (bindat-type (mappings unit nil))))))
"A spec for a TTF kern table.
see URL `https://developer.apple.com/fonts/TrueType-Reference-Manual/RM06/Chap6kern.html'")
(provide 'fontsloth-otf-kern)
;;; fontsloth-otf-kern.el ends here