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 ;; This is done in a couple passes. First, initialize the names
250 ;; tables with indexes into either the standard table or the
252 (dotimes (i glyph-count
)
253 (setf (aref names i
) (read-uint16 stream
)))
254 ;; Next, read the pstring table into a vector.
255 ;; We can't know the number of extended glyph names in advance but
256 ;; GLYPH-COUNT should be enough in many cases. Note that we cannot
257 ;; compute the number of extended glyph names from the indices
258 ;; preceding the indices might not reference all names.
259 (let ((pstrings (make-array glyph-count
:adjustable t
:fill-pointer
0)))
260 (loop with position
= (+ 2 (* 2 glyph-count
))
261 while
(< position size-without-header
)
262 do
(let ((string (read-pstring stream
)))
263 (vector-push-extend string pstrings
)
264 (incf position
(1+ (length string
)))))
265 ;; Finally, replace the indexes with names.
266 (loop for i below glyph-count
267 for name-index across names
268 do
(setf (aref names i
)
269 (if (< name-index
258)
270 (aref standard-names name-index
)
271 (aref pstrings
(- name-index
258))))))))
273 (defun load-post-format-3 (names stream
)
274 (declare (ignore stream
))
277 (defmethod load-post-info ((font-loader font-loader
))
278 (let* ((names (make-array (glyph-count font-loader
)
280 (stream (input-stream font-loader
))
281 (table-info (table-info "post" font-loader
)))
282 (seek-to-table table-info font-loader
)
283 (let ((format (read-uint32 stream
))
285 (when (/= format
#x00020000
#x00030000
)
286 (error 'unsupported-format
287 :location
"\"post\" table"
288 :expected-values
(list #x00020000
#x00030000
)
289 :actual-value format
))
290 (setf (italic-angle font-loader
) (read-fixed stream
)
291 (underline-position font-loader
) (read-fword stream
)
292 (underline-thickness font-loader
) (read-fword stream
)
293 (fixed-pitch-p font-loader
) (plusp (read-uint32 stream
))
294 (postscript-glyph-names font-loader
) names
)
295 ;; skip minMemType* fields
296 (advance-file-position stream
(- header-size
16))
298 (#x00020000
(load-post-format-2
299 names stream
(- (size table-info
) header-size
)))
300 (#x00030000
(load-post-format-3 names stream
))))))
302 (defun postscript-uni-name-p (name)
303 (let ((end (or (position #\. name
) (length name
))))
305 (= (mismatch "uni" name
) 3)
306 (loop for i from
3 below end
307 always
(digit-char-p (char name i
) 16)))))
309 (defun postscript-name-code-point (name)
310 "Returns, if available, the interpretation of the PostScript name NAME as a Unicode code point specifier.
311 Ref: http://partners.adobe.com/public/developer/opentype/index_glyph.html"
312 (when (postscript-uni-name-p name
)
313 (parse-integer name
:start
3 :end
7 :radix
16)))