1 ;;; Copyright (c) 2006 Zachary Beane, All Rights Reserved
3 ;;; Redistribution and use in source and binary forms, with or without
4 ;;; modification, are permitted provided that the following conditions
7 ;;; * Redistributions of source code must retain the above copyright
8 ;;; notice, this list of conditions and the following disclaimer.
10 ;;; * Redistributions in binary form must reproduce the above
11 ;;; copyright notice, this list of conditions and the following
12 ;;; disclaimer in the documentation and/or other materials
13 ;;; provided with the distribution.
15 ;;; THIS SOFTWARE IS PROVIDED BY THE AUTHOR 'AS IS' AND ANY EXPRESSED
16 ;;; OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
17 ;;; WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE
18 ;;; ARE DISCLAIMED. IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY
19 ;;; DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
20 ;;; DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
21 ;;; GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
22 ;;; INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
23 ;;; WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING
24 ;;; NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS
25 ;;; SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
27 ;;; The font-loader object, which is the primary interface for
28 ;;; getting glyph and metrics info.
30 ;;; $Id: font-loader.lisp,v 1.26 2006/03/23 22:21:40 xach Exp $
32 (in-package #:zpb-ttf
)
34 (defclass font-loader
()
35 ((tables :initform
(make-hash-table) :reader tables
)
36 (input-stream :initarg
:input-stream
:accessor input-stream
37 :documentation
"The stream from which things are loaded.")
38 (table-count :initarg
:table-count
:reader table-count
)
39 ;; from the 'head' table
40 (units/em
:accessor units
/em
)
41 (bounding-box :accessor bounding-box
)
42 (loca-offset-format :accessor loca-offset-format
)
43 ;; from the 'loca' table
44 (glyph-locations :accessor glyph-locations
)
45 ;; from the 'cmap' table
46 (character-map :accessor character-map
)
47 (inverse-character-map :accessor inverse-character-map
)
48 ;; from the 'maxp' table
49 (glyph-count :accessor glyph-count
)
50 ;; from the 'hhea' table
51 (ascender :accessor ascender
)
52 (descender :accessor descender
)
53 (line-gap :accessor line-gap
)
54 (max-width :accessor max-width
)
55 ;; from the 'hmtx' table
56 (advance-widths :accessor advance-widths
)
57 (left-side-bearings :accessor left-side-bearings
)
58 ;; from the 'vhea' table
59 (vhea-missing-p :initform nil
:accessor vhea-missing-p
)
60 (vascender :accessor vascender
)
61 (vdescender :accessor vascender
)
62 ;; from 'vhea' and 'vmtx' tables
63 (vmtx-missing-p :initform nil
:accessor vmtx-missing-p
)
64 (advance-heights :accessor advance-heights
)
65 (top-side-bearings :accessor top-side-bearings
)
66 ;; from the 'kern' table
67 (kerning-table :initform
(make-hash-table) :accessor kerning-table
)
68 ;; from the 'name' table
69 (name-entries :initform nil
:accessor name-entries
)
70 ;; from the 'post' table
71 (italic-angle :accessor italic-angle
:initform
0)
72 (fixed-pitch-p :accessor fixed-pitch-p
:initform nil
)
73 (underline-position :accessor underline-position
:initform
0)
74 (underline-thickness :accessor underline-thickness
:initform
0)
75 (postscript-glyph-names :accessor postscript-glyph-names
)
77 (glyph-cache :accessor glyph-cache
)
78 ;; # of fonts in collection, if loaded from a ttc file
79 (collection-font-count :reader collection-font-count
:initform nil
80 :initarg
:collection-font-cont
)
81 ;; index of font in collection, if loaded from a ttc file
82 (collection-font-index :reader collection-font-index
:initform nil
83 :initarg
:collection-font-index
)))
85 (defclass table-info
()
86 ((name :initarg
:name
:reader name
)
87 (offset :initarg
:offset
:reader offset
)
88 (size :initarg
:size
:reader size
)))
90 (defmethod print-object ((object table-info
) stream
)
91 (print-unreadable-object (object stream
:type t
)
92 (format stream
"\"~A\"" (name object
))))
95 ;;; tag integers to strings and back
97 (defun number->tag
(number)
98 "Convert the 32-bit NUMBER to a string of four characters based on
99 the CODE-CHAR of each octet in the number."
100 (let ((tag (make-string 4)))
102 for offset from
24 downto
0 by
8
103 do
(setf (schar tag i
)
104 (code-char (ldb (byte 8 offset
) number
))))
107 (defun tag->number
(tag)
108 "Convert the four-character string TAG to a 32-bit number based on
109 the CHAR-CODE of each character."
110 (declare (simple-string tag
))
111 (loop for char across tag
112 for offset from
24 downto
0 by
8
113 summing
(ash (char-code char
) offset
)))
116 ;;; Getting table info out of the loader
118 (defmethod table-info ((tag string
) (font-loader font-loader
))
119 (gethash (tag->number tag
) (tables font-loader
)))
121 (defmethod table-exists-p (tag font-loader
)
122 (nth-value 1 (table-info tag font-loader
)))
124 (defmethod table-position ((tag string
) (font-loader font-loader
))
125 "Return the byte position in the font-loader's stream for the table
127 (let ((table-info (table-info tag font-loader
)))
130 (error "No such table -- ~A" tag
))))
132 (defmethod table-size ((tag string
) (font-loader font-loader
))
133 (let ((table-info (table-info tag font-loader
)))
136 (error "No such table -- ~A" tag
))))
138 (defmethod seek-to-table ((tag string
) (font-loader font-loader
))
139 "Move FONT-LOADER's input stream to the start of the table named by TAG."
140 (let ((table-info (table-info tag font-loader
)))
142 (seek-to-table table-info font-loader
)
143 (error "No such table -- ~A" tag
))))
145 (defmethod seek-to-table ((table table-info
) (font-loader font-loader
))
146 "Move FONT-LOADER's input stream to the start of TABLE."
147 (file-position (input-stream font-loader
) (offset table
)))