zpb-ttf-0.7/ 0040775 0000764 0000764 00000000000 10524643132 011414 5 ustar xach xach zpb-ttf-0.7/zpb-ttf.asd 0100664 0000764 0000764 00000006760 10411055337 013500 0 ustar xach xach ;; zpb-ttf.asd,v 1.5 2006/03/24 20:47:27 xach Exp
(defpackage #:zpb-ttf-system
(:use #:cl #:asdf))
(in-package #:zpb-ttf-system)
(defsystem #:zpb-ttf
:version "0.5"
:components ((:file "package")
(:file "util"
:depends-on ("package"))
(:file "conditions"
:depends-on ("package"))
(:file "bounding-box"
:depends-on ("package"))
(:file "font-loader"
:depends-on ("package"
"util"
"bounding-box"))
(:file "maxp"
:depends-on ("package"
"util"
"font-loader"))
(:file "head"
:depends-on ("package"
"util"
"conditions"
"font-loader"))
(:file "kern"
:depends-on ("package"
"util"
"conditions"
"font-loader"))
(:file "loca"
:depends-on ("package"
"util"
"font-loader"))
(:file "name"
:depends-on ("package"
"util"
"conditions"
"font-loader"))
(:file "cmap"
:depends-on ("package"
"util"
"name"
"font-loader"))
(:file "post"
:depends-on ("package"
"util"
"conditions"
"font-loader"))
(:file "hhea"
:depends-on ("package"
"util"
"font-loader"))
(:file "hmtx"
:depends-on ("package"
"util"
"font-loader"
"hhea"))
(:file "glyf"
:depends-on ("package"
"util"
"loca"
"font-loader"))
(:file "glyph"
:depends-on ("package"
"util"
"font-loader"
"bounding-box"
"glyf"
"kern"
"loca"))
(:file "font-loader-interface"
:depends-on ("package"
"util"
"conditions"
"font-loader"
"maxp"
"head"
"kern"
"loca"
"name"
"cmap"
"post"
"hhea"
"hmtx"))))
zpb-ttf-0.7/maxp.lisp 0100664 0000764 0000764 00000003563 10375725047 013270 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the "maxp" table.
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/maxp.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6maxp.html
;;;
;;; maxp.lisp,v 1.3 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
(defmethod load-maxp-info ((font-loader font-loader))
(seek-to-table "maxp" font-loader)
(with-slots (input-stream glyph-count) font-loader
(let ((version (read-uint32 input-stream)))
(check-version "\"maxp\" table" version #x00010000)
(setf glyph-count (read-uint16 input-stream)))))
zpb-ttf-0.7/hmtx.lisp 0100664 0000764 0000764 00000004310 10375725047 013272 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the "hmtx" table.
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/hmtx.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6hmtx.html
;;;
;;; hmtx.lisp,v 1.3 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
(defmethod load-hmtx-info ((font-loader font-loader))
(let* ((horizontal-metrics-count (horizontal-metrics-count font-loader))
(advance-widths (make-array horizontal-metrics-count))
(left-side-bearings (make-array horizontal-metrics-count)))
(seek-to-table "hmtx" font-loader)
(with-slots (input-stream) font-loader
(dotimes (i horizontal-metrics-count)
(setf (svref advance-widths i) (read-uint16 input-stream))
(setf (svref left-side-bearings i) (read-int16 input-stream))))
(setf (advance-widths font-loader) advance-widths
(left-side-bearings font-loader) left-side-bearings)))
zpb-ttf-0.7/cmap.lisp 0100664 0000764 0000764 00000021502 10410617744 013226 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the "cmap" table.
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/cmap.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6cmap.html
;;;
;;; cmap.lisp,v 1.15 2006/03/23 22:23:32 xach Exp
(in-package #:zpb-ttf)
(deftype cmap-value-table ()
`(array (unsigned-byte 16) (*)))
;;; FIXME: "unicode-cmap" is actually a format 4 character map that
;;; happens to currently be loaded from a Unicode-compatible
;;; subtable. However, other character maps (like Microsoft's Symbol
;;; encoding) also use format 4 and could be loaded with these
;;; "unicode" objects and functions.
(defclass unicode-cmap ()
((segment-count :initarg :segment-count :reader segment-count)
(end-codes :initarg :end-codes :reader end-codes)
(start-codes :initarg :start-codes :reader start-codes)
(id-deltas :initarg :id-deltas :reader id-deltas)
(id-range-offsets :initarg :id-range-offsets :reader id-range-offsets)
(glyph-indexes :initarg :glyph-indexes :accessor glyph-indexes)))
(defun load-unicode-cmap (stream)
"Load a Unicode character map of type 4 from STREAM starting at the
current offset."
(let ((format (read-uint16 stream)))
(when (/= format 4)
(error 'unsupported-format
:location "\"cmap\" subtable"
:actual-value format
:expected-values (list 4))))
(let ((table-start (- (file-position stream) 2))
(subtable-length (read-uint16 stream))
(language-code (read-uint16 stream))
(segment-count (/ (read-uint16 stream) 2))
(search-range (read-uint16 stream))
(entry-selector (read-uint16 stream))
(range-shift (read-uint16 stream)))
(declare (ignore language-code search-range entry-selector range-shift))
(flet ((make-and-load-array (&optional (size segment-count))
(loop with array = (make-array size
:element-type '(unsigned-byte 16)
:initial-element 0)
for i below size
do (setf (aref array i) (read-uint16 stream))
finally (return array)))
(make-signed (i)
(if (logbitp 15 i)
(1- (- (logandc2 #xFFFF i)))
i)))
(let ((end-codes (make-and-load-array))
(pad (read-uint16 stream))
(start-codes (make-and-load-array))
(id-deltas (make-and-load-array))
(id-range-offsets (make-and-load-array))
(glyph-index-array-size (/ (- subtable-length
(- (file-position stream)
table-start))
2)))
(declare (ignore pad))
(make-instance 'unicode-cmap
:segment-count segment-count
:end-codes end-codes
:start-codes start-codes
;; these are really signed, so sign them
:id-deltas (map 'vector #'make-signed id-deltas)
:id-range-offsets id-range-offsets
:glyph-indexes (make-and-load-array glyph-index-array-size))))))
(defmethod invert-character-map (font-loader)
"Return a vector mapping font indexes to code points."
(with-slots (start-codes end-codes)
(character-map font-loader)
(declare (type cmap-value-table start-codes end-codes))
(let ((points (make-array (glyph-count font-loader) :initial-element -1)))
(dotimes (i (1- (length end-codes)) points)
(loop for j from (aref start-codes i) to (aref end-codes i)
for font-index = (code-point-font-index j font-loader)
when (minusp (svref points font-index)) do
(setf (svref points font-index) j))))))
(defgeneric code-point-font-index (code-point font-loader)
(:documentation "Return the index of the Unicode CODE-POINT in
FONT-LOADER, if present, otherwise NIL.")
(:method (code-point font-loader)
(let ((cmap (character-map font-loader)))
(with-slots (end-codes start-codes
id-deltas id-range-offsets
glyph-indexes)
cmap
(declare (type cmap-value-table
end-codes start-codes
id-deltas id-range-offsets
glyph-indexes))
(dotimes (i (segment-count cmap) 1)
(when (<= code-point (aref end-codes i))
(return
(let ((start-code (aref start-codes i))
(id-range-offset (aref id-range-offsets i))
(id-delta (aref id-deltas i)))
(cond ((< code-point start-code)
0)
((zerop id-range-offset)
(logand #xFFFF (+ code-point id-delta)))
(t
(let* ((glyph-index-offset (- (+ i
(ash id-range-offset -1)
(- code-point start-code))
(segment-count cmap)))
(glyph-index (aref (glyph-indexes cmap)
glyph-index-offset)))
(logand #xFFFF
(+ glyph-index id-delta)))))))))))))
(defgeneric font-index-code-point (glyph-index font-loader)
(:documentation "Return the code-point for a given glyph index.")
(:method (glyph-index font-loader)
(let ((point (aref (inverse-character-map font-loader) glyph-index)))
(if (plusp point)
point
0))))
(defmethod load-cmap-info ((font-loader font-loader))
(seek-to-table "cmap" font-loader)
(with-slots (input-stream)
font-loader
(let ((start-pos (file-position input-stream))
(version-number (read-uint16 input-stream))
(subtable-count (read-uint16 input-stream))
(foundp nil))
(declare (ignore version-number))
(loop repeat subtable-count
for platform-id = (read-uint16 input-stream)
for platform-specific-id = (read-uint16 input-stream)
for offset = (+ start-pos (read-uint32 input-stream))
when (and (= platform-id
+microsoft-platform-id+)
(= platform-specific-id
+microsoft-unicode-bmp-encoding-id+))
do
(file-position input-stream offset)
(setf (character-map font-loader) (load-unicode-cmap input-stream))
(setf (inverse-character-map font-loader)
(invert-character-map font-loader)
foundp t)
(return))
(unless foundp
(error "Could not find supported character map in font file")))))
(defun available-character-maps (loader)
(seek-to-table "cmap" loader)
(let ((stream (input-stream loader)))
(let ((start-pos (file-position stream))
(version-number (read-uint16 stream))
(subtable-count (read-uint16 stream)))
(declare (ignore start-pos))
(assert (zerop version-number))
(dotimes (i subtable-count)
(let ((platform-id (read-uint16 stream))
(encoding-id (read-uint16 stream))
(offset (read-uint32 stream)))
(declare (ignore offset))
(format t "~D (~A) - ~D (~A)~%"
platform-id (platform-id-name platform-id)
encoding-id (encoding-id-name platform-id encoding-id)))))))
zpb-ttf-0.7/post.lisp 0100664 0000764 0000764 00000017177 10524641750 013310 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; "post" table functions
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/post.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6post.html
;;;
;;; post.lisp,v 1.7 2006/11/09 15:06:16 xach Exp
(in-package #:zpb-ttf)
(defvar *standard-mac-glyph-names*
#(".notdef"
".null"
"nonmarkingreturn"
"space"
"exclam"
"quotedbl"
"numbersign"
"dollar"
"percent"
"ampersand"
"quotesingle"
"parenleft"
"parenright"
"asterisk"
"plus"
"comma"
"hyphen"
"period"
"slash"
"zero" "one" "two" "three" "four"
"five" "six" "seven" "eight" "nine"
"colon"
"semicolon"
"less"
"equal"
"greater"
"question"
"at"
"A" "B" "C" "D" "E" "F" "G" "H" "I" "J" "K" "L" "M"
"N" "O" "P" "Q" "R" "S" "T" "U" "V" "W" "X" "Y" "Z"
"bracketleft"
"backslash"
"bracketright"
"asciicircum"
"underscore"
"grave"
"a" "b" "c" "d" "e" "f" "g" "h" "i" "j" "k" "l" "m"
"n" "o" "p" "q" "r" "s" "t" "u" "v" "w" "x" "y" "z"
"braceleft"
"bar"
"braceright"
"asciitilde"
"Adieresis"
"Aring"
"Ccedilla"
"Eacute"
"Ntilde"
"Odieresis"
"Udieresis"
"aacute"
"agrave"
"acircumflex"
"adieresis"
"atilde"
"aring"
"ccedilla"
"eacute"
"egrave"
"ecircumflex"
"edieresis"
"iacute"
"igrave"
"icircumflex"
"idieresis"
"ntilde"
"oacute"
"ograve"
"ocircumflex"
"odieresis"
"otilde"
"uacute"
"ugrave"
"ucircumflex"
"udieresis"
"dagger"
"degree"
"cent"
"sterling"
"section"
"bullet"
"paragraph"
"germandbls"
"registered"
"copyright"
"trademark"
"acute"
"dieresis"
"notequal"
"AE"
"Oslash"
"infinity"
"plusminus"
"lessequal"
"greaterequal"
"yen"
"mu"
"partialdiff"
"summation"
"product"
"pi"
"integral"
"ordfeminine"
"ordmasculine"
"Omega"
"ae"
"oslash"
"questiondown"
"exclamdown"
"logicalnot"
"radical"
"florin"
"approxequal"
"Delta"
"guillemotleft"
"guillemotright"
"ellipsis"
"nonbreakingspace"
"Agrave"
"Atilde"
"Otilde"
"OE"
"oe"
"endash"
"emdash"
"quotedblleft"
"quotedblright"
"quoteleft"
"quoteright"
"divide"
"lozenge"
"ydieresis"
"Ydieresis"
"fraction"
"currency"
"guilsinglleft"
"guilsinglright"
"fi"
"fl"
"daggerdbl"
"periodcentered"
"quotesinglbase"
"quotedblbase"
"perthousand"
"Acircumflex"
"Ecircumflex"
"Aacute"
"Edieresis"
"Egrave"
"Iacute"
"Icircumflex"
"Idieresis"
"Igrave"
"Oacute"
"Ocircumflex"
"apple"
"Ograve"
"Uacute"
"Ucircumflex"
"Ugrave"
"dotlessi"
"circumflex"
"tilde"
"macron"
"breve"
"dotaccent"
"ring"
"cedilla"
"hungarumlaut"
"ogonek"
"caron"
"Lslash"
"lslash"
"Scaron"
"scaron"
"Zcaron"
"zcaron"
"brokenbar"
"Eth"
"eth"
"Yacute"
"yacute"
"Thorn"
"thorn"
"minus"
"multiply"
"onesuperior"
"twosuperior"
"threesuperior"
"onehalf"
"onequarter"
"threequarters"
"franc"
"Gbreve"
"gbreve"
"Idotaccent"
"Scedilla"
"scedilla"
"Cacute"
"cacute"
"Ccaron"
"ccaron"
"dcroat"))
(defun load-post-format-2 (names stream)
(let* ((glyph-count (read-uint16 stream))
(new-count glyph-count))
(when (/= glyph-count (length names))
(warn "Glyph count in \"post\" table (~D) ~
does not match glyph count in \"maxp\" table (~D). ~
This font may be broken."
glyph-count (length names))
(setf glyph-count (length names)
new-count (length names)))
;; This is done in a couple passes. First, initialize the names
;; tables with indexes into either the standard table or the
;; pstring table. Next, read the pstring table into a vector.
;; Finally, replace the indexes with names.
(dotimes (i glyph-count)
(let ((name-index (read-uint16 stream)))
(when (< name-index 258)
(decf new-count))
(setf (aref names i) name-index)))
(let ((pstrings (make-array new-count)))
(dotimes (i new-count)
(setf (aref pstrings i) (read-pstring stream)))
(loop for i below glyph-count
for j across names
do
(cond ((< j 258)
(setf (aref names i)
(aref *standard-mac-glyph-names* j)))
(t
(setf (aref names i)
(aref pstrings (- j 258)))))))))
(defun load-post-format-3 (names stream)
(declare (ignore stream))
(fill names nil))
(defmethod load-post-info ((font-loader font-loader))
(let ((names (make-array (glyph-count font-loader)
:initial-element 0))
(stream (input-stream font-loader)))
(seek-to-table "post" font-loader)
(let ((format (read-uint32 stream)))
(when (/= format #x00020000 #x00030000)
(error 'unsupported-format
:location "\"post\" table"
:expected-values (list #x00020000 #x00030000)
:actual-value format))
(setf (italic-angle font-loader) (read-fixed stream)
(underline-position font-loader) (read-fword stream)
(underline-thickness font-loader) (read-fword stream)
(fixed-pitch-p font-loader) (plusp (read-uint32 stream))
(postscript-glyph-names font-loader) names)
;; skip minMemType* fields
(advance-file-position stream 16)
(case format
(#x00020000 (load-post-format-2 names stream))
(#x00030000 (load-post-format-3 names stream))))))
(defun postscript-uni-name-p (name)
(let ((end (or (position #\. name) (length name))))
(and (= end 7)
(= (mismatch "uni" name) 3)
(loop for i from 3 below end
always (digit-char-p (char name i) 16)))))
(defun postscript-name-code-point (name)
"Returns, if available, the interpretation of the PostScript name NAME as a Unicode code point specifier.
Ref: http://partners.adobe.com/public/developer/opentype/index_glyph.html"
(when (postscript-uni-name-p name)
(parse-integer name :start 3 :end 7 :radix 16)))
zpb-ttf-0.7/name.lisp 0100664 0000764 0000764 00000035402 10375725047 013240 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the TrueType "name" table.
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/name.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6name.html
;;;
;;; name.lisp,v 1.8 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
(defvar *name-identifiers*
#(:copyright-notice
:font-family
:font-subfamily
:unique-subfamily
:full-name
:name-table-version
:postscript-name
:trademark-notice
:manufacturer-name
:designer
:description
:vendor-url
:designer-url
:license-description
:licence-info-url
:reserved
:preferred-family
:preferred-subfamily
:compatible-full
:sample-text))
(defvar *platform-identifiers*
#(:unicode
:macintosh
:iso
:microsoft
:custom))
(defvar *unicode-encoding-ids*
#(:unicode-1.0
:unicode-1.1
:iso-10646\:1993
:unicode>=2.0-bmp-only
:unicode>=2.0-full-repertoire))
(defvar *microsoft-encoding-ids*
#(:symbol
:unicode
:shiftjis
:prc
:big5
:wansung
:johab
:reserved
:reserved
:reserved
:ucs-4))
(defvar *macintosh-encoding-ids*
#(:roman
:japanese
:chinese-traditional
:korean
:arabic
:hebrew
:greek
:russian
:RSymbol
:devanagari
:gurmukhi
:gujarati
:oriya
:bengali
:tamil
:telugu
:kennada
:malayam
:sinhalese
:burmese
:khmer
:thai
:laotian
:georgian
:armenian
:chinese-simplified
:tibetan
:mongolian
:geez
:slavic
:vietnamese
:sindhi
:uninterpreted))
(defparameter *encoding-tables*
(vector *unicode-encoding-ids*
*macintosh-encoding-ids*
nil
*microsoft-encoding-ids*
nil))
(defun encoding-id-name (platform-id encoding-id)
(aref (aref *encoding-tables* platform-id) encoding-id))
(defun platform-id-name (platform-id)
(aref *platform-identifiers* platform-id))
(defparameter *macroman-translation-table*
#(#x00 #x00
#x01 #x01
#x02 #x02
#x03 #x03
#x04 #x04
#x05 #x05
#x06 #x06
#x07 #x07
#x08 #x08
#x09 #x09
#x0A #x0A
#x0B #x0B
#x0C #x0C
#x0D #x0D
#x0E #x0E
#x0F #x0F
#x10 #x10
#x11 #x11
#x12 #x12
#x13 #x13
#x14 #x14
#x15 #x15
#x16 #x16
#x17 #x17
#x18 #x18
#x19 #x19
#x1A #x1A
#x1B #x1B
#x1C #x1C
#x1D #x1D
#x1E #x1E
#x1F #x1F
#x20 #x20
#x21 #x21
#x22 #x22
#x23 #x23
#x24 #x24
#x25 #x25
#x26 #x26
#x27 #x27
#x28 #x28
#x29 #x29
#x2A #x2A
#x2B #x2B
#x2C #x2C
#x2D #x2D
#x2E #x2E
#x2F #x2F
#x30 #x30
#x31 #x31
#x32 #x32
#x33 #x33
#x34 #x34
#x35 #x35
#x36 #x36
#x37 #x37
#x38 #x38
#x39 #x39
#x3A #x3A
#x3B #x3B
#x3C #x3C
#x3D #x3D
#x3E #x3E
#x3F #x3F
#x40 #x40
#x41 #x41
#x42 #x42
#x43 #x43
#x44 #x44
#x45 #x45
#x46 #x46
#x47 #x47
#x48 #x48
#x49 #x49
#x4A #x4A
#x4B #x4B
#x4C #x4C
#x4D #x4D
#x4E #x4E
#x4F #x4F
#x50 #x50
#x51 #x51
#x52 #x52
#x53 #x53
#x54 #x54
#x55 #x55
#x56 #x56
#x57 #x57
#x58 #x58
#x59 #x59
#x5A #x5A
#x5B #x5B
#x5C #x5C
#x5D #x5D
#x5E #x5E
#x5F #x5F
#x60 #x60
#x61 #x61
#x62 #x62
#x63 #x63
#x64 #x64
#x65 #x65
#x66 #x66
#x67 #x67
#x68 #x68
#x69 #x69
#x6A #x6A
#x6B #x6B
#x6C #x6C
#x6D #x6D
#x6E #x6E
#x6F #x6F
#x70 #x70
#x71 #x71
#x72 #x72
#x73 #x73
#x74 #x74
#x75 #x75
#x76 #x76
#x77 #x77
#x78 #x78
#x79 #x79
#x7A #x7A
#x7B #x7B
#x7C #x7C
#x7D #x7D
#x7E #x7E
#x7F #x7F
#x80 #x00C4
#x81 #x00C5
#x82 #x00C7
#x83 #x00C9
#x84 #x00D1
#x85 #x00D6
#x86 #x00DC
#x87 #x00E1
#x88 #x00E0
#x89 #x00E2
#x8A #x00E4
#x8B #x00E3
#x8C #x00E5
#x8D #x00E7
#x8E #x00E9
#x8F #x00E8
#x90 #x00EA
#x91 #x00EB
#x92 #x00ED
#x93 #x00EC
#x94 #x00EE
#x95 #x00EF
#x96 #x00F1
#x97 #x00F3
#x98 #x00F2
#x99 #x00F4
#x9A #x00F6
#x9B #x00F5
#x9C #x00FA
#x9D #x00F9
#x9E #x00FB
#x9F #x00FC
#xA0 #x2020
#xA1 #x00B0
#xA2 #x00A2
#xA3 #x00A3
#xA4 #x00A7
#xA5 #x2022
#xA6 #x00B6
#xA7 #x00DF
#xA8 #x00AE
#xA9 #x00A9
#xAA #x2122
#xAB #x00B4
#xAC #x00A8
#xAD #x2260
#xAE #x00C6
#xAF #x00D8
#xB0 #x221E
#xB1 #x00B1
#xB2 #x2264
#xB3 #x2265
#xB4 #x00A5
#xB5 #x00B5
#xB6 #x2202
#xB7 #x2211
#xB8 #x220F
#xB9 #x03C0
#xBA #x222B
#xBB #x00AA
#xBC #x00BA
#xBD #x03A9
#xBE #x00E6
#xBF #x00F8
#xC0 #x00BF
#xC1 #x00A1
#xC2 #x00AC
#xC3 #x221A
#xC4 #x0192
#xC5 #x2248
#xC6 #x2206
#xC7 #x00AB
#xC8 #x00BB
#xC9 #x2026
#xCA #x00A0
#xCB #x00C0
#xCC #x00C3
#xCD #x00D5
#xCE #x0152
#xCF #x0153
#xD0 #x2103
#xD1 #x2014
#xD2 #x201C
#xD3 #x201D
#xD4 #x2018
#xD5 #x2019
#xD6 #x00F7
#xD7 #x25CA
#xD8 #x00FF
#xD9 #x0178
#xDA #x2044
#xDB #x20AC
#xDC #x2039
#xDD #x203A
#xDE #xFB01
#xDF #xFB02
#xE0 #x2021
#xE1 #x00B7
#xE2 #x201A
#xE3 #x201E
#xE4 #x2030
#xE5 #x00C2
#xE6 #x00CA
#xE7 #x00C1
#xE8 #x00CB
#xE9 #x00C8
#xEA #x00CD
#xEB #x00CE
#xEC #x00CF
#xED #x00CC
#xEE #x00D3
#xEF #x00D4
#xF0 #xF8FF
#xF1 #x00D2
#xF2 #x00DA
#xF3 #x00DB
#xF4 #x00D9
#xF5 #x0131
#xF6 #x02C6
#xF7 #x02DC
#xF8 #x00AF
#xF9 #x02D8
#xFA #x02D9
#xFB #x02DA
#xFC #x00B8
#xFD #x02DD
#xFE #x02DB
#xFF #x02C7))
(defconstant +unicode-platform-id+ 0)
(defconstant +macintosh-platform-id+ 1)
(defconstant +iso-platform-id+ 2)
(defconstant +microsoft-platform-id+ 3)
(defconstant +custom-platform-id+ 4)
(defconstant +unicode-2.0-encoding-id+ 3)
(defconstant +microsoft-unicode-bmp-encoding-id+ 1)
(defconstant +microsoft-symbol-encoding-id+ 0)
(defconstant +macintosh-roman-encoding-id+ 1)
;; Full list of microsoft language IDs is here:
;; http://www.microsoft.com/globaldev/reference/lcid-all.mspx
(defconstant +microsoft-us-english-language-id+ #x0409)
(defconstant +macintosh-english-language-id+ 1)
(defconstant +unicode-language-id+ 0)
(defclass name-entry ()
((font-loader
:initarg :font-loader
:accessor font-loader)
(platform-id
:initarg :platform-id
:accessor platform-id)
(encoding-id
:initarg :encoding-id
:accessor encoding-id)
(language-id
:initarg :language-id
:accessor language-id)
(name-id
:initarg :name-id
:accessor name-id)
(offset
:initarg :offset
:accessor offset
:documentation "The octet offset within the TrueType file stream
of the entry's data. *Not* the same as the offset in the NameRecord
structure, which is relative to the start of the string data for the
table.")
(entry-length
:initarg :entry-length
:accessor entry-length)
(value
:reader %value
:writer (setf value))
(octets
:reader %octets
:writer (setf octets))))
(defmethod print-object ((name-entry name-entry) stream)
(print-unreadable-object (name-entry stream :type t)
(format stream "~A (~A/~A/~D)"
(aref *name-identifiers* (name-id name-entry))
(platform-id-name (platform-id name-entry))
(encoding-id-name (platform-id name-entry)
(encoding-id name-entry))
(language-id name-entry))))
(defun unicode-octets-to-string (octets)
(let ((string (make-string (/ (length octets) 2))))
(flet ((ref16 (i)
(+ (ash (aref octets i) 16)
(aref octets (1+ i)))))
(loop for i from 0 below (length octets) by 2
for j from 0
do (setf (char string j) (code-char (ref16 i))))
string)))
(defun macintosh-octets-to-string (octets)
(flet ((macroman->unicode (point)
(code-char (aref *macroman-translation-table* (1+ (ash point 1))))))
(let ((string (make-string (length octets))))
(dotimes (i (length octets) string)
(setf (schar string i) (macroman->unicode (aref octets i)))))))
(defgeneric initialize-name-entry (name-entry)
(:method (name-entry)
(let ((stream (input-stream (font-loader name-entry)))
(octets (make-array (entry-length name-entry)
:element-type '(unsigned-byte 8)))
(value nil)
(platform-id (platform-id name-entry)))
(file-position stream (offset name-entry))
(read-sequence octets stream)
(cond ((or (= platform-id +unicode-platform-id+)
(= platform-id +microsoft-platform-id+))
(setf value (unicode-octets-to-string octets)))
((= platform-id +macintosh-platform-id+)
(setf value (macintosh-octets-to-string octets)))
(t
(error 'unsupported-value
:location "\"name\" table platform ID"
:actual-value platform-id
:expected-values (list +unicode-platform-id+
+microsoft-platform-id+
+macintosh-platform-id+))))
(setf (value name-entry) value
(octets name-entry) octets))))
(defgeneric value (name-entry)
(:method (name-entry)
(unless (slot-boundp name-entry 'value)
(initialize-name-entry name-entry))
(%value name-entry)))
(defgeneric octets (name-entry)
(:method (name-entry)
(unless (slot-boundp name-entry 'octets)
(initialize-name-entry name-entry))
(%octets name-entry)))
(defun load-name-info (loader)
(seek-to-table "name" loader)
(let* ((stream (input-stream loader))
(table-offset (file-position stream))
(format (read-uint16 stream)))
(unless (= format 0)
(error 'unsupported-format
:location "\"name\" table"
:actual-value format
:expected-values (list 0)))
(let* ((count (read-uint16 stream))
(values-offset (read-uint16 stream))
(entries (make-array count)))
(setf (name-entries loader) entries)
(dotimes (i count)
(let ((platform-id (read-uint16 stream))
(encoding-id (read-uint16 stream))
(language-id (read-uint16 stream))
(name-id (read-uint16 stream))
(length (read-uint16 stream))
(offset (read-uint16 stream)))
(setf (aref entries i)
(make-instance 'name-entry
:font-loader loader
:platform-id platform-id
:encoding-id encoding-id
:language-id language-id
:name-id name-id
:entry-length length
:offset (+ table-offset values-offset offset))))))))
;;;
;;; Fetching info out of the name-entry vector
;;;
(defun name-identifier-id (symbol)
(let ((id (position symbol *name-identifiers*)))
(if id
id
(error "Unknown NAME identifier: ~S" symbol))))
(defmethod find-name-entry (platform-id encoding-id language-id name-id
(font-loader font-loader))
;; FIXME: this vector is sorted by platform ID, encoding ID,
;; language ID, and name ID, in that order. Could bisect if it
;; mattered.
(loop for name-entry across (name-entries font-loader)
when (and (or (null platform-id)
(= (platform-id name-entry) platform-id))
(or (null encoding-id)
(= (encoding-id name-entry) encoding-id))
(or (null language-id)
(= (language-id name-entry) language-id))
(or (null name-id)
(= (name-id name-entry) name-id)))
return name-entry))
(defmethod name-entry-value (name-designator (font-loader font-loader))
(let* ((name-id (etypecase name-designator
(keyword (name-identifier-id name-designator))
(integer name-designator)))
(entry (or (find-name-entry +unicode-platform-id+
+unicode-2.0-encoding-id+
+unicode-language-id+
name-id
font-loader)
(find-name-entry +microsoft-platform-id+
nil
+microsoft-us-english-language-id+
name-id
font-loader)
(find-name-entry +macintosh-platform-id+
+macintosh-roman-encoding-id+
+macintosh-english-language-id+
name-id
font-loader))))
(when entry
(value entry))))
(defmethod postscript-name ((font-loader font-loader))
(name-entry-value :postscript-name font-loader))
(defmethod family-name ((font-loader font-loader))
(name-entry-value :font-family font-loader))
(defmethod subfamily-name ((font-loader font-loader))
(name-entry-value :font-subfamily font-loader))
(defmethod full-name ((font-loader font-loader))
(name-entry-value :full-name font-loader))
zpb-ttf-0.7/font-loader.lisp 0100664 0000764 0000764 00000011603 10410617564 014521 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; The font-loader object, which is the primary interface for
;;; getting glyph and metrics info.
;;;
;;; font-loader.lisp,v 1.26 2006/03/23 22:21:40 xach Exp
(in-package #:zpb-ttf)
(defclass font-loader ()
((tables :initform (make-hash-table) :reader tables)
(input-stream :initarg :input-stream :accessor input-stream
:documentation "The stream from which things are loaded.")
(table-count :initarg :table-count :reader table-count)
;; from the 'head' table
(units/em :accessor units/em)
(bounding-box :accessor bounding-box)
(loca-offset-format :accessor loca-offset-format)
;; from the 'loca' table
(glyph-locations :accessor glyph-locations)
;; from the 'cmap' table
(character-map :accessor character-map)
(inverse-character-map :accessor inverse-character-map)
;; from the 'maxp' table
(glyph-count :accessor glyph-count)
;; from the 'hhea' table
(ascender :accessor ascender)
(descender :accessor descender)
(line-gap :accessor line-gap)
;; from the 'hmtx' table
(advance-widths :accessor advance-widths)
(left-side-bearings :accessor left-side-bearings)
;; from the 'kern' table
(kerning-table :initform (make-hash-table) :accessor kerning-table)
;; from the 'name' table
(name-entries :initform nil :accessor name-entries)
;; from the 'post' table
(italic-angle :accessor italic-angle :initform 0)
(fixed-pitch-p :accessor fixed-pitch-p :initform nil)
(underline-position :accessor underline-position :initform 0)
(underline-thickness :accessor underline-thickness :initform 0)
(postscript-glyph-names :accessor postscript-glyph-names)
;; misc
(glyph-cache :accessor glyph-cache)))
(defclass table-info ()
((name :initarg :name :reader name)
(offset :initarg :offset :reader offset)
(size :initarg :size :reader size)))
(defmethod print-object ((object table-info) stream)
(print-unreadable-object (object stream :type t)
(format stream "\"~A\"" (name object))))
;;; tag integers to strings and back
(defun number->tag (number)
"Convert the 32-bit NUMBER to a string of four characters based on
the CODE-CHAR of each octet in the number."
(let ((tag (make-string 4)))
(loop for i below 4
for offset from 24 downto 0 by 8
do (setf (schar tag i)
(code-char (ldb (byte 8 offset) number))))
tag))
(defun tag->number (tag)
"Convert the four-character string TAG to a 32-bit number based on
the CHAR-CODE of each character."
(declare (simple-string tag))
(loop for char across tag
for offset from 24 downto 0 by 8
summing (ash (char-code char) offset)))
;;; Getting table info out of the loader
(defmethod table-info ((tag string) (font-loader font-loader))
(gethash (tag->number tag) (tables font-loader)))
(defmethod table-exists-p (tag font-loader)
(nth-value 1 (table-info tag font-loader)))
(defmethod table-position ((tag string) (font-loader font-loader))
"Return the byte position in the font-loader's stream for the table
named by TAG."
(let ((table-info (table-info tag font-loader)))
(if table-info
(offset table-info)
(error "No such table -- ~A" tag))))
(defmethod table-size ((tag string) (font-loader font-loader))
(let ((table-info (table-info tag font-loader)))
(if table-info
(size table-info)
(error "No such table -- ~A" tag))))
(defmethod seek-to-table ((tag string) (font-loader font-loader))
"Move FONT-LOADER's input stream to the start of the table named by TAG."
(file-position (input-stream font-loader) (table-position tag font-loader)))
zpb-ttf-0.7/hhea.lisp 0100664 0000764 0000764 00000004372 10375725047 013227 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the "hhea" table.
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/hhea.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6hhea.html
;;;
;;; hhea.lisp,v 1.4 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
(defmethod load-hhea-info ((font-loader font-loader))
(seek-to-table "hhea" font-loader)
(with-slots (input-stream ascender descender line-gap)
font-loader
(let ((version (read-fixed input-stream)))
(check-version "\"hhea\" table" version #x00010000))
(setf ascender (read-fword input-stream)
descender (read-fword input-stream)
line-gap (read-fword input-stream))))
(defmethod horizontal-metrics-count ((font-loader font-loader))
(seek-to-table "hhea" font-loader)
(with-slots (input-stream) font-loader
;; Skip to the end, since all we care about is the last item
(advance-file-position input-stream 34)
(read-uint16 input-stream)))
zpb-ttf-0.7/loca.lisp 0100664 0000764 0000764 00000004465 10375725047 013243 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the "loca" table.
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/loca.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6loca.html
;;;
;;; loca.lisp,v 1.3 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
(defmethod load-loca-info ((font-loader font-loader))
(seek-to-table "loca" font-loader)
(with-slots (input-stream glyph-locations glyph-count loca-offset-format)
font-loader
(setf glyph-locations (make-array (1+ glyph-count)))
(dotimes (i (1+ glyph-count))
(setf (svref glyph-locations i)
(if (eql loca-offset-format :short)
(* (read-uint16 input-stream) 2)
(read-uint32 input-stream))))))
(defmethod glyph-location (index (font-loader font-loader))
(aref (glyph-locations font-loader) index))
(defmethod glyph-length (index (font-loader font-loader))
(with-slots (glyph-locations)
font-loader
(- (aref glyph-locations (1+ index))
(aref glyph-locations index))))
zpb-ttf-0.7/head.lisp 0100664 0000764 0000764 00000006000 10375725047 013211 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the "head" table.
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/head.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6head.html
;;;
;;; head.lisp,v 1.5 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
(defmethod load-head-info ((font-loader font-loader))
(seek-to-table "head" font-loader)
(with-slots (input-stream units/em bounding-box loca-offset-format)
font-loader
(flet ((skip-bytes (count)
(file-position input-stream (+ count
(file-position input-stream)))))
(let ((version (read-uint32 input-stream)))
(check-version "\"head\" table" version #x00010000))
;; skip fontRevsion and checkSumAdjustment (both uint32)
(skip-bytes 8)
;; check the magicNumber
(let ((magic-number (read-uint32 input-stream)))
(when (/= magic-number #x5F0F3CF5)
(error 'bad-magic
:location "\"head\" table"
:expected-values (list #x5F0F3CF5)
:actual-value magic-number)))
;; skip flags
(skip-bytes 2)
(setf units/em (read-uint16 input-stream))
;; skip created and modified dates
(skip-bytes 16)
(setf bounding-box (vector (read-int16 input-stream)
(read-int16 input-stream)
(read-int16 input-stream)
(read-int16 input-stream)))
;; skip macStyle, lowestRecPPEM, fontDirectionHint
(skip-bytes 6)
;; set the loca-offset-format
(if (zerop (read-int16 input-stream))
(setf loca-offset-format :short)
(setf loca-offset-format :long)))))
zpb-ttf-0.7/kern.lisp 0100664 0000764 0000764 00000010221 10412245155 013234 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; "kern" table functions
;;;
;;; http://www.microsoft.com/OpenType/OTSpec/kern.htm
;;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6kern.html
;;;
;;; kern.lisp,v 1.8 2006/03/28 14:38:37 xach Exp
(in-package #:zpb-ttf)
(defun load-kerning-format-1 (table stream)
"Return a hash table keyed on a UINT32 key that represents the glyph
index in the left and right halves with a value of the kerning
distance between the pair."
(let ((pair-count (read-uint16 stream))
(search-range (read-uint16 stream))
(entry-selector (read-uint16 stream))
(range-shift (read-uint16 stream)))
(declare (ignore search-range entry-selector range-shift))
(dotimes (i pair-count)
(setf (gethash (read-uint32 stream) table)
(read-int16 stream)))))
(defmethod load-kerning-subtable ((font-loader font-loader) format)
(when (/= 1 format)
(error 'unsupported-format
:description "kerning subtable"
:size 1
:expected-values (list 1)
:actual-value format))
(load-kerning-format-1 (kerning-table font-loader)
(input-stream font-loader)))
(defmethod load-kern-info ((font-loader font-loader))
(when (table-exists-p "kern" font-loader)
(seek-to-table "kern" font-loader)
(let* ((stream (input-stream font-loader))
(maybe-version (read-uint16 stream))
(maybe-table-count (read-uint16 stream))
(version 0)
(table-count 0))
;; These shenanegins are because Apple documents one style of
;; kern table and Microsoft documents another. This code
;; implements Microsoft's version.
;; See:
;; http://developer.apple.com/fonts/TTRefMan/RM06/Chap6kern.html
;; http://www.microsoft.com/OpenType/OTSpec/kern.htm
(if (zerop version)
(setf version maybe-version
table-count maybe-table-count)
(setf version (logand (ash maybe-version 16) maybe-table-count)
table-count (read-uint32 stream)))
(check-version "\"kern\" table" version 0)
(dotimes (i table-count)
(let ((version (read-uint16 stream))
(length (read-uint16 stream))
(coverage-flags (read-uint8 stream))
(format (read-uint8 stream)))
(declare (ignore version length coverage-flags))
(load-kerning-subtable font-loader format))))))
(defmethod all-kerning-pairs ((font-loader font-loader))
(let ((pairs nil))
(maphash (lambda (k v)
(let* ((left-index (ldb (byte 16 16) k))
(right-index (ldb (byte 16 0) k))
(left (index-glyph left-index font-loader))
(right (index-glyph right-index font-loader)))
(push (list left right v) pairs)))
(kerning-table font-loader))
pairs))
zpb-ttf-0.7/zpb-ttf.html 0100664 0000764 0000764 00000051347 10524642217 013702 0 ustar xach xach
ZPB-TTF - TrueType font file access for Common Lisp
ZPB-TTF - TrueType font file access for Common Lisp
Abstract
TrueType fonts have a publicly
documented
file format. ZPB-TTF is a TrueType file parser that provides an
interface for reading typographic metrics, glyph outlines, and other
information from the file. It is available under a BSD-like
license. The current version is 0.7, released on November 9, 2006.
TrueType is a registered trademark of Apple Computer, Inc.
Download shortcut: http://www.xach.com/lisp/zpb-ttf.tgz
Contents
- Limitations
- Overview
- Glyph Example
- The ZPB-TTF Dictionary
- open-font-loader
- close-font-loader
- with-font-loader
- glyph-count
- name-entry-value
- find-name-entry
- value
- italic-angle
- underline-thickness
- underline-position
- fixed-pitch-p
- units/em
- ascender
- descender
- line-gap
- postscript-name
- full-name
- family-name
- subfamily-name
- all-kerning-pairs
- glyph-exists-p
- index-glyph
- find-glyph
- bounding-box
- xmin
- ymin
- xmax
- ymax
- x
- y
- on-curve-p
- contour-count
- contour
- contours
- do-contours
- explicit-contour-points
- do-contour-segments
- do-contour-segments*
- code-point
- font-index
- advance-width
- left-side-bearing
- right-side-bearing
- kerning-offset
- string-bounding-box
- Feedback
Limitations
ZPB-TTF has the following limitations:
- is not a rasterizer; it will not produce bitmaps
- is not a scaler; all units are unscaled values directly from the
font file
- only works with fonts that have a Unicode character map
- has been tested on a limited number of fonts
Overview
Font files are loaded by creating font loaders. A font
loader has information that applies to the font as a whole, such as
its overall bounding box and other typographic metrics, the number of
glyphs it contains, and a character map that can be used to convert a
character set index into a glyph index meaningful to the font loader.
A font loader can also be used to create and find glyphs. A
glyph object has information about an individual glyph such as
typographic metrics and its outline.
Glyph outlines are made up of arrays of control points. An
array of control points is called a contour. Contours define
the shape of the glyph. For example, in most fonts, the glyph for the
character #\I has one contour defining its outline. The glyph
for the character #\O has two contours: one for the outer
edge, and one for the inner edge.
This documentation is not meant to be a substitute for the TrueType
file format documentation. For file format details, see the
specifications from either Apple
or Microsoft.
Glyph Example
This image is a rendering of the Greek small letter lambda (U+03BB)
from the Times New
Roman TrueType font. It was drawn into a PDF with CL-PDF
and rendered with Adobe Acrobat
Reader.
The dark gray grid lines represent the axes of the glyph coordinate
system. Light grid lines are drawn at intervals of 256 em-square
units.
Black squares represent the control points returned from CONTOUR. Solid black squares are points
on the outline (ON-CURVE-P returns
true), and hollow black squares are not on the outline. Solid
red squares represent implicit control points on the glyph outline;
they are not in the original contour, but they would be returned in a
new contour created with EXPLICIT-CONTOUR-POINTS.
The alternating blue and green portions of the glyph outline
represent the separate segments whose start, control, and end points
were bound with DO-CONTOUR-SEGMENTS.
The ZPB-TTF Dictionary
[Function]
open-font-loader font-file-designator => font-loader
Creates and returns a font-loader object from
font-file-designator, which should be either a pathname,
pathname namestring, or a font-loader object.
[Function]
close-font-loader font-loader =>
Closes any open resources held by font-loader.
[Macro]
with-font-loader (font-loader font-loader-designator) &body body =>
Performs body with font-loader bound to a font-loader
object created as if with (open-font-loader
font-loader-designator). Automatically closes the
font-loader when finished.
[Function]
glyph-count font-loader => number
Returns the number of glyphs available in font-loader.
[Function]
name-entry-value name-designator font-loader => string
Returns an entry from the TrueType "name" table, which contains
human-readable values for copyright info, trademark notices, creator
names, and the like.
name-designator may be either an integer ID from the table of
NameIDs in the TrueType
"name" table specification, or a keyword designating such an
ID. Valid keywords and their IDs are:
| Keyword | ID |
|---|
| :COPYRIGHT-NOTICE | 0 |
| :FONT-FAMILY | 1 |
| :FONT-SUBFAMILY | 2 |
| :UNIQUE-SUBFAMILY | 3 |
| :FULL-NAME | 4 |
| :NAME-TABLE-VERSION | 5 |
| :POSTSCRIPT-NAME | 6 |
| :TRADEMARK-NOTICE | 7 |
| :MANUFACTURER-NAME | 8 |
| :DESIGNER | 9 |
| :DESCRIPTION | 10 |
| :VENDOR-URL | 11 |
| :DESIGNER-URL | 12 |
| :LICENSE-DESCRIPTION | 13 |
| :LICENCE-INFO-URL | 14 |
| :RESERVED | 15 |
| :PREFERRED-FAMILY | 16 |
| :PREFERRED-SUBFAMILY | 17 |
| :COMPATIBLE-FULL | 18 |
| :SAMPLE-TEXT | 19 |
If the font does not provide any "name" table entry for the given
name-designator, returns NIL.
[Function]
find-name-entry platform-id language-id name-id font-loader => name-entry
This is the low-level interface used by NAME-ENTRY-VALUE. platform-id,
language-id, and name-id should be integer ID values from the TrueType
"name" table specification. If the combination of IDs is found in
the name table, a name-entry object is returned, otherwise
NIL is returned.
[Function]
value name-entry => string
Returns the string value of a name-entry object.
[Function]
italic-angle font-loader => number
Returns the typographic italic angle of font-loader.
[Function]
underline-thickness font-loader => number
Returns the typographic underline thickness of font-loader.
[Function]
underline-position font-loader => number
Returns the typographic underline position of font-loader.
[Function]
fixed-pitch-p font-loader => boolean
Returns true if font-loader is fixed pitch (all glyphs have the
same width).
[Function]
units/em font-loader => number
Return the number of units in the typographic em-square of
font-loader.
[Function]
ascender font-loader => number
Returns the typographic ascender value of font-loader.
[Function]
descender font-loader => number
Returns the typographic descender value of font-loader.
[Function]
line-gap font-loader => number
Returns the typographic line gap of font-loader.
[Generic function]
postscript-name object => string
Returns the Postscript name of object, which may be a glyph or a
font-loader.
[Function]
full-name font-loader => string
Returns the full name of font-loader.
[Function]
family-name font-loader => string
Returns the family name of font-loader.
[Function]
subfamily-name font-loader => string
Returns the subfamily name of font-loader.
[Function]
all-kerning-pairs font-loader => list
Returns a list of all the kerning pairs available in
font-loader. Each element of the list is itself a list, with
three elements: a left glyph, a right glyph, and a numeric kerning
offset.
[Function]
glyph-exists-p character-designator font-loader => boolean
Returns true if font-loader has glyph data for
character-designator.
[Function]
index-glyph index font-loader => glyph
Returns the glyph at index in font-loader.
[Function]
find-glyph character-designator font-loader => glyph
Returns the glyph for character-designator in
font-loader. If
character-designator is an integer, it is treated as a Unicode
code-point and the corresponding glyph is fetched from the font. If
character-designator is a character, its char-code is used as
a Unicode code-point for lookup.
Note: If the
char-codes of characters the Lisp implementation do not
correspond to Unicode (or a subset), this may not return the expected
glyph.
If font-loader does not contain any glyphs for
character-designator, the "missing glyph" glyph is returned. To
test for the existence of a glyph without returning the "missing
glyph" glyph, use GLYPH-EXISTS-P.
[Generic function]
bounding-box object => #(xmin ymin xmax ymax)
Returns the bounding box of object, which may be a glyph or a
font-loader.
[Generic functions]
xmin object => value
ymin object => value
xmax object => value
ymax object => value
Returns the horizontal and vertical extreme values for object, which
may be a glyph or font-loader. If object is a four-element vector,
each function is an accessor to the appropriate entry in the vector.
[Function]
x control-point => number
y control-point => number
Returns the respective coordinate of control-point.
[Function]
on-curve-p control-point => boolean
Returns true if control-point is on the contour outline.
[Function]
contour-count glyph => number
Returns the number of contours of glyph. Some glyphs, such as the
glyph for the Space character, may have zero contours.
[Function]
contour glyph index => vector
Returns the indexth contour from the contours of
glyph. A contour is represented as a vector of control point
objects. Each control point may be on (touching) or off (not touching)
the the contour outline.
TrueType files may store contours that have implicit control
points. When two consecutive control points are off the contour
outline, there is an implied control point at the midpoint between
them on the contour curve.
[Function]
contours glyph => vector
Returns all contours of glyph as a vector.
[Macro]
do-contours (contour glyph &optional
result) &body body => result
Performs body for each contour in glyph, with the
contour bound to contour. Returns result (evaluated) at
the end of processing.
[Function]
explicit-contour-points contour => vector
Returns a vector of points that is the same as contour with the implicit
contour points inserted.
[Macro]
do-contour-segments (start control end) contour &body body =>
For convenience, a TrueType contour may be thought of as being made up
of connected segments. Each segment is either a straight line from one
point on the outline to another, or a curved line that starts with a
point on the outline, is controlled by a point off the outline, and
ends with a point on the outline.
DO-CONTOUR-SEGMENTS performs body for each segment of
contour, with the start, control, and end
variables (not evaluated) bound to the start, control, and end points
of the segment. If the segment is a straight line, control is
bound to NIL.
Contours of a glyph in a TrueType file may contain implied control
points; two consecutive points off the outline may be treated as if
there is there is an point on the outline at the midpoint between
them. DO-CONTOUR-SEGMENTS synthesizes and binds any implicit
points as needed when going through the contour segments. (See the Glyph Example for a visual explanation.)
Segments are not a TrueType glyph concept. The term is used for
convenience by ZPB-TTF.
[Macro]
do-contour-segments* (control end) contour &body body =>
DO-CONTOUR-SEGMENTS* is like DO-CONTOUR-SEGMENTS, except it does
not bind a start variable.
[Function]
code-point glyph => number
Returns the Unicode code point of a character glyph
represents. Note: Since font glyphs may represent more than one
character, this value may not be exactly what you expect. Note:
Since glyphs in a font do not necessarily correspond to a code point,
or to a single code point, this may not always return a meaningful
value.
[Function]
font-index glyph => number
Returns the integer index of glyph in its font loader.
[Function]
advance-width glyph => number
Returns the typographic advance width of glyph.
[Function]
left-side-bearing glyph => number
Returns the typographic left side bearing of glyph.
[Function]
right-side-bearing glyph => number
Returns the typographic right side bearing of glyph.
[Function]
kerning-offset left-glyph right-glyph
font-loader => number
Returns the typographic kerning adjustment needed for the advance
width when left-glyph and right-glyph appear next to
each other.
[Function]
string-bounding-box string font-loader =>
#(xmin ymin xmax ymax)
Returns the bounding box for string in the natural unit size of
font-loader.
Feedback
Please send bug reports, patches, questions, and any other feedback
to Zachary Beane.
/home/cvs/zpb-ttf/zpb-ttf.html,v 1.8 2006/11/09 15:09:03 xach Exp
zpb-ttf-0.7/font-loader-interface.lisp 0100664 0000764 0000764 00000010523 10410617463 016455 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Interface functions for creating, initializing, and closing a
;;; FONT-LOADER object.
;;;
;;; font-loader-interface.lisp,v 1.6 2006/03/23 22:20:35 xach Exp
(in-package #:zpb-ttf)
(defun arrange-finalization (object stream)
(flet ((quietly-close (&optional object)
(declare (ignore object))
(ignore-errors (close stream))))
#+sbcl
(sb-ext:finalize object #'quietly-close)
#+cmucl
(ext:finalize object #'quietly-close)
#+clisp
(ext:finalize object #'quietly-close)
#+allegro
(excl:schedule-finalization object #'quietly-close)))
;;;
;;; FIXME: move most/all of this stuff into initialize-instance
;;;
(defun open-font-loader-from-file (font-file)
(let* ((input-stream (open font-file
:direction :input
:element-type '(unsigned-byte 8)))
(magic (read-uint32 input-stream)))
(when (/= magic #x00010000 #x74727565)
(error 'bad-magic
:location "font header"
:expected-values (list #x00010000 #x74727565)
:actual-value magic))
(let* ((table-count (read-uint16 input-stream))
(font-loader (make-instance 'font-loader
:input-stream input-stream
:table-count table-count)))
(arrange-finalization font-loader input-stream)
;; skip the unused stuff:
;; searchRange, entrySelector, rangeShift
(read-uint16 input-stream)
(read-uint16 input-stream)
(read-uint16 input-stream)
(loop repeat table-count
for tag = (read-uint32 input-stream)
for checksum = (read-uint32 input-stream)
for offset = (read-uint32 input-stream)
for size = (read-uint32 input-stream)
do (setf (gethash tag (tables font-loader))
(make-instance 'table-info
:offset offset
:name (number->tag tag)
:size size)))
(load-maxp-info font-loader)
(load-head-info font-loader)
(load-kern-info font-loader)
(load-loca-info font-loader)
(load-name-info font-loader)
(load-cmap-info font-loader)
(load-post-info font-loader)
(load-hhea-info font-loader)
(load-hmtx-info font-loader)
(setf (glyph-cache font-loader)
(make-array (glyph-count font-loader) :initial-element nil))
font-loader)))
(defun open-font-loader (thing)
(typecase thing
(font-loader
(unless (open-stream-p (input-stream thing))
(setf (input-stream thing) (open (input-stream thing))))
thing)
(t
(open-font-loader-from-file thing))))
(defun close-font-loader (loader)
(close (input-stream loader)))
(defmacro with-font-loader ((loader file) &body body)
`(let (,loader)
(unwind-protect
(progn
(setf ,loader (open-font-loader ,file))
,@body)
(when ,loader
(close-font-loader ,loader)))))
zpb-ttf-0.7/glyph.lisp 0100664 0000764 0000764 00000024755 10411054672 013442 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; An object for working with glyphs from the font. Some fields are
;;; lazily loaded from the input-stream of the font-loader when needed.
;;;
;;; glyph.lisp,v 1.27 2006/03/24 20:42:34 xach Exp
(in-package #:zpb-ttf)
(defclass glyph ()
((font-loader
:initarg :font-loader
:reader font-loader
:documentation "The font-loader from which this glyph originates.")
(font-index
:initarg :font-index
:accessor font-index
:documentation "The index of this glyph within the font file, used
to look up information in various structures in the truetype file.")
(code-point
:initarg :code-point
:accessor code-point)
(contours
:initarg :contours
:accessor contours)
(bounding-box
:initarg :bounding-box
:accessor bounding-box)))
(defmethod initialize-instance :after ((glyph glyph)
&key code-point font-index font-loader
&allow-other-keys)
(flet ((argument-error (name)
(error "Missing required initarg ~S" name)))
(unless font-loader
(argument-error :font-loader))
(cond ((and code-point font-index)) ;; do nothing
(code-point
(setf (font-index glyph)
(code-point-font-index code-point font-loader)))
(font-index
(let ((code-point (font-index-code-point font-index font-loader)))
(when (zerop code-point)
(setf code-point
(or (postscript-name-code-point (postscript-name glyph))
code-point)))
(setf (code-point glyph) code-point)))
(t
(argument-error (list :font-index :code-point))))))
(defmethod print-object ((glyph glyph) stream)
(print-unreadable-object (glyph stream :type t :identity nil)
;; FIXME: Is this really going to be Unicode?
(format stream "~S U+~4,'0X"
(postscript-name glyph)
(code-point glyph))))
;;; Glyph-specific values determined from data in the font-loader
(defgeneric left-side-bearing (object)
(:method ((glyph glyph))
(bounded-aref (left-side-bearings (font-loader glyph))
(font-index glyph))))
(defmethod (setf left-side-bearing) (new-value glyph)
(setf (bounded-aref (left-side-bearings (font-loader glyph))
(font-index glyph))
new-value))
;;; Kerning
(defgeneric kerning-offset (left right loader))
(defmethod kerning-offset ((left-glyph glyph) (right-glyph glyph)
(font-loader font-loader))
(let ((kerning-table-key (logior (ash (font-index left-glyph) 16)
(font-index right-glyph))))
(gethash kerning-table-key (kerning-table font-loader) 0)))
(defmethod kerning-offset ((left character) (right character)
(font-loader font-loader))
(kerning-offset (find-glyph left font-loader)
(find-glyph right font-loader)
font-loader))
(defmethod kerning-offset ((left null) right font-loader)
(declare (ignore left right font-loader))
0)
(defmethod kerning-offset (left (right null) font-loader)
(declare (ignore left right font-loader))
0)
(defgeneric advance-width (object)
(:method ((glyph glyph))
(bounded-aref (advance-widths (font-loader glyph))
(font-index glyph))))
(defmethod (setf advance-width) (new-value (glyph glyph))
(setf (bounded-aref (advance-widths (font-loader glyph))
(font-index glyph))
new-value))
(defgeneric kerned-advance-width (object next)
(:method ((object glyph) next)
(+ (advance-width object)
(kerning-offset object next (font-loader object)))))
(defgeneric location (object)
(:method ((glyph glyph))
(with-slots (font-index font-loader)
glyph
(+ (table-position "glyf" font-loader)
(glyph-location font-index font-loader)))))
(defgeneric data-size (object)
(:method ((glyph glyph))
(with-slots (font-index font-loader)
glyph
(- (glyph-location (1+ font-index) font-loader)
(glyph-location font-index font-loader)))))
;;; Initializing delayed data
(defmethod initialize-bounding-box ((glyph glyph))
(if (zerop (data-size glyph))
(setf (bounding-box glyph) (empty-bounding-box))
(let ((stream (input-stream (font-loader glyph))))
;; skip contour-count
(file-position stream (+ (location glyph) 2))
(setf (bounding-box glyph)
(vector (read-fword stream)
(read-fword stream)
(read-fword stream)
(read-fword stream))))))
(defmethod initialize-contours ((glyph glyph))
(if (zerop (data-size glyph))
(setf (contours glyph) (empty-contours))
(let ((stream (input-stream (font-loader glyph))))
(file-position stream (location glyph))
(let ((contour-count (read-int16 stream)))
;; skip glyph bounding box, 4 FWords
(advance-file-position stream 8)
(if (= contour-count -1)
(setf (contours glyph)
(read-compound-contours (font-loader glyph)))
(setf (contours glyph)
(read-simple-contours contour-count stream)))))))
(defmethod bounding-box :before ((glyph glyph))
(unless (slot-boundp glyph 'bounding-box)
(initialize-bounding-box glyph)))
(defmethod contours :before ((glyph glyph))
(unless (slot-boundp glyph 'contours)
(initialize-contours glyph)))
(defgeneric contour-count (object)
(:method (object)
(length (contours object))))
(defgeneric contour (object idex)
(:method (object index)
(aref (contours object) index)))
(defmacro do-contours ((contour object &optional result) &body body)
(let ((i (gensym))
(obj (gensym)))
`(let ((,obj ,object))
(dotimes (,i (contour-count ,obj) ,result)
(let ((,contour (contour ,obj ,i)))
,@body)))))
(defgeneric right-side-bearing (object)
(:method ((glyph glyph))
(- (advance-width glyph)
(- (+ (left-side-bearing glyph) (xmax glyph))
(xmin glyph)))))
;;; Producing a bounding box for a sequence of characters
(defgeneric string-bounding-box (string loader &key kerning))
(defmethod string-bounding-box (string (font-loader font-loader)
&key (kerning t))
(cond ((zerop (length string))
(empty-bounding-box))
((= 1 (length string))
(copy-seq (bounding-box (find-glyph (char string 0) font-loader))))
(t
(let ((origin 0)
(left (find-glyph (char string 0) font-loader))
(xmin most-positive-fixnum) (ymin most-positive-fixnum)
(xmax most-negative-fixnum) (ymax most-negative-fixnum))
(flet ((update-bounds (glyph)
(setf xmin (min (+ (xmin glyph) origin) xmin)
xmax (max (+ (xmax glyph) origin) xmax)
ymin (min (ymin glyph) ymin)
ymax (max (ymax glyph) ymax))))
(update-bounds left)
(loop for i from 1 below (length string)
for glyph = (find-glyph (char string i) font-loader)
do
(incf origin (advance-width left))
(when kerning
(incf origin (kerning-offset left glyph font-loader))
(setf left glyph))
(update-bounds glyph)))
(vector xmin ymin xmax ymax)))))
;;; Producing glyphs from loaders
(defgeneric glyph-exists-p (character font-loader)
(:method ((character glyph) font-loader)
(let ((index (font-index character)))
(not (zerop index))))
(:method (character font-loader)
(glyph-exists-p (find-glyph character font-loader) font-loader)))
(defgeneric find-glyph (character font-loader)
(:documentation "Find the glyph object for CHARACTER in FONT-LOADER
and return it. If CHARACTER is an integer, treat it as a Unicode code
point. If CHARACTER is a Lisp character, treat its char-code as a
Unicode code point.")
(:method ((character integer) (font-loader font-loader))
(index-glyph (code-point-font-index character font-loader) font-loader))
(:method ((character character) (font-loader font-loader))
(find-glyph (char-code character) font-loader)))
(defgeneric index-glyph (index font-loader)
(:documentation "Return the GLYPH object located at glyph index
INDEX in FONT-LOADER, or NIL if no glyph is defined for that
index. Despite the name, NOT the inverse of GLYPH-INDEX.")
(:method (index font-loader)
(let* ((cache (glyph-cache font-loader))
(glyph (aref cache index)))
(if glyph
glyph
(setf (aref cache index)
(make-instance 'glyph
:font-index index
:font-loader font-loader))))))
;;; Misc
(defmethod postscript-name ((glyph glyph))
(let* ((names (postscript-glyph-names (font-loader glyph)))
(index (font-index glyph))
(name (aref names index)))
(cond (name)
((slot-boundp glyph 'code-point)
(setf (aref names index)
(format nil "uni~4,'0X" (code-point glyph))))
(t "unknown"))))
zpb-ttf-0.7/util.lisp 0100664 0000764 0000764 00000007133 10375725047 013275 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Utility functions, mostly for reading data out of the input-stream
;;; of a font-loader.
;;;
;;; util.lisp,v 1.9 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
;;; Reading compound MSB values from an '(unsigned-byte 8) stream
(defun read-uint32 (stream)
(loop repeat 4
for value = (read-byte stream)
then (logior (ash value 8) (read-byte stream))
finally (return value)))
(defun read-uint16 (stream)
(loop repeat 2
for value = (read-byte stream)
then (logior (ash value 8) (read-byte stream))
finally (return value)))
(defun read-uint8 (stream)
(read-byte stream))
(defun read-int8 (stream)
(let ((result (read-byte stream)))
(if (logbitp 7 result)
(1- (- (logandc2 #xFF result)))
result)))
(defun read-int16 (stream)
(let ((result (read-uint16 stream)))
(if (logbitp 15 result)
(1- (- (logandc2 #xFFFF result)))
result)))
(defun read-fixed (stream)
(read-uint32 stream))
(defun read-fword (stream)
(read-int16 stream))
(defun read-fixed2.14 (stream)
(let ((value (read-uint16 stream)))
(let ((integer (ash value -14))
(fraction (logand #x3FFF value)))
(when (logbitp 1 integer)
(setf integer (1- (- (logandc2 #b11 integer)))))
(+ integer (float (/ fraction #x3FFF))))))
(defun read-pstring (stream)
"Read a Pascal-style length-prefixed string."
(let* ((length (read-uint8 stream))
(buf (make-array length :element-type '(unsigned-byte 8)))
(string (make-string length)))
(read-sequence buf stream)
;; The following could be (map 'string #'code-char buf), but that
;; form benchmarked poorly
(dotimes (i length string)
(setf (schar string i) (code-char (aref buf i))))))
(defun advance-file-position (stream n)
"Move the file position of STREAM ahead by N bytes."
(let ((pos (file-position stream)))
(file-position stream (+ pos n))))
(defun bounded-aref (vector index)
"Some TrueType data vectors are truncated, and any references beyond
the end of the vector should be treated as a reference to the last
element in the vector."
(aref vector (min (1- (length vector)) index)))
(defun (setf bounded-aref) (new-value vector index)
(setf (aref vector (min (1- (length vector)) index)) new-value))
zpb-ttf-0.7/conditions.lisp 0100664 0000764 0000764 00000006225 10375725047 014472 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Conditions
;;;
;;; conditions.lisp,v 1.3 2006/02/18 23:13:43 xach Exp
(in-package #:zpb-ttf)
(define-condition regrettable-value ()
((actual-value
:initarg :actual-value
:accessor actual-value)
(expected-values
:initarg :expected-values
:accessor expected-values)
(description
:initarg :description
:initform nil
:accessor description)
(location
:initarg :location
:initform nil
:accessor location))
(:report
(lambda (c s)
(format s "~:[Regrettable~;~:*~A~] value~:[~;~:* in ~A~]: ~
~A (expected ~{~A~^ or ~})"
(description c)
(location c)
(actual-value c)
(expected-values c)))))
(define-condition regrettable-hex-value (regrettable-value)
((size
:initarg :size
:initform 8
:accessor size)
(actual-value
:reader %actual-value)
(expected-values
:reader %expected-values)))
(defmethod actual-value ((c regrettable-hex-value))
(format nil "#x~v,'0X" (size c) (%actual-value c)))
(defmethod expected-values ((c regrettable-hex-value))
(mapcar (lambda (v)
(format nil "#x~v,'0X" (size c) v))
(%expected-values c)))
(define-condition bad-magic (regrettable-hex-value)
((description :initform "Bad magic")))
(define-condition unsupported-version (regrettable-hex-value)
((description :initform "Unsupported version")))
(define-condition unsupported-format (regrettable-hex-value)
((description :initform "Unsupported format")))
(define-condition unsupported-value (regrettable-value)
((description :initform "Unsupported")))
(defun check-version (location actual &rest expected)
(or (member actual expected :test #'=)
(error 'unsupported-version
:location location
:actual-value actual
:expected-values expected)))
zpb-ttf-0.7/glyf.lisp 0100664 0000764 0000764 00000032240 10410617611 013241 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; Loading data from the 'glyf' table.
;;;
;;; glyf.lisp,v 1.13 2006/03/23 22:22:01 xach Exp
(in-package #:zpb-ttf)
(defclass control-point ()
((x :initarg :x :accessor x)
(y :initarg :y :accessor y)
(on-curve-p :initarg :on-curve-p :reader on-curve-p)))
(defun make-control-point (x y on-curve-p)
(make-instance 'control-point
:x x
:y y
:on-curve-p on-curve-p))
(defmethod print-object ((control-point control-point) stream)
(print-unreadable-object (control-point stream :type t)
(format stream "~D,~D~:[~;*~]"
(x control-point) (y control-point) (on-curve-p control-point))))
(defmacro do-contour-segments* ((p1 p2) contour &body body)
(let ((length (gensym))
(i (gensym))
(stack (gensym))
(next (gensym))
(next-point (gensym "NEXT-POINT"))
(midpoint (gensym "MIDPOINT"))
(contour* (gensym))
(loop (gensym "LOOP"))
(body-tag (gensym "BODY"))
(mid p1)
(end p2))
`(let* ((,i 1)
(,contour* ,contour)
(,length (length ,contour*))
,stack ,next ,mid ,end)
(unless (zerop ,length)
(flet ((,next-point ()
(when (< ,i ,length)
(prog1 (aref ,contour* ,i) (incf ,i))))
(,midpoint (p0 p1)
(make-control-point (/ (+ (x p0) (x p1)) 2)
(/ (+ (y p0) (y p1)) 2)
t)))
(tagbody
,loop
(setf ,mid nil
,next (,next-point))
(unless ,next
(setf ,mid ,stack
,end (aref ,contour* 0))
(go ,body-tag))
(if (on-curve-p ,next)
(setf ,end ,next
,mid ,stack
,stack nil)
(cond (,stack
(setf ,mid ,stack
,end (,midpoint ,stack ,next)
,stack ,next))
(t
(setf ,stack ,next)
(go ,loop))))
,body-tag
,@body
(when ,next
(go ,loop))))))))
(defmacro do-contour-segments ((p0 p1 p2) contour &body body)
"A contour is made up of segments. A segment may be a straight line
or a curve. For each segment, bind the P0 and P2 variables to the
start and end points of the segment. If the segment is a curve, set P1
to the control point of the curve, otherwise set P1 to NIL."
;; This macro started out life as a function and was converted.
(let ((start p0)
(contour* (gensym "CONTOUR")))
`(let ((,contour* ,contour))
(when (plusp (length ,contour*))
(let ((,start (aref ,contour* 0)))
(do-contour-segments* (,p1 ,p2)
,contour*
(progn ,@body)
(setf ,start ,p2)))))))
(defun explicit-contour-points (contour)
(let ((new-contour (make-array (length contour)
:adjustable t
:fill-pointer 0)))
(when (plusp (length contour))
(vector-push-extend (aref contour 0) new-contour))
(do-contour-segments* (p1 p2)
contour
(when p1
(vector-push-extend p1 new-contour))
(vector-push-extend p2 new-contour))
new-contour))
;;; Locating a glyph's contours and bounding box in the font loader's
;;; stream, and loading them
(defparameter *empty-contours*
(make-array 0 :element-type '(signed-byte 16)))
(defparameter *empty-bounding-box*
(make-array 4
:initial-element 0
:element-type '(signed-byte 16)))
(defun empty-bounding-box ()
(copy-seq *empty-bounding-box*))
(defun empty-contours ()
(copy-seq *empty-contours*))
(defun dump-compound-flags (flags)
(format t "XXX flags=~16,'0B~%" flags)
(let ((meanings '((0 . ARG_1_AND_2_ARE_WORDS)
(1 . ARGS_ARE_XY_VALUES)
(2 . ROUND_XY_TO_GRID)
(3 . WE_HAVE_A_SCALE)
(4 . OBSOLETE)
(5 . MORE_COMPONENTS)
(6 . WE_HAVE_AN_X_AND_Y_SCALE)
(7 . WE_HAVE_A_TWO_BY_TWO)
(8 . WE_HAVE_INSTRUCTIONS)
(9 . USE_MY_METRICS)
(10 . OVERLAP_COMPOUND))))
(loop for ((bit . meaning)) on meanings
do (when (logbitp bit flags)
(format t "...~A~%" meaning)))))
(defun transform-option-count (flags)
(let ((scale-p 3)
(xy-scale-p 6)
(2*2-scale-p 7))
(cond ((logbitp scale-p flags) 1)
((logbitp xy-scale-p flags) 2)
((logbitp 2*2-scale-p flags) 4)
(t 0))))
(defun make-transformer (a b c d e f)
"Given the elements of the transformation matrix specified by A, B,
C, D, E, and F, return a function of two arguments that returns the
arguments transformed as multiple values.
Ref: http://developer.apple.com/fonts/TTRefMan/RM06/Chap6glyf.html"
(let ((m (max (abs a) (abs b)))
(n (max (abs c) (abs d))))
(when (<= (abs (- (abs a) (abs b))) 33/65536)
(setf m (* m 2)))
(when (<= (abs (- (abs c) (abs d))) 33/65536)
(setf n (* n 2)))
(lambda (x y)
(values (* m (+ (* (/ a m) x)
(* (/ c m) y)
e))
(* n (+ (* (/ b n) x)
(* (/ d n) y)
f))))))
(defun transform-contours (fn contours)
"Call FN with the X and Y coordinates of each point of each contour
in the vector CONTOURS. FN should return two values, which are used to
update the X and Y values of each point."
(loop for contour across contours do
(loop for p across contour do
(setf (values (x p) (y p))
(funcall fn (x p) (y p))))))
(defun merge-contours (contours-list)
(let* ((total-contours (loop for contours in contours-list
summing (length contours)))
(merged (make-array total-contours))
(i 0))
(dolist (contours contours-list merged)
(loop for contour across contours do
(setf (aref merged i) contour)
(incf i)))))
(defun read-compound-contours (loader)
(let ((contours-list '())
(stream (input-stream loader)))
(loop
(let ((flags (read-uint16 stream))
(font-index (read-uint16 stream)))
(let ((position (file-position stream))
(contours (read-contours-at-index font-index loader)))
(push contours contours-list)
(file-position stream position)
(let ((args-words-p (logbitp 0 flags))
(args-xy-values-p (logbitp 1 flags))
(more-components-p (logbitp 5 flags))
arg1 arg2)
(cond ((and args-words-p args-xy-values-p)
(setf arg1 (read-int16 stream)
arg2 (read-int16 stream)))
(args-words-p
(setf arg1 (read-uint16 stream)
arg2 (read-uint16 stream))
(error "Compound glyphs relative to indexes not yet supported"))
(args-xy-values-p
(setf arg1 (read-int8 stream)
arg2 (read-int8 stream)))
(t
(setf arg1 (read-uint8 stream)
arg2 (read-uint8 stream))
(error "Compound glyphs relative to indexes not yet supported")))
;; Transform according to the transformation matrix
(let ((a 1.0) (b 0.0) (c 0.0) (d 1.0)
(e arg1) (f arg2))
(ecase (transform-option-count flags)
(0)
(1
(setf a (setf d (read-fixed2.14 stream))))
(2
(setf a (read-fixed2.14 stream)
d (read-fixed2.14 stream)))
(4
(setf a (read-fixed2.14 stream)
b (read-fixed2.14 stream)
c (read-fixed2.14 stream)
d (read-fixed2.14 stream))))
(let ((transform-fn (make-transformer a b c d e f)))
(transform-contours transform-fn contours)))
(unless more-components-p
(return (merge-contours contours-list)))))))))
(defun read-points-vector (stream flags count axis)
(let ((points (make-array count :fill-pointer 0))
(short-index (if (eql axis :x) 1 2))
(same-index (if (eql axis :x) 4 5)))
(flet ((save-point (point)
(vector-push point points)))
(loop for flag across flags
for short-p = (logbitp short-index flag)
for same-p = (logbitp same-index flag)
do (cond (short-p
(let ((new-point (read-uint8 stream)))
(save-point (if same-p new-point (- new-point)))))
(t
(if same-p
(save-point 0)
(save-point (read-int16 stream)))))))
points))
(defun read-simple-contours (contour-count stream)
"With the stream positioned immediately after the glyph bounding
box, read the contours data from STREAM and return it as a vector."
(let ((contour-endpoint-indexes (make-array contour-count)))
(loop for i below contour-count
for endpoint-index = (read-uint16 stream)
do (setf (svref contour-endpoint-indexes i) endpoint-index))
;; instructions
(let ((n-points (1+ (svref contour-endpoint-indexes
(1- contour-count))))
(instruction-length (read-uint16 stream)))
(loop for i below instruction-length
do (read-byte stream))
;; read the flags
(let ((flags (make-array n-points)))
(loop with i = 0
while (< i n-points) do
(let ((flag-byte (read-uint8 stream)))
(setf (svref flags i) flag-byte)
(incf i)
(when (logbitp 3 flag-byte)
(let ((n-repeats (read-uint8 stream)))
(loop repeat n-repeats do
(setf (svref flags i) flag-byte)
(incf i))))))
(let ((x-points (read-points-vector stream flags n-points :x ))
(y-points (read-points-vector stream flags n-points :y))
(control-points (make-array n-points :fill-pointer 0))
(contours (make-array contour-count)))
(loop for x-point across x-points
for y-point across y-points
for flag across flags
for x = x-point then (+ x x-point)
for y = y-point then (+ y y-point)
do
(vector-push-extend (make-control-point x y
(logbitp 0 flag))
control-points))
(loop for start = 0 then (1+ end)
for end across contour-endpoint-indexes
for i from 0
do (setf (svref contours i)
(subseq control-points start (1+ end))))
contours)))))
(defun read-contours-at-index (index loader)
"Read the contours at glyph index INDEX, discarding bounding box
information."
(let ((stream (input-stream loader)))
(file-position stream (+ (table-position "glyf" loader)
(glyph-location index loader)))
(let ((contour-count (read-int16 stream))
(xmin (read-int16 stream))
(ymin (read-int16 stream))
(xmax (read-int16 stream))
(ymax (read-int16 stream)))
(declare (ignore xmin ymin xmax ymax))
(if (= contour-count -1)
(read-compound-contours loader)
(read-simple-contours contour-count stream)))))
zpb-ttf-0.7/bounding-box.lisp 0100664 0000764 0000764 00000004073 10375725047 014713 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;;
;;;; Bounding boxes, which are common to both the overall font and
;;;; individual glyphs.
;;;;
;;;; bounding-box.lisp,v 1.2 2006/02/18 23:13:43 xach Exp
(in-package :zpb-ttf)
(defgeneric bounding-box (object))
(macrolet ((bbox-accessor (name index)
`(progn
(defgeneric ,name (object)
(:method (object)
(aref (bounding-box object) ,index)))
(defgeneric (setf ,name) (new-value object)
(:method (new-value object)
(setf (aref (bounding-box object) ,index) new-value))))))
(bbox-accessor xmin 0)
(bbox-accessor ymin 1)
(bbox-accessor xmax 2)
(bbox-accessor ymax 3))
(defmethod bounding-box ((object array))
object)
zpb-ttf-0.7/package.lisp 0100664 0000764 0000764 00000004636 10412057721 013705 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
;;;
;;; package.lisp,v 1.22 2006/03/27 21:57:37 xach Exp
(defpackage #:zpb-ttf
(:use #:cl)
(:export
;; font loader
#:open-font-loader
#:close-font-loader
#:with-font-loader
#:glyph-count
#:name-entry-value
#:find-name-entry
#:value
;; font typographic
#:italic-angle
#:underline-thickness
#:underline-position
#:fixed-pitch-p
#:units/em
#:ascender
#:descender
#:line-gap
;; other font attributes
#:postscript-name
#:full-name
#:family-name
#:subfamily-name
#:all-kerning-pairs
#:glyph-exists-p
#:index-glyph
#:find-glyph
;; shared between font-loader and glyph
#:bounding-box
#:xmin
#:ymin
#:xmax
#:ymax
;; control points
#:x
#:y
#:on-curve-p
;; glyph contours
#:contour-count
#:contour
#:contours
#:do-contours
#:explicit-contour-points
#:do-contour-segments
#:do-contour-segments*
;; glyph other
#:code-point
#:font-index
;; glyph typographic
#:advance-width
#:left-side-bearing
#:right-side-bearing
#:kerning-offset
#:string-bounding-box))
zpb-ttf-0.7/lambda.png 0100664 0000764 0000764 00000051551 10375725134 013355 0 ustar xach xach PNG
IHDR G !ux pHYs tIME 6Om IDATxw\\י9wz !Hꒋ$E۱7u%y7x]|Svlu6yq"ݱ,YŒUA $!ކav,Y%Ӹ3_C ù>|iy 9mE 9f1ڏ+fתr:>f})(ңm]SSSV5$vn7=ZprfƏ\&i||<$p8\.W>ZnnO mvUjɅnt>T-K_=== Ft::C
"TUBU>Y]6mjj*TghJjWҡxضz`lB87~4(!h"UMaj HA Uq+((\.>===sɓ' C`=Zp1ArZV*J. A
Na?P 0 g1\ z622Vz}=`ddL 1rRIXƘ|2L&PP8ΐl
"$ mllLV
j4|4ιBj4&TMj HA UA&R5Aj HA U R5Aj HA TM R5Aj HA&TM R5Aj HA&TM }wvv ~MMM({13?: ۷ jF85kk.1͗.]㬹FcYYO>r
{i e\('Lgzfbc!HMEz:""C
A">ס8`:T ) y|-9XJ éScqq0BQV A}~>יp#X'>ܕ3tЪA 5 ش .`9~V^elmmm 8iiiԆRo0 Mkׯ_W =/-3F5< P6_唕?X.GD""ׯ磣hh`.Wϛ,ڵ͍6D}F|܉8^ƻōk%3qqز[¯ ~P*j0Ӏ?B돫tX/;U@&D} jԾwD#ZwL\s9 BZz
11`ZAqysb!rj5yv{.?eދJjQ Dg
^]Η}A|4 rĶ6_>v vE,$BJ *n}T|x$}m@^XSy1jWzLau *^.7#X!~۸/9Asa/
+.hp=\K_EI ٰº /3M=ҼyZCGG .ZAI/ /;) ?mGfV# 'g&>6YZA}'~ -e"Ų|F _' jAq=+1dH^X@<;_RaL$~ރ_/Or!/6G-?"n/˃z*@XW/E(!{M)Q$BX"=*w8^ ۜ7 } в}9ǢoWTBȉq 1|b۩Q!j 4.Y\ sMш?rǞǗ( PQQAUs'5kxXg`kTUkDʩ936غa>d?ijD診: _g BDn {:h/`I" հeqC EAjo
8EjDp11ԃ 2Ī NTBߵSa"U=8'v-d X%h."YJUsCcZd QwM'&P[+~*^ցI9st:vL8gaZv{OWq5M\B刢hۅk1Bn=EqddO'ź-CřnBP(>4K"O4rq"S78NdZCrL&S=f sb1rBPT
B.3>A*ɮWL&~;:t6dbb+..rl6[iio###FO۷iӦ9'N #33sŊ|B N/UD.B\.85\>/U(wFkUYjZD $Of8jy. .}`zr9d2̺nf ?|i<ͨ0%`DžLMMP ~]+f - q!ѧ'7g%/yivmd%[/RT'Kɛ7oE|!֯6+)6wl,
OA~o'
|t
g Z*v8 %%%$09 Α繪9x #K[|]@ ~+3O~£x2\ݝXSzR5!yzy.6e_SW;`? !Jq8<)jDU ":[ŧVܥbࡇPUž}dc[,TBv\̜Ei)=pb:U{+xz%V0H"}a|ll̏WOVW^ }ZpI3Ȣey%}{챥(J< JJ~&/=2;` jV uިIB-o~'|ˢwL] eZ@"3nj!!X_ٞ=~y6݉4} zPzbE<_L;s?f$sDD Q'Xj*EA&C JϣŻصKo/?~s`vE|r11מV}= f_0e^ o ܷ @j\MjBBrV~/9 ˖!--Ȭg/! w\&rfQ(:~<{ձ ,v䠨"8<:SSZ,!U84=ς{E[ew-aFA-V9u^`˗Ms`/-.vNlz & :}o ۲%; ew RCp~uo/}.XCCLXhѢ:ղիe){~[EA RRڵt)NDv6p 6,_~l6B &b8 x-cGP.}ԁڇ ~=>QuF?z\AOBCMdxh45MWS{Fo22t Uϛi }9YXy2Ԕl`Xfs!tuGD5/,)JĖ-YGMX8Ul T*r) Nsl,`@H(+ëb30(ҥϰs'5]bTۋ+WyU'&&6n˿6Ү x/wF쓩4z{JXy8"#g Á4U(9NpƉt&r %T՜cY:^VP̠ [5|{h'N `RLM!.nQ:KOi HQ@Z}RZf&d2r %NccHJ;'OPR@u|p2>
qjfũlFSRRBF$G6}QZ-ZC8`>|:Vٶm8MOZXC[6jBzj
2,Z[YnnXغγILz_TV?zN'5`"શX ľw8Ǽ/*6^jDU=1Y:s b6d,'.P&j&db2 sLjb/*)6LV####0Ts~,= Z-Z 1}BA$&B.#Y!X>_B1
Ot&2g]ܥ.ozzby 9rE;]D2ܔ1R5 wM c dξ^$:h5S$it`'&ȫl TX5S_Wt:W\9B&&&: ɚ@P_y045qrnpp0**h4x]DZZ.O W ?~|Ғ|;zg_x2d2466fffӑQV'z~^%Aa*j̄?je2&'MӦId>힜4L6b1L&QKdC.xpÇ%W_OI]S$XE&699m:W`k*5l
ߥGbaTf4>q7q2{8>&G@J3ML03 f"3R5PU?)$4pT
` EZ }(57Uggg?v^uPVTQy{{7=='1a5z,٫췸-q446n
2TkRSSyk+d1Tr{پ}Od#TPV־Wz\Hr2W*H_-*^p H<꼉a` IU)E px\RRG$H+ clZ[ɖZh)Ay4^]
IA?`)!"EE|`lIA.! ySHv6Μ![ji lVu3R$&zVO%8=.!+ ~%HDXif&pd$ZB$U1f]N /-IՄ4@>y]
(/dKR5!6cY+I~>NF Hc ڛ(D$U ,ڛ]k
+Vn% ,9W]gRTMx̴ͩ4~KE1yg' ɐs{r49''/
s0 w: 8ْTMHe уI=.A\N(jB2JEҠG2gr
-IՄ4``P]xlTW-IՄdHGY{a{{A岻O<|wReB_=#wA
Mj$''*
=lVҴ u
e dR(3yqpotlyDN{;n.uDnh9'T_jbෘHOXV2R51 ɐ&
-
ԌILRY8tŢR)TA5.RYߵ| Cw7Z7 c*TM|C1OTP21DR5)N'q \:H K fjz%"jR5q)ǹp'PQ!-IwvsXI +!6qQj9g#AT >LLKHբwaߏd}XԂVKSBaHHaQ& GEIFF09V$γ+0y2U|$դ0ap55VvQP
4+?: )|:L8q\-8rm܈َ ēNC QDC˥Nv"3Y~g>Cb
krS:xQCLLl lǎOɮ^t(ytRu(rW"Z3 cx-]z1a
S lS8#B'U,P(/w] Ct BI.L{^ HՒsաBT-mRBEµ% v鑪CXBZw {`G5QA9͝'U&ǎ!-MZN'x_[
RR&˗C @юHաɄ_OH*+,4,lԳ2RRuHR] /u3gXl,nX zpN=A(n7a$pa6wRWc|r H!E?Ο;J Y&vgWQ@ N)D＃ + vĬXR)T \lpUU['cV!&I"OV
O"SRAVWibjoE|5;J]ej*wCqI wc$R y缜Z :88sii<-MrZ==7E#2E{('膛 Z\3'Nh544P2<e*
Acc+VH
lZ*lJxiNqvD> }ի%wB?|C(<
T-qظQZE{ _YIEJ-<_CSFoT-e8Ǒ#X^ZA ĺHa& jY>4jnkh1/J,h$Mb%HX#"+KHLVG-8y] 2C^%: 8IT-!V :}QR' tt0*X<y/L}d%E] RSetrd;weCzҐ; MR_MN' \RA\d2VT #.!/B '%D_ zzҥ$`QPbo%F~?ߏ ;ϝ1 Aֲm306 y"0-R@K ֮Fa TݎNo:Xu HEs|^/۱g{1}:F\&K"`h8t̃TLMe)e
5P"';`|zV+_Hr>yd
4Vٟnٕ0=311a<Ǹp$|N a%
وgaQy睟C|e*&&?$EM[ lR!##]v``~Zon7ʕ\j.6^mݺ NDB-ksIJ U%cc ̡Yf\:q `RuP2 %qbK +*BE؈ L`dx9Qj9l6 =~#,G&a~wtү}k .^d,+KKr"Uӧ%8`EEXKDv_ܕu֭[ }D# 2=ÇQ^.ł_gߏ A *Z` pHM ׇ dTŲ8{ZA&O".ySBYIVjvￏEZrv2.\`˖IڀI0ֳ^6!T3L&tu!?_dw =J4 > KH阜$e}6qEdh4JY_ o:SqKP*a0 R8 ӟs P[ Hp^p
(-p Mg 7TW#+ggKq}ۼYd3!G(\ՌaLHQG}*+
Qd%#{ޔ`4qRkzz %j SR_'F:#,swuHЀ2) fn7
KF!j1RW[E!njeLM#PZ
Z'U{¥K0'7/۬(puכBF~ IbyqÎ
UUANvMU(6{@d$J#Uχ
AA478H\{Zm+99È%wcx5`&9:#VWssy}=E'U
aN)0wv2qC_nՉJ"ơC(*bA кrÛrRznCӧ!l; \.ֲoHcg9<72c()2R t v;_D>vUU!%%[F
0y@N?y;$4RlTWt)쮻rC"a)/FRe%U Î R<
YZZ( T¼b >(Hշs.6luEHk#|/^inh=
Xtt Q'&\XVGFF2^ZF#ohࣣ,2sn6m6'= ȯ 2_iO4}ÁW^wtaVTGח-wknn==WGUvww\eѢE_̹0GGvb)vV+ؗRMSEjι_{ض
MяΞu^ >ys q9{ ;Joc0 /wwp|n}Nw[x}l%<9#Gͤ!!2Յۿ |o|ÿC 9X QU*UUU缯*/ީaZnXhXѬ[nz52x(,22/$%%UTT a 4a)>^x֖ϟzbr{k T(b sjx{O2D< c6x,EAW˅t wEQ
a
)Ψ9G] 'gCe%QΜB9sQNr:(|xmp8"TdM.2R :А#>$.b|lVl6 ̇FPꩼ$nb7փR55(-QQRY?
/Ugd`>櫵, ?{8tYF ezr{R']O@uJT*[d)LLuṋ*,T9dž
\.0Z0d&_))9
u2 YEf-ף\'ǎabO:
(۰*+ 9X.͠V..]**C|[-CլN'bbfYY-!U; 8p +J3lldHI wUض
>{iw8 55غuN1Wum- !r8K! lzkoܖ EK{Z3`Aʪ
y /&E@R"#y֮e߃={P[ ذsGEL(lЪFqqHe
\}{ tfZq,
[$BYէN|/#+HΟT"!A[N>G% h*WЀ
$*VTVbl.tWp}sd9~X՜c^TUqiƫ /?pߦ 44!^oG
P*yi\cAtd"Z IDATzbXJlL&͕DGe%}]gK=^vְ{sКaÑ YU76BIIR-QG bRMX 1?4ė離<:j~ =~Mvq8/H.ٗ4,f$ᛐ>L~)\
S|Ʉ_597{-d!4U}V^T$j;z!.$|"#hhcXK\.&Vh.bO@\«bвZq {!I&(ƅ ~D./N\܌ ;*䂋1Tu_ .Z XF[
kF5ڄ:hCPuu4c8q-_NdL g `Ubi.Kj(kV楥eTAjضMb%%ۡP[7 [kHtJŷld?WaO-NDZDC8q:TT||~ _?4/_y/'}=q1~Pł={qD%=9waKF܄TDE1 'r w&[iZZp EC ~6Wp|"v,&4;;
"" ?yV+Ĥ'Ҍ/q?Mo ?t_9N@YDc\hkckג`'ȱ| \Go"w ?;le"\C&ǒЋ+bU=<.vDOhEVP@+%%gӁb"\!x ~ oaDA((uћA oA{4bCJբCe%"$˝s 8lI磱1/idwϺϝi ,s{;_QWǿ
q6e(x\lf^=6&|;u áCmLwV䁌&@HF7ůwK/WbnDT,({`rWU͛}sTavThU!)I.ձ*&͐,R&3 fɁXݷo_6 }]{ه(_4蠕_r 9r
&ZZ?N~ݼ-oZ R
G0څD
t: (!!!(U-C<fNմ : pl"ƌnݺu
%..K%^2l=2C"Vkg# ;N 0ݍFCR/|ϯNOO;;;n
dd2eeeeee ⾺:ݜ,
;re(/Gm-۲e!+#qȃ|zvg]yM5
Q .bĖ-`~ }Xl)j۹dS+<0yHa!^yctRf6_'~7 x@Z|1|md! 1Iw * ;ƸkXѫl6arbx-8I1p8fjllnN;٥JVr- dd} S&@}uM
rr$rs >
NGM
? ۴ی555WعefKMM}g>&L\1(n^OEȼv33?f:2^ T=5?1q~ҦW$&"%]}f̃я~俻RTUUU
-Ʀk2g@ 5h65ŲI^P /uu$~nDM
6l(ٝw"0K&=_Ǐ3q#MhBDP(Qs.VYI
ذGPw pÑBA՜WK4 8xf`dzfħ\dq,* Ru_ QOOeajx>#5٬OpC ZB ORJ={\;F dBJ
=P55ظ
,0[`^e U=4^=SI_n }&
KE u ̝ C)ƊҌ
-~?]MTo`LRӉÇ}DsĊ" FQI.I`jkk;G X{ Օߙ{q3DUCeQ7a nm֦vƚMv7l[7 lS1صZZ(b*(afcĚZ 3g.=^/~g~wn꺁ߦi~G/CQĉ Z[YVW0z{{
@\ _~9Y3*?7V{8tV z@C7Nge IeDX.QO [-};Q(<"nn~|Za?:ՊEpk :99H++Eq8
7G",Z:
{bkjHu+ϢQH#] XU4sn(vsνӣn:Z%NFmPq.aMN\hi"h[D((mt: 0c$D^dF.*+pkz7c|z
+Wo4t>ڵ{h6}>C+W~a tWTZjHK3=Μs0;b'F՜狛rRRhxk| s8Fی@ߣ )V믹߃8rfdݎ_ ǣFL:X T]x:|XZU+d$'joFWfy<%%~hƍpE,n$Q_O|ϟG+ ^/ +xQOczIZ
zzPZJEEI!V|8w1Aǽ22h$x0u*rs\ڑ v -_.[ ʰq#ַpН;*0 N~
ٳbUh ԄqOhAf&uN8իt{m' ./ǔ)ׇ'饗 Ts*]㈱(qUEM
͛1yp7\ |qj8
b $ ;Kwv xnT->;٦M4I x{bŊW-~|>TTP~$ D!`^ƶ_SVWc }쭷0m KW =lΘs废Lt$"a ~w.l_|5 4 aմu(&՜
gt<&"ż?kt6jGis;v7XtJ? z n@s3N5Es'h: NJ/KF>__^^^^RR^/N|P(lr 7o".Tu
tctdfl
_SiA9z{w/}
{MfuGGǙ3gB;w~%H/^
5f<9k'xz3lֿ?8>]._dΠ>өS,3ňbl~v;Nt:ns4eee*++}~P"]{
^1fb~Idaʲ=V3jjCG ho нc{?p>`uֹ|fdd{'
Wҁۋ,Z'l2Jˤ(J^^2+\.,ӧO_vmiE̙3jk͚5Z&%U~>m30%6*P GvgXv墶6|njl$ kbtܗW-I3 VڵKduh iH^n8kqU*Ĺ/i^Ța0 +`` l6M%7ru0,.'F=蹋N8$h(b瞣e(!6=E>tD@`h1c1gl` 2ɡ O99O; WꞣMK⤦۷/xKOOJM4 6;VkXT?eYhcuhCXxq躩'dii0-(( pV[,N}I -a0*ZpcV a|,kuL&f6j j:88A4Z &IhO٬U"ꄄ=.Qha] ! \Q KA*^WCTԚ Ǡrεh!4;, IENDB` zpb-ttf-0.7/LICENSE 0100664 0000764 0000764 00000002512 10375724222 012422 0 ustar xach xach ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
;;;
;;; Redistribution and use in source and binary forms, with or without
;;; modification, are permitted provided that the following conditions
;;; are met:
;;;
;;; * Redistributions of source code must retain the above copyright
;;; notice, this list of conditions and the following disclaimer.
;;;
;;; * Redistributions in binary form must reproduce the above
;;; copyright notice, this list of conditions and the following
;;; disclaimer in the documentation and/or other materials
;;; provided with the distribution.
;;;
;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.