1 ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
3 ;;; Redistribution and use in source and binary forms, with or without
4 ;;; modification, are permitted provided that the following conditions
7 ;;; * Redistributions of source code must retain the above copyright
8 ;;; notice, this list of conditions and the following disclaimer.
10 ;;; * Redistributions in binary form must reproduce the above
11 ;;; copyright notice, this list of conditions and the following
12 ;;; disclaimer in the documentation and/or other materials
13 ;;; provided with the distribution.
15 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
16 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
17 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
19 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
20 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
21 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
23 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
24 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
25 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 ;;; "post" table functions
29 ;;; https://docs.microsoft.com/en-us/typography/opentype/spec/post
30 ;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6post.html
32 ;;; $Id: post.lisp,v 1.7 2006/11/09 15:06:16 xach Exp $
34 (in-package #:zpb-ttf
)
36 (defvar *standard-mac-glyph-names
*
56 "zero" "one" "two" "three" "four"
57 "five" "six" "seven" "eight" "nine"
65 "A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"
66 "N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"
73 "a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m"
74 "n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z"
240 (defun load-post-format-2 (names stream size-without-header
)
241 (let* ((standard-names *standard-mac-glyph-names
*)
242 (name-count (length names
))
243 (glyph-count (read-uint16 stream
)))
244 (when (/= glyph-count name-count
)
245 (warn "Glyph count in \"post\" table (~D) ~
246 does not match glyph count in \"maxp\" table (~D). ~
247 This font may be broken."
248 glyph-count name-count
)
249 (setf glyph-count name-count
))
250 ;; This is done in a couple passes. First, initialize the names
251 ;; tables with indexes into either the standard table or the
253 (dotimes (i glyph-count
)
254 (setf (aref names i
) (read-uint16 stream
)))
255 ;; Next, read the pstring table into a vector.
256 ;; We can't know the number of extended glyph names in advance but
257 ;; GLYPH-COUNT should be enough in many cases. Note that we cannot
258 ;; compute the number of extended glyph names from the indices
259 ;; preceding the indices might not reference all names.
260 (let ((pstrings (make-array glyph-count
:adjustable t
:fill-pointer
0)))
261 (loop with position
= (+ 2 (* 2 glyph-count
))
262 while
(< position size-without-header
)
263 do
(let ((string (read-pstring stream
)))
264 (vector-push-extend string pstrings
)
265 (incf position
(1+ (length string
)))))
266 ;; Finally, replace the indexes with names.
267 (loop for i below glyph-count
268 for name-index across names
269 do
(setf (aref names i
)
270 (if (< name-index
258)
271 (aref standard-names name-index
)
272 (aref pstrings
(- name-index
258))))))))
274 (defun load-post-format-3 (names stream
)
275 (declare (ignore stream
))
278 (defmethod load-post-info ((font-loader font-loader
))
279 (let* ((names (make-array (glyph-count font-loader
)
281 (stream (input-stream font-loader
))
282 (table-info (table-info "post" font-loader
)))
283 (seek-to-table table-info font-loader
)
284 (let ((format (read-uint32 stream
))
286 (when (/= format
#x00020000
#x00030000
)
287 (error 'unsupported-format
288 :location
"\"post\" table"
289 :expected-values
(list #x00020000
#x00030000
)
290 :actual-value format
))
291 (setf (italic-angle font-loader
) (read-fixed stream
)
292 (underline-position font-loader
) (read-fword stream
)
293 (underline-thickness font-loader
) (read-fword stream
)
294 (fixed-pitch-p font-loader
) (plusp (read-uint32 stream
))
295 (postscript-glyph-names font-loader
) names
)
296 ;; skip minMemType* fields
297 (advance-file-position stream
(- header-size
16))
299 (#x00020000
(load-post-format-2
300 names stream
(- (size table-info
) header-size
)))
301 (#x00030000
(load-post-format-3 names stream
))))))
303 (defun postscript-uni-name-p (name)
304 (let ((end (or (position #\. name
) (length name
))))
306 (= (mismatch "uni" name
) 3)
307 (loop for i from
3 below end
308 always
(digit-char-p (char name i
) 16)))))
310 (defun postscript-name-code-point (name)
311 "Returns, if available, the interpretation of the PostScript name NAME as a Unicode code point specifier.
312 Ref: http://partners.adobe.com/public/developer/opentype/index_glyph.html"
313 (when (postscript-uni-name-p name
)
314 (parse-integer name
:start
3 :end
7 :radix
16)))