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 ;;;   http://www.microsoft.com/OpenType/OTSpec/post.htm
  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)
 241   (let* ((glyph-count (read-uint16 stream))
 242          (new-count glyph-count))
 243     (when (/= glyph-count (length names))
 244       (warn "Glyph count in \"post\" table (~D) ~
 245              does not match glyph count in \"maxp\" table (~D). ~
 246              This font may be broken."
 247             glyph-count (length names))
 248       (setf glyph-count (length names)
 249             new-count (length names)))
 250     ;; This is done in a couple passes. First, initialize the names
 251     ;; tables with indexes into either the standard table or the
 252     ;; pstring table. Next, read the pstring table into a vector.
 253     ;; Finally, replace the indexes with names.
 254     (dotimes (i glyph-count)
 255       (let ((name-index (read-uint16 stream)))
 256         (when (< name-index 258)
 257           (decf new-count))
 258         (setf (aref names i) name-index)))
 259     (let ((pstrings (make-array new-count)))
 260       (dotimes (i new-count)
 261         (setf (aref pstrings i) (read-pstring stream)))
 262       (loop for i below glyph-count
 263             for j across names
 264             do
 265             (cond ((< j 258)
 266                    (setf (aref names i)
 267                          (aref *standard-mac-glyph-names* j)))
 268                   (t
 269                    (setf (aref names i)
 270                          (aref pstrings (- j 258)))))))))
 271
 272 (defun load-post-format-3 (names stream)
 273   (declare (ignore stream))
 274   (fill names nil))
 275
 276 (defmethod load-post-info ((font-loader font-loader))
 277   (let ((names (make-array (glyph-count font-loader)
 278                            :initial-element 0))
 279         (stream (input-stream font-loader)))
 280     (seek-to-table "post" font-loader)
 281     (let ((format (read-uint32 stream)))
 282       (when (/= format #x00020000 #x00030000)
 283         (error 'unsupported-format
 284                :location "\"post\" table"
 285                :expected-values (list #x00020000 #x00030000)
 286                :actual-value format))
 287       (setf (italic-angle font-loader) (read-fixed stream)
 288             (underline-position font-loader) (read-fword stream)
 289             (underline-thickness font-loader) (read-fword stream)
 290             (fixed-pitch-p font-loader) (plusp (read-uint32 stream))
 291             (postscript-glyph-names font-loader) names)
 292       ;; skip minMemType* fields
 293       (advance-file-position stream 16)
 294       (case format
 295         (#x00020000 (load-post-format-2 names stream))
 296         (#x00030000 (load-post-format-3 names stream))))))
 297
 298 (defun postscript-uni-name-p (name)
 299   (let ((end (or (position #\. name) (length name))))
 300     (and (= end 7)
 301          (= (mismatch "uni" name) 3)
 302          (loop for i from 3 below end
 303                always (digit-char-p (char name i) 16)))))
 304
 305 (defun postscript-name-code-point (name)
 306   "Returns, if available, the interpretation of the PostScript name NAME as a Unicode code point specifier.
 307 Ref: http://partners.adobe.com/public/developer/opentype/index_glyph.html"
 308   (when (postscript-uni-name-p name)
 309     (parse-integer name :start 3 :end 7 :radix 16)))