photofont.lisp
Last edited on December 8, 2008
Yesterday I've stumbled upon Photofonts, a font format where every letter is a fully colored bitmap image. It also supports kerning and Unicode encoding. The file format specification is publicly documented: it's an xml file, the characters are Base64-encoded PNG images in a MIME-container. How nice! And certainly the most efficient way to store binary data.
Sadly there is no Gimp plug-in yet, but you can download a plug-in for Adobe Photoshop, Adobe Illustrator, and Corel Painter for free, and the company has announced plug-ins for Adobe InDesign as well as QuarkXPress. Well, the graphic designers will be happy with those… They have also developed Flash-based embedded web font stuff, but for the program to convert photofonts into that format, called Photofont WebReady, they want to see some money.
Enough of that! A quick look into the CLiki — the Common Lisp Wiki informed me about XMLS, CL-MIME, s-base64, and CL-PNG. Everything I need. Thanks go to the authors and maintainers Drew Crampsie, Robert Marlow, Sven Van Caekenberghe, Harald Musum, and Vebjorn Ljosa! The interfaces are all quite usable and after looking into some free photofonts from the aforementioned homepage (mostly from my Lisp image using XMLS:PARSE) and some hacking I now have a photofont:
Please click on the image to have a look at the HUGE version! I hope you like it! Every single character of this font is a photograph of some arranged tea light candles. But this article is about the photofont format and my program to generate photofonts, and not about my particular Tea Light Canle Font. Perhaps there will be a separate article some time in the future…
Well, here comes the quick and dirty implementation in Common Lisp:
;;; photofont.lisp - A program to generate photofonts
;;; Dec 5, 2008 by Max-Gerd Retzlaff <m.retzlaff@gmx.net>
;;; Version 1
;;;
;;; See http://www.photofont.com/ for more information.
;;; The "Photofont format specification" is here:
;;; http://www.photofont.com/photofont/devel/
;;;
;;; Example call:
;;; (photofont "Teelichter256" "font-spec-256" "Teelichter256.phf" :indent nil)
;;;
;;; The font-spec file is expected to contain lines like this one:
;;; ! Teelichter-256/!_dscf5475.jpg.png
;;; (single character, a single space, filename with relative path, newline character)
(require :xmls)
(require :cl-mime)
(require :s-base64)
(require :png) ;; cl-png
(defun png->mime (pathname)
(with-output-to-string (mime-out)
(let ((png (with-open-file (in pathname
:element-type '(unsigned-byte 8))
(with-output-to-string (out)
(s-base64:encode-base64 in out)))))
(mime:print-mime mime-out
(make-instance 'mime:text-mime
:type "image"
:subtype "png"
:charset "US-ASCII"
:content-encoding :base64
:encoding :base64
:content png)
t nil))))
;; (png->mime "Teelichter/256/A_dscf5380.jpg.png")
(defun png-dimensions (pathname)
(let ((png (with-open-file (in pathname
:element-type '(unsigned-byte 8))
(png:decode in))))
(values (png:image-width png)
(png:image-height png))))
(defun root (children)
(xmls:make-node :name "PhF" :attrs '(("version" "1.0"))
:children children))
#+(or)
(defun header ()
(xmls:make-node :name "header"
(make-node :name "version" :attrs (xmls:make-node :name "type" :attrs "string"))
(make-node :name)
))
(defun header (fontname &key (encoding "ISO 8859- 1 Latin 1 (Western)")
(ascender 256)
(descender 51)
(internal-leading 77)
(upm 256))
`("header" NIL ("version" (("type" "string")))
("family" (("type" "string")) ,fontname)
("full_name" (("type" "string")) ,fontname)
("codepage" (("type" "string")) ,(princ-to-string encoding))
("ascender" (("type" "int")) ,(princ-to-string ascender))
("descender" (("type" "int")) ,(princ-to-string descender))
("internal_leading" (("type" "int")) ,(princ-to-string internal-leading))
("upm" (("type" "int")) ,upm)))
(defun letter->id (letter)
"More or less a bugfix, as the photofont plug-in for Adobe Photoshop CS3 (Windows),
seems to have a problem with XML encodings like \"§\"... Otherwise I would just
use STRING."
(let ((code (char-code letter)))
(if (< 127 code)
(char-name letter)
;; (format nil "~a+0x80" (code-char (- code 128)))
(string letter))))
(defun mapping (letter)
`("map" (("unc" ,(princ-to-string (char-code letter))) ("id" ,(letter->id letter)))))
(defun all-mappings (letters)
(mapcar #'mapping letters))
(defun globals (all-mappings)
`("globals" NIL
("unicode_mapping" (("subtype" "map_unicode") ("type" "array"))
,@all-mappings)))
;; (globals (all-mappings (coerce "ABCDß!§$" 'list)))
(defun glyph (letter pathname)
(multiple-value-bind (width height)
(png-dimensions pathname)
(let ((width-string (princ-to-string width))
(height-string (princ-to-string height)))
`("glyph" (("id" ,(letter->id letter)))
("image" (("type" "photo")
("id" "v0"))
("shape" (("embedded" ,(file-namestring pathname)))
("ppm" (("int" ,height-string)))
("bbox" (("height" ,height-string) ("width" ,width-string)
("y" "0") ("x" "0")))
("base" (("y" ,height-string) ("x" "0")))
("delta" (("y" "0") ("x" ,(princ-to-string (- width 2)))))))))))
(defun all-glyphs (list)
(xmls:make-node :name "glyphs"
:children (mapcar (lambda (glyph-spec)
(apply #'glyph glyph-spec))
list)))
#+(or)
(all-glyphs '((#\A #p"Teelichter/256/A_dscf5380.jpg.png")
(#\B #p"Teelichter/256/B_dscf5702.jpg.png")))
(defun image (pathname)
(xmls:make-node :name "image" :attrs `(("id" ,(file-namestring pathname)))
:children (list (png->mime pathname))))
;; (image "Teelichter/256/A_dscf5380.jpg.png")
(defun all-images (pathnames)
(xmls:make-node :name "data"
:children (list (xmls:make-node :name "photo"
:children (mapcar #'image pathnames)))))
#+(or)
(all-images (list "Teelichter/256/A_dscf5380.jpg.png"
"Teelichter/256/B_dscf5702.jpg.png"))
(defun parse-fontspec (pathname)
(let ((glyph-specs))
(with-open-file (file pathname)
(do ((line (read-line file nil 'eof)
(read-line file nil 'eof)))
((eq line 'eof))
(push (list (elt line 0)
(subseq line 2))
glyph-specs)))
(nreverse glyph-specs)))
(defun generate-photofont (fontname pathname)
(let ((glyph-specs (parse-fontspec pathname)))
(multiple-value-bind (width height)
(png-dimensions (second (first glyph-specs)))
(declare (ignore height))
(root
(list
(header fontname
:ascender (princ-to-string width)
:upm (princ-to-string width))
(globals (all-mappings (mapcar #'car glyph-specs)))
(all-glyphs glyph-specs)
(all-images (mapcar #'second glyph-specs)))))))
(defun photofont (fontname source target &key indent)
(with-open-file (out target :direction :output :if-exists :overwrite :if-does-not-exist :create)
(princ "<?xml version=\"1.0\" ?>
" out)
(xmls:write-xml (generate-photofont fontname source) out :indent indent)))
;; (photofont "Teelichter256" "font-spec-256" "Teelichter256.phf" :indent nil)
;; (princ (xmls:toxml * :indent t))
Please send me an email if you have a use for this
code or have a nice photofont for me. Thanks in advance!
