From 3e6b4396fddd193b6633cb9952255715a0c01d69 Mon Sep 17 00:00:00 2001
From: Zach Beane <xach@xach.com>
Date: Sun, 5 Jun 2011 19:27:45 -0400
Subject: [PATCH] Support opening streams as font loaders.

---
 font-loader-interface.lisp | 20 ++++++++++++++------
 zpb-ttf.html               |  4 ++--
 2 files changed, 16 insertions(+), 8 deletions(-)

diff --git a/font-loader-interface.lisp b/font-loader-interface.lisp
index b010fe0..89442bd 100644
--- a/font-loader-interface.lisp
+++ b/font-loader-interface.lisp
@@ -49,11 +49,8 @@
 ;;; 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)))
+(defun open-font-loader-from-stream (input-stream)
+  (let ((magic (read-uint32 input-stream)))
     (when (/= magic #x00010000 #x74727565)
       (error 'bad-magic
              :location "font header"
@@ -63,7 +60,6 @@
            (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)
@@ -92,12 +88,24 @@
             (make-array (glyph-count font-loader) :initial-element nil))
       font-loader)))
 
+(defun open-font-loader-from-file (thing)
+  (let ((stream (open thing
+                      :direction :input
+                      :element-type '(unsigned-byte 8))))
+    (let ((font-loader (open-font-loader-from-stream stream)))
+      (arrange-finalization font-loader stream)
+      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)
+    (stream
+     (if (open-stream-p thing)
+         (open-font-loader-from-stream thing)
+         (error "~A is not an open stream" thing)))
     (t
      (open-font-loader-from-file thing))))
 
diff --git a/zpb-ttf.html b/zpb-ttf.html
index f2a4fda..5ada768 100644
--- a/zpb-ttf.html
+++ b/zpb-ttf.html
@@ -21,7 +21,7 @@ href="http://www.microsoft.com/OpenType/OTSpec/otff.htm">documented</a>
 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 1.0, released on November 3, 2008.
+license. The current version is 1.0.1, released on June 5, 2011.
 
 <p>TrueType is a registered trademark of Apple Computer, Inc.
 
@@ -173,7 +173,7 @@ href='#do-contour-segments'><tt>DO-CONTOUR-SEGMENTS</tt></a>.
 <blockquote>
 Creates and returns a font-loader object from
 <i>font-file-designator</i>, which should be either a pathname,
-pathname namestring, or a font-loader object.
+pathname namestring, a stream, or a font-loader object.
 </blockquote>
 
 
-- 
2.11.4.GIT