post.lisp

   1 ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
   2 ;;;
   3 ;;; Redistribution and use in source and binary forms, with or without
   4 ;;; modification, are permitted provided that the following conditions
   5 ;;; are met:
   6 ;;;
   7 ;;;   * Redistributions of source code must retain the above copyright
   8 ;;;     notice, this list of conditions and the following disclaimer.
   9 ;;;
  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.
  14 ;;;
  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.
  26 ;;;
  27 ;;; "post" table functions
  28 ;;;
  29 ;;;   https://docs.microsoft.com/en-us/typography/opentype/spec/post
  30 ;;;   http://developer.apple.com/fonts/TTRefMan/RM06/Chap6post.html
  31 ;;;
  32 ;;; $Id: post.lisp,v 1.7 2006/11/09 15:06:16 xach Exp $
  33
  34 (in-package #:zpb-ttf)
  35
  36 (defvar *standard-mac-glyph-names*
  37   #(".notdef"
  38     ".null"
  39     "nonmarkingreturn"
  40     "space"
  41     "exclam"
  42     "quotedbl"
  43     "numbersign"
  44     "dollar"
  45     "percent"
  46     "ampersand"
  47     "quotesingle"
  48     "parenleft"
  49     "parenright"
  50     "asterisk"
  51     "plus"
  52     "comma"
  53     "hyphen"
  54     "period"
  55     "slash"
  56     "zero" "one" "two" "three" "four"
  57     "five" "six" "seven" "eight" "nine"
  58     "colon"
  59     "semicolon"
  60     "less"
  61     "equal"
  62     "greater"
  63     "question"
  64     "at"
  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"
  67     "bracketleft"
  68     "backslash"
  69     "bracketright"
  70     "asciicircum"
  71     "underscore"
  72     "grave"
  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"
  75     "braceleft"
  76     "bar"
  77     "braceright"
  78     "asciitilde"
  79     "Adieresis"
  80     "Aring"
  81     "Ccedilla"
  82     "Eacute"
  83     "Ntilde"
  84     "Odieresis"
  85     "Udieresis"
  86     "aacute"
  87     "agrave"
  88     "acircumflex"
  89     "adieresis"
  90     "atilde"
  91     "aring"
  92     "ccedilla"
  93     "eacute"
  94     "egrave"
  95     "ecircumflex"
  96     "edieresis"
  97     "iacute"
  98     "igrave"
  99     "icircumflex"
 100     "idieresis"
 101     "ntilde"
 102     "oacute"
 103     "ograve"
 104     "ocircumflex"
 105     "odieresis"
 106     "otilde"
 107     "uacute"
 108     "ugrave"
 109     "ucircumflex"
 110     "udieresis"
 111     "dagger"
 112     "degree"
 113     "cent"
 114     "sterling"
 115     "section"
 116     "bullet"
 117     "paragraph"
 118     "germandbls"
 119     "registered"
 120     "copyright"
 121     "trademark"
 122     "acute"
 123     "dieresis"
 124     "notequal"
 125     "AE"
 126     "Oslash"
 127     "infinity"
 128     "plusminus"
 129     "lessequal"
 130     "greaterequal"
 131     "yen"
 132     "mu"
 133     "partialdiff"
 134     "summation"
 135     "product"
 136     "pi"
 137     "integral"
 138     "ordfeminine"
 139     "ordmasculine"
 140     "Omega"
 141     "ae"
 142     "oslash"
 143     "questiondown"
 144     "exclamdown"
 145     "logicalnot"
 146     "radical"
 147     "florin"
 148     "approxequal"
 149     "Delta"
 150     "guillemotleft"
 151     "guillemotright"
 152     "ellipsis"
 153     "nonbreakingspace"
 154     "Agrave"
 155     "Atilde"
 156     "Otilde"
 157     "OE"
 158     "oe"
 159     "endash"
 160     "emdash"
 161     "quotedblleft"
 162     "quotedblright"
 163     "quoteleft"
 164     "quoteright"
 165     "divide"
 166     "lozenge"
 167     "ydieresis"
 168     "Ydieresis"
 169     "fraction"
 170     "currency"
 171     "guilsinglleft"
 172     "guilsinglright"
 173     "fi"
 174     "fl"
 175     "daggerdbl"
 176     "periodcentered"
 177     "quotesinglbase"
 178     "quotedblbase"
 179     "perthousand"
 180     "Acircumflex"
 181     "Ecircumflex"
 182     "Aacute"
 183     "Edieresis"
 184     "Egrave"
 185     "Iacute"
 186     "Icircumflex"
 187     "Idieresis"
 188     "Igrave"
 189     "Oacute"
 190     "Ocircumflex"
 191     "apple"
 192     "Ograve"
 193     "Uacute"
 194     "Ucircumflex"
 195     "Ugrave"
 196     "dotlessi"
 197     "circumflex"
 198     "tilde"
 199     "macron"
 200     "breve"
 201     "dotaccent"
 202     "ring"
 203     "cedilla"
 204     "hungarumlaut"
 205     "ogonek"
 206     "caron"
 207     "Lslash"
 208     "lslash"
 209     "Scaron"
 210     "scaron"
 211     "Zcaron"
 212     "zcaron"
 213     "brokenbar"
 214     "Eth"
 215     "eth"
 216     "Yacute"
 217     "yacute"
 218     "Thorn"
 219     "thorn"
 220     "minus"
 221     "multiply"
 222     "onesuperior"
 223     "twosuperior"
 224     "threesuperior"
 225     "onehalf"
 226     "onequarter"
 227     "threequarters"
 228     "franc"
 229     "Gbreve"
 230     "gbreve"
 231     "Idotaccent"
 232     "Scedilla"
 233     "scedilla"
 234     "Cacute"
 235     "cacute"
 236     "Ccaron"
 237     "ccaron"
 238     "dcroat"))
 239
 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
 251     ;; pstring table.
 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))))))))
 272
 273 (defun load-post-format-3 (names stream)
 274   (declare (ignore stream))
 275   (fill names nil))
 276
 277 (defmethod load-post-info ((font-loader font-loader))
 278   (let* ((names (make-array (glyph-count font-loader)
 279                             :initial-element 0))
 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))
 284           (header-size 32))
 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))
 297       (case format
 298         (#x00020000 (load-post-format-2
 299                      names stream (- (size table-info) header-size)))
 300         (#x00030000 (load-post-format-3 names stream))))))
 301
 302 (defun postscript-uni-name-p (name)
 303   (let ((end (or (position #\. name) (length name))))
 304     (and (= end 7)
 305          (= (mismatch "uni" name) 3)
 306          (loop for i from 3 below end
 307                always (digit-char-p (char name i) 16)))))
 308
 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)))