Add OTF/TTF font support via freetype.

8 files changed, 542 insertions, 32 deletions

diff --git a/Makefile.am b/Makefile.am
index 5cd42b5..83232a3 100644
--- a/Makefile.am
+++ b/Makefile.am
@@ -46,6 +46,7 @@ SOURCES = 					\
   chickadee/heap.scm				\
   chickadee/array-list.scm			\
   chickadee/queue.scm				\
+  chickadee/freetype.scm			\
   chickadee/math.scm				\
   chickadee/math/vector.scm			\
   chickadee/math/bezier.scm			\
diff --git a/chickadee/config.scm.in b/chickadee/config.scm.in
index 5a2a8f8..76f70ce 100644
--- a/chickadee/config.scm.in
+++ b/chickadee/config.scm.in
@@ -27,6 +27,7 @@
             %libopenal
             %libvorbisfile
             %libmpg123
+            %libfreetype
             scope-datadir))
 
 (define %datadir
@@ -37,6 +38,7 @@
 (define %libopenal "@OPENAL_LIBDIR@/libopenal")
 (define %libvorbisfile "@VORBIS_LIBDIR@/libvorbisfile")
 (define %libmpg123 "@MPG123_LIBDIR@/libmpg123")
+(define %libfreetype "@FREETYPE_LIBDIR@/libfreetype")
 
 (define (scope-datadir file)
   "Append the Chickadee data directory to FILE."
diff --git a/chickadee/freetype.scm b/chickadee/freetype.scm
new file mode 100644
index 0000000..58a1d08
--- /dev/null
+++ b/chickadee/freetype.scm
@@ -0,0 +1,356 @@
+;;; Chickadee Game Toolkit
+;;; Copyright © 2020 David Thompson <davet@gnu.org>
+;;;
+;;; Chickadee is free software: you can redistribute it and/or modify
+;;; it under the terms of the GNU General Public License as published
+;;; by the Free Software Foundation, either version 3 of the License,
+;;; or (at your option) any later version.
+;;;
+;;; Chickadee is distributed in the hope that it will be useful, but
+;;; WITHOUT ANY WARRANTY; without even the implied warranty of
+;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
+;;; General Public License for more details.
+;;;
+;;; You should have received a copy of the GNU General Public License
+;;; along with this program.  If not, see
+;;; <http://www.gnu.org/licenses/>.
+
+;;; Commentary:
+;;
+;; FreeType 2 bindings.
+;;
+;;; Code:
+
+(define-module (chickadee freetype)
+  #:use-module (chickadee config)
+  #:use-module (ice-9 format)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-9)
+  #:use-module (system foreign)
+  #:export (init-freetype
+            freetype-handle?
+            load-face
+            freetype-face?
+            face-num-glyphs
+            face-family-name
+            face-style-name
+            face-height
+            face-glyph-slot
+            face-size
+            get-char-index
+            get-kerning
+            set-char-size!
+            load-char
+            glyph-metrics
+            glyph-bitmap
+            glyph-bitmap-left
+            glyph-bitmap-top
+            size-metrics))
+
+
+;;;
+;;; Low-level bindings
+;;;
+
+(define %lib (dynamic-link %libfreetype))
+
+(define (freetype-func return-type function-name arg-types)
+  (pointer->procedure return-type
+                      (dynamic-func function-name %lib)
+                      arg-types))
+
+(define-syntax-rule (define-foreign name return-type func-name arg-types)
+  (define name
+    (freetype-func return-type func-name arg-types)))
+
+(define FT_LOAD_NO_SCALE                    1)
+(define FT_LOAD_NO_HINTING                  2)
+(define FT_LOAD_RENDER                      4)
+(define FT_LOAD_NO_BITMAP                   8)
+(define FT_LOAD_VERTICAL_LAYOUT             16)
+(define FT_LOAD_FORCE_AUTOHINT              32)
+(define FT_LOAD_CROP_BITMAP                 64)
+(define FT_LOAD_PEDANTIC                    128)
+(define FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH 256)
+(define FT_LOAD_NO_RECURSE                  512)
+(define FT_LOAD_IGNORE_TRANSFORM            1024)
+(define FT_LOAD_MONOCHROME                  2048)
+(define FT_LOAD_LINEAR_DESIGN               4096)
+(define FT_LOAD_NO_AUTOHINT                 8192)
+(define FT_LOAD_COLOR                       16384)
+(define FT_LOAD_COMPUTE_METRICS             32768)
+(define FT_LOAD_BITMAP_METRICS_ONLY         65536)
+
+(define-foreign ft-error-string
+  '* "FT_Error_String" (list int))
+
+(define-foreign ft-init-freetype
+  int "FT_Init_FreeType" '(*))
+
+(define ft-done-freetype (dynamic-func "FT_Done_FreeType" %lib))
+
+(define-foreign ft-new-face
+  int "FT_New_Face" (list '* '* long '*))
+
+(define ft-done-face (dynamic-func "FT_Done_Face" %lib))
+
+(define-foreign ft-set-char-size
+  int "FT_Set_Char_Size" (list '* long long unsigned-int unsigned-int))
+
+(define-foreign ft-get-char-index
+  unsigned-long "FT_Get_Char_Index" (list '* unsigned-long))
+
+(define-foreign ft-load-glyph
+  int "FT_Load_Glyph" (list '* unsigned-int int32))
+
+(define-foreign ft-render-glyph
+  int "FT_Render_Glyph" (list '* int))
+
+(define-foreign ft-load-char
+  int "FT_Load_Char" (list '* unsigned-long int32))
+
+(define-foreign ft-get-kerning
+  int "FT_Get_Kerning" (list '* unsigned-int unsigned-int unsigned-int '*))
+
+;; This is all super hacky since Guile doesn't provide a good way to index
+;; into struct pointers.
+(define ft-generic '(* *))
+(define ft-bbox (list long long long long))
+(define ft-vector (list long long))
+
+;;  https://www.freetype.org/freetype2/docs/reference/ft2-base_interface.html#ft_glyph_metrics
+(define ft-glyph-metrics
+  (list long long long long long long long long))
+
+;; https://www.freetype.org/freetype2/docs/reference/ft2-basic_types.html#ft_bitmap
+(define ft-bitmap
+  (list unsigned-int unsigned-int int '* short uint8 uint8 '*))
+
+;; https://www.freetype.org/freetype2/docs/reference/ft2-base_interface.html#ft_facerec
+(define face-num-glyphs-offset
+  (sizeof (list long long long long)))
+(define face-family-name-offset
+  (sizeof (list long long long long long)))
+(define face-style-name-offset
+  (sizeof (list long long long long long '*)))
+(define face-height-offset
+  (sizeof (list long long long long long '*
+                '* int '* int '* ft-generic
+                ft-bbox unsigned-short short short)))
+(define face-glyph-slot-offset
+  (sizeof (list long long long long long '*
+                '* int '* int '* ft-generic
+                ft-bbox unsigned-short
+                short short short short short short short)))
+(define face-size-offset
+  (sizeof (list long long long long long '*
+                '* int '* int '* ft-generic
+                ft-bbox unsigned-short
+                short short short short short short short
+                '*)))
+
+;; https://www.freetype.org/freetype2/docs/reference/ft2-base_interface.html#ft_glyphslotrec
+(define glyph-slot-metrics-offset
+  (sizeof (list '* '* '* unsigned-int '* '*)))
+(define glyph-slot-bitmap-offset
+  (+ glyph-slot-metrics-offset
+     (sizeof (list ft-glyph-metrics long long ft-vector int))))
+(define glyph-slot-bitmap-left-offset
+  (+ glyph-slot-bitmap-offset (sizeof ft-bitmap)))
+(define glyph-slot-bitmap-top-offset
+  (+ glyph-slot-bitmap-left-offset (sizeof int)))
+
+;; https://www.freetype.org/freetype2/docs/reference/ft2-base_interface.html#ft_sizerec
+(define size-metrics-offset
+  (sizeof (list '* ft-generic)))
+(define ft-size-metrics
+  (list unsigned-short unsigned-short long long long long long long))
+
+
+;;;
+;;; High-level wrappers
+;;;
+
+(define (make-pointer-pointer)
+  (make-bytevector (sizeof uintptr_t)))
+
+(define (bytevector-pointer-ref bv finalizer)
+  (make-pointer (bytevector-uint-ref bv 0 (native-endianness) (sizeof uintptr_t))
+                finalizer))
+
+(define (extract-pointer pointer offset)
+  (dereference-pointer (make-pointer (+ (pointer-address pointer) offset))))
+
+(define (extract-string pointer offset)
+  (pointer->string (extract-pointer pointer offset)))
+
+(define (check-error error message)
+  (unless (zero? error)
+    (error message (pointer->string (ft-error-string error)))))
+
+(define-wrapped-pointer-type <freetype-handle>
+  freetype-handle?
+  wrap-freetype-handle unwrap-freetype-handle
+  (lambda (handle port)
+    (display "#<freetype-handle>" port)))
+
+(define (init-freetype)
+  (let ((bv (make-pointer-pointer)))
+    (check-error (ft-init-freetype (bytevector->pointer bv))
+                 "failed to initialize freetype library")
+    (wrap-freetype-handle (bytevector-pointer-ref bv ft-done-freetype))))
+
+(define-wrapped-pointer-type <freetype-face>
+  freetype-face?
+  wrap-freetype-face unwrap-freetype-face
+  (lambda (face port)
+    (display "#<freetype-face>" port)))
+
+(define* (load-face handle file-name #:optional (face-index 0))
+  (let ((bv (make-pointer-pointer)))
+    (check-error (ft-new-face (unwrap-freetype-handle handle)
+                              (string->pointer file-name)
+                              face-index
+                              (bytevector->pointer bv))
+                 "failed to load face")
+    (wrap-freetype-face (bytevector-pointer-ref bv ft-done-face))))
+
+(define (set-char-size! face width height horizontal-dpi vertical-dpi)
+  (check-error (ft-set-char-size (unwrap-freetype-face face)
+                                 width
+                                 height
+                                 horizontal-dpi
+                                 vertical-dpi)
+               "failed to set face char size"))
+
+(define (get-char-index face char)
+  (ft-get-char-index (unwrap-freetype-face face)
+                     (char->integer char)))
+
+(define (get-kerning face left-index right-index )
+  (let ((bv (make-s64vector 2)))
+    (check-error (ft-get-kerning (unwrap-freetype-face face)
+                                 left-index
+                                 right-index
+                                 0
+                                 (bytevector->pointer bv))
+                 "failed to get kerning")
+    bv))
+
+(define (load-flags->bitmask flags)
+  (fold (lambda (flag prev)
+          (logior prev
+                  (match flag
+                    ('no-scale FT_LOAD_NO_SCALE)
+                    ('no-hinting FT_LOAD_NO_HINTING)
+                    ('render FT_LOAD_RENDER)
+                    ('no-bitmap FT_LOAD_NO_BITMAP)
+                    ('vertical-layout FT_LOAD_VERTICAL_LAYOUT)
+                    ('force-auto-hint FT_LOAD_FORCE_AUTOHINT)
+                    ('crop-bitmap FT_LOAD_CROP_BITMAP)
+                    ('pedantic FT_LOAD_PEDANTIC)
+                    ('ignore-global-advance-width FT_LOAD_IGNORE_GLOBAL_ADVANCE_WIDTH)
+                    ('no-recurse FT_LOAD_NO_RECURSE)
+                    ('ignore-transform FT_LOAD_IGNORE_TRANSFORM)
+                    ('load-monochrome FT_LOAD_MONOCHROME)
+                    ('linear-design FT_LOAD_LINEAR_DESIGN)
+                    ('no-auto-hint FT_LOAD_NO_AUTOHINT)
+                    ('load-color FT_LOAD_COLOR)
+                    ('compute-metrics FT_LOAD_COMPUTE_METRICS)
+                    ('bitmap-metrics-only FT_LOAD_BITMAP_METRICS_ONLY))))
+        0
+        flags))
+
+(define* (load-glyph face index #:optional (flags '()))
+  (check-error (ft-load-glyph (unwrap-freetype-face face)
+                              index
+                              (load-flags->bitmask flags))
+               "failed to load glyph"))
+
+(define* (load-char face char #:optional (flags '()))
+  (check-error (ft-load-char (unwrap-freetype-face face)
+                             (char->integer char)
+                             (load-flags->bitmask flags))
+               "failed to load char"))
+
+(define (face-num-glyphs face)
+  (s64vector-ref (pointer->bytevector (unwrap-freetype-face face)
+                                      1 face-num-glyphs-offset 's64)
+                 0))
+
+(define (face-family-name face)
+  (extract-string (unwrap-freetype-face face) face-family-name-offset))
+
+(define (face-style-name face)
+  (extract-string (unwrap-freetype-face face) face-style-name-offset))
+
+(define (face-height face)
+  (s64vector-ref (pointer->bytevector (unwrap-freetype-face face)
+                                      1
+                                      face-height-offset
+                                      's64)
+                 0))
+
+(define-wrapped-pointer-type <freetype-glyph-slot>
+  freetype-glyph-slot?
+  wrap-freetype-glyph-slot unwrap-freetype-glyph-slot
+  (lambda (glyph-slot port)
+    (display "#<freetype-glyph-slot>" port)))
+
+(define (face-glyph-slot face)
+  (wrap-freetype-glyph-slot
+   (extract-pointer (unwrap-freetype-face face) face-glyph-slot-offset)))
+
+(define-wrapped-pointer-type <freetype-size>
+  freetype-size?
+  wrap-freetype-size unwrap-freetype-size
+  (lambda (size port)
+    (display "#<freetype-size>" port)))
+
+(define (face-size face)
+  (wrap-freetype-size
+   (extract-pointer (unwrap-freetype-face face) face-size-offset)))
+
+(define (size-metrics size)
+  (parse-c-struct (make-pointer (+ (pointer-address
+                                    (unwrap-freetype-size size))
+                                   size-metrics-offset))
+                  ft-size-metrics))
+
+(define (glyph-metrics glyph-slot)
+  (match (parse-c-struct (make-pointer (+ (pointer-address
+                                           (unwrap-freetype-glyph-slot glyph-slot))
+                                          glyph-slot-metrics-offset))
+                         ft-glyph-metrics)
+    ;; Ignoring vertical layout for now.
+    ((_ _ bearing-x bearing-y advance _ _ _)
+     (list (/ bearing-x 64) (/ bearing-y 64) (/ advance 64)))))
+
+(define (glyph-bitmap glyph-slot)
+  (match (parse-c-struct (make-pointer (+ (pointer-address
+                                           (unwrap-freetype-glyph-slot glyph-slot))
+                                          glyph-slot-bitmap-offset))
+                         ft-bitmap)
+    ((height width pitch buffer num-grays pixel-mode _ _)
+     (list width height pitch
+           (and (not (zero? (pointer-address buffer)))
+                (pointer->bytevector buffer (* height pitch)))))))
+
+(define (glyph-bitmap-left glyph-slot)
+  (bytevector-sint-ref (pointer->bytevector (unwrap-freetype-glyph-slot glyph-slot)
+                                            (sizeof int)
+                                            glyph-slot-bitmap-left-offset)
+                       0
+                       (native-endianness)
+                       (sizeof int)))
+
+
+(define (glyph-bitmap-top glyph-slot)
+  (bytevector-sint-ref (pointer->bytevector (unwrap-freetype-glyph-slot glyph-slot)
+                                            (sizeof int)
+                                            glyph-slot-bitmap-top-offset)
+                       0
+                       (native-endianness)
+                       (sizeof int)))
diff --git a/chickadee/render/font.scm b/chickadee/render/font.scm
index 537590d..759ccb0 100644
--- a/chickadee/render/font.scm
+++ b/chickadee/render/font.scm
@@ -1,5 +1,5 @@
 ;;; Chickadee Game Toolkit
-;;; Copyright © 2017 David Thompson <davet@gnu.org>
+;;; Copyright © 2017, 2020 David Thompson <davet@gnu.org>
 ;;;
 ;;; Chickadee is free software: you can redistribute it and/or modify
 ;;; it under the terms of the GNU General Public License as published
@@ -24,22 +24,28 @@
 (define-module (chickadee render font)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (ice-9 regex)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-4)
   #:use-module (srfi srfi-9)
   #:use-module (srfi srfi-9 gnu)
   #:use-module (srfi srfi-11)
   #:use-module (sxml xpath)
   #:use-module (sxml simple)
   #:use-module (chickadee config)
+  #:use-module (chickadee freetype)
   #:use-module (chickadee math matrix)
   #:use-module (chickadee math rect)
   #:use-module (chickadee math vector)
   #:use-module (chickadee render)
+  #:use-module (chickadee render gpu)
   #:use-module (chickadee render shader)
   #:use-module (chickadee render sprite)
   #:use-module (chickadee render texture)
-  #:export (load-font
-            load-tile-font
+  #:use-module (rnrs bytevectors)
+  #:export (load-tile-font
+            load-bitmap-font
+            load-font
             font?
             font-face
             font-line-height
@@ -60,14 +66,14 @@
   (advance font-char-advance))
 
 (define-record-type <font>
-  (make-font face bold? italic? line-height chars kerning sprite-batches)
+  (make-font face bold? italic? line-height chars kernings sprite-batches)
   font?
   (face font-face)
   (bold? font-bold?)
   (italic? font-italic?)
   (line-height font-line-height)
   (chars font-chars)
-  (kerning font-kerning)
+  (kernings font-kernings)
   (sprite-batches font-sprite-batches))
 
 (define (display-font font port)
@@ -90,6 +96,116 @@
                 (+ i 1)))
         width)))
 
+(define freetype-handle
+  (delay (init-freetype)))
+
+(define* (load-font file-name point-size #:key (char-set char-set:ascii))
+  "Load all the glyphs in CHAR-SET from the font in FILE-NAME and
+display it at POINT-SIZE.  By default, the ASCII character is used."
+  (unless (file-exists? file-name)
+    (error "no such file" file-name))
+  (let ((face (load-face (force freetype-handle) file-name))
+        (chars (make-hash-table))
+        (kernings (make-hash-table))
+        (batches (make-hash-table))
+        (texture-size (min (gpu-max-texture-size (current-gpu)) 2048)))
+    ;; TODO: Use actual screen DPI.
+    (set-char-size! face (* point-size 64) 0 96 96)
+    (let ((glyph (face-glyph-slot face))
+          (pixels (make-bytevector (* texture-size texture-size 4)))
+          (x 0)
+          (y 0)
+          (next-y 0))
+      (define (add-pixels char width height pitch left top advance glyph-pixels)
+        (when (> (+ x width) texture-size)
+          (set! y next-y)
+          (set! x 0))
+        (let y-loop ((row 0))
+          (when (< row height)
+            (let x-loop ((column 0))
+              (when (< column width)
+                (let ((gray (u8vector-ref glyph-pixels
+                                          (+ (* row pitch) column)))
+                      (offset (+ (* (+ y row) texture-size 4)
+                                 (* (+ x column) 4))))
+                  (u8vector-set! pixels offset 255)
+                  (u8vector-set! pixels (+ offset 1) 255)
+                  (u8vector-set! pixels (+ offset 2) 255)
+                  (u8vector-set! pixels (+ offset 3) gray))
+                (x-loop (+ column 1))))
+            (y-loop (+ row 1))))
+        (let ((spec (list char x y width height left top advance)))
+          (set! x (+ x width))
+          (set! next-y (max next-y (+ y height)))
+          spec))
+      ;; Render individual glyph bitmaps and compose them into larger
+      ;; images to be used as textures.
+      (let* ((specs
+              (char-set-fold
+               (lambda (char prev)
+                 (load-char face char '(render))
+                 (let ((left (glyph-bitmap-left glyph))
+                       (top (glyph-bitmap-top glyph)))
+                   (match (glyph-metrics glyph)
+                     ((bearing-x bearing-y advance)
+                      (match (glyph-bitmap glyph)
+                        ((width height pitch glyph-pixels)
+                         (cons (if glyph-pixels
+                                   (add-pixels char width height
+                                               pitch left top
+                                               advance
+                                               glyph-pixels)
+                                   (list char #f #f width height left top advance))
+                               prev)))))))
+               '()
+               char-set))
+             ;; TODO: Use multiple textures if needed.
+             (texture (make-texture pixels texture-size texture-size)))
+        ;; Process kernings.
+        (char-set-for-each
+         (lambda (left)
+           (let ((left-index (get-char-index face left)))
+             (char-set-for-each
+              (lambda (right)
+                (let* ((k (get-kerning face
+                                       left-index
+                                       (get-char-index face right)))
+                       (kx (s64vector-ref k 0))
+                       (ky (s64vector-ref k 1))
+                       (t (hash-ref kernings left)))
+                  (unless (and (zero? kx) (zero? ky))
+                    (let ((kv (vec2 (/ kx 64.0) (/ ky 64.0))))
+                      (if t
+                          (hash-set! t right kv)
+                          (let ((t (make-hash-table)))
+                            (hash-set! t right kv)
+                            (hash-set! kernings left t)))))))
+              char-set)))
+         char-set)
+        ;; Build chars.
+        (for-each (match-lambda
+                    ((char x y width height left top advance)
+                     (hash-set! chars char
+                                (make-font-char char
+                                                (and x y
+                                                     (make-texture-region texture
+                                                                          (make-rect x y width height)))
+                                                (vec2 left (- top height))
+                                                (vec2 width height)
+                                                (vec2 advance 0.0)))))
+                  specs)
+        (hashq-set! batches texture (make-sprite-batch texture))))
+    (let ((style (face-style-name face)))
+      (match (size-metrics (face-size face))
+        ((_ _ _ _ _ _ height _)
+         (make-font (face-family-name face)
+                    (and (string-match ".*[B,b]old.*" style) #t)
+                    (and (string-match ".*[I,i]talic.*" style) #t)
+                    (/ height 64.0)
+                    chars
+                    kernings
+                    batches))))))
+
 (define* (load-tile-font file tile-width tile-height characters #:key
                          (face "untitled") (margin 0) (spacing 0))
   "Load the font named FACE from FILE, a bitmap image containing the
@@ -122,7 +238,7 @@ image may have MARGIN pixels of empty space around its border."
     (hashq-set! batches texture (make-sprite-batch texture))
     (make-font face #f #f tile-height chars kernings batches)))
 
-(define (load-font file)
+(define (load-bitmap-font file)
   "Load the AngelCode formatted bitmap font within FILE.  The file
 extension must be either .xml or .fnt."
   (cond
@@ -320,25 +436,33 @@ extension must be either .xml or .fnt."
         (rect (make-rect 0.0 0.0 0.0 0.0)))
     (lambda* (font text matrix #:key (blend-mode 'alpha)
                    (start 0) (end (string-length text)))
-      (let ((batches (font-sprite-batches font)))
-        ;; TODO: Respect kerning.
-        (define (render-char c)
+      (let ((batches (font-sprite-batches font))
+            (kernings (font-kernings font)))
+        (define (kerning char prev)
+          (let ((t (hash-ref kernings prev)))
+            (and t (hash-ref t char))))
+        (define (render-char c prev)
           (if (eqv? c #\newline)
               (begin
                 (set-vec2-x! cursor 0.0)
                 (set-vec2-y! cursor (- (vec2-y cursor) (font-line-height font))))
               ;; TODO: What if "?" isn't in the font?
               (let* ((char (or (font-ref font c) (font-ref font #\?)))
+                     (k (kerning c prev))
                      (texture (font-char-texture-region char))
-                     (batch (hashq-ref batches (texture-parent texture)))
+                     (batch (and texture (hashq-ref batches (texture-parent texture))))
                      (dimensions (font-char-dimensions char))
                      (offset (font-char-offset char)))
-                (set-rect-x! rect (+ (vec2-x cursor) (vec2-x offset)))
-                (set-rect-y! rect (+ (vec2-y cursor) (vec2-y offset)))
-                (set-rect-width! rect (vec2-x dimensions))
-                (set-rect-height! rect (vec2-y dimensions))
-                (sprite-batch-add* batch rect matrix
-                                   #:texture-region texture)
+                ;; Apply kerning, if present.
+                (when k
+                  (set-vec2-x! cursor (+ (vec2-x cursor) (vec2-x k))))
+                (when texture
+                  (set-rect-x! rect (+ (vec2-x cursor) (vec2-x offset)))
+                  (set-rect-y! rect (+ (vec2-y cursor) (vec2-y offset)))
+                  (set-rect-width! rect (vec2-x dimensions))
+                  (set-rect-height! rect (vec2-y dimensions))
+                  (sprite-batch-add* batch rect matrix
+                                     #:texture-region texture))
                 ;; Move forward to where the next character needs to be drawn.
                 (set-vec2-x! cursor
                              (+ (vec2-x cursor)
@@ -348,7 +472,12 @@ extension must be either .xml or .fnt."
         (hash-for-each (lambda (texture batch)
                          (sprite-batch-clear! batch))
                        batches)
-        (string-for-each render-char text start end)
+        (let loop ((i start)
+                   (prev #f))
+          (when (< i end)
+            (let ((char (string-ref text i)))
+              (render-char char prev)
+              (loop (+ i 1) char))))
         (hash-for-each (lambda (texture batch)
                          (draw-sprite-batch batch #:blend-mode blend-mode))
                        batches)))))
@@ -357,7 +486,7 @@ extension must be either .xml or .fnt."
 (define %null-vec2 (vec2 0.0 0.0))
 
 (define default-font
-  (let ((font (delay (load-font (scope-datadir "fonts/good-neighbors.fnt")))))
+  (let ((font (delay (load-bitmap-font (scope-datadir "fonts/good-neighbors.fnt")))))
     (lambda ()
       (force font))))
 
diff --git a/configure.ac b/configure.ac
index 1e7da13..52146b9 100644
--- a/configure.ac
+++ b/configure.ac
@@ -53,4 +53,14 @@ AS_IF([test "MPG123_LIBDIR" = "x"], [
 ])
 AC_SUBST([MPG123_LIBDIR])
 
+PKG_CHECK_MODULES([freetype], [freetype2])
+PKG_CHECK_VAR([FREETYPE_LIBDIR], [freetype2], [libdir])
+AC_MSG_CHECKING([freetype library path])
+AS_IF([test "FREETYPE_LIBDIR" = "x"], [
+  AC_MSG_FAILURE([Unable to identify freetype lib path.])
+], [
+  AC_MSG_RESULT([$FREETYPE_LIBDIR])
+])
+AC_SUBST([FREETYPE_LIBDIR])
+
 AC_OUTPUT
diff --git a/doc/api.texi b/doc/api.texi
index 446460e..84bcaed 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -2274,16 +2274,25 @@ Printing text to the screen is quite easy:
 (draw-text "Hello, world" (vec2 100.0 100.0))
 @end example
 
-Chickadee loads and renders bitmap fonts in the
-@url{http://www.angelcode.com/products/bmfont/doc/file_format.html,
-Angel Code format}.  A default font named ``Good Neighbors'' is
-built-in to Chickadee and is used for all text rendering operations
-where a font is not specified, as is the case in the above example.
+Chickadee supports OpenType/TrueType fonts (via the FreeType library),
+bitmap fonts in Angel Code bmfont format, and simple sprite sheet
+bitmap fonts.  A default font named Inconsolata is used for all text
+rendering operations where a font is not specified, as is the case in
+the above example.
 
 The following procedures can be found in the @code{(chickadee render
 font)} module:
 
-@deffn {Procedure} load-font file
+@deffn {Procedure} load-font file-name point-size [#:char-set]
+Load the scalable (OpenType, TrueType, etc.) font in the file
+@var{file-name} and display it at the given @var{point-size}.  By
+default, all the characters in the ASCII character set are loaded.
+This can be changed by passing a different character set
+(@pxref{Character Sets,,, guile, GNU Guile Reference Manual}) using
+the @var{char-set} keyword argument.
+@end deffn
+
+@deffn {Procedure} load-bitmap-font file
 Load the Angel Code font (in either XML or FNT format) in @var{file}
 and return a new font object.
 @end deffn
diff --git a/examples/text.scm b/examples/text.scm
index 4758782..df0a2ed 100644
--- a/examples/text.scm
+++ b/examples/text.scm
@@ -3,6 +3,7 @@
              (chickadee render font))
 
 (define (draw alpha)
-  (draw-text "Hello, world!" #v(260.0 240.0)))
+  (draw-text "The quick brown fox jumps over the lazy dog.\nFive hexing wizard bots jump quickly."
+             #v(140.0 240.0)))
 
 (run-game #:draw draw)
diff --git a/guix.scm b/guix.scm
index 91ea9fb..4861da1 100644
--- a/guix.scm
+++ b/guix.scm
@@ -37,7 +37,7 @@
 (use-modules (ice-9 match)
              (srfi srfi-1)
              (guix packages)
-             (guix licenses)
+             ((guix licenses) #:prefix license:)
              (guix download)
              (guix git-download)
              (guix build-system gnu)
@@ -45,6 +45,7 @@
              (gnu packages)
              (gnu packages audio)
              (gnu packages autotools)
+             (gnu packages fontutils)
              (gnu packages pkg-config)
              (gnu packages texinfo)
              (gnu packages guile)
@@ -90,18 +91,18 @@
                (invoke "autoreconf" "-vfi")))))))))
 
 (define guile-sdl2
-  (let ((commit "dae8466030776f9e3afa851122705baaf09071a9"))
+  (let ((commit "1054cbd906ced5cb38476b00700aa8c279f6e1c8"))
     (package
       (name "guile-sdl2")
       (version (string-append "0.5.0-1." (string-take commit 7)))
       (source (origin
                 (method git-fetch)
                 (uri (git-reference
-                      (url "git://dthompson.us/guile-sdl2.git")
+                      (url "https://git.dthompson.us/guile-sdl2.git")
                       (commit commit)))
                 (sha256
                  (base32
-                  "12rrqdbscrsqpvwwakpv8k88cg53kj9q97diqmfic4hyz5skrgr3"))))
+                  "17cccc2648lhyxq62b1zpzbvmfdqpyn4hnbj2962hbj1mxdms1y8"))))
       (build-system gnu-build-system)
       (arguments
        '(#:make-flags '("GUILE_AUTO_COMPILE=0")
@@ -123,7 +124,7 @@
       (description "Guile-sdl2 provides pure Guile Scheme bindings to the
 SDL2 C shared library via the foreign function interface.")
       (home-page "https://git.dthompson.us/guile-sdl2.git")
-      (license lgpl3+))))
+      (license license:lgpl3+))))
 
 (package
   (name "chickadee")
@@ -136,7 +137,8 @@ SDL2 C shared library via the foreign function interface.")
      ("pkg-config" ,pkg-config)
      ("texinfo" ,texinfo)))
   (inputs
-   `(("guile" ,target-guile)
+   `(("freetype" ,freetype)
+     ("guile" ,target-guile)
      ("libvorbis" ,libvorbis)
      ("mpg123" ,mpg123)
      ("openal" ,openal)))
@@ -148,4 +150,4 @@ SDL2 C shared library via the foreign function interface.")
 Scheme.  It contains all of the basic components needed to develop
 2D/3D video games.")
   (home-page "https://dthompson.us/projects/chickadee.html")
-  (license gpl3+))
+  (license license:gpl3+))