summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--Makefile.am1
-rw-r--r--chickadee/config.scm.in2
-rw-r--r--chickadee/freetype.scm356
-rw-r--r--chickadee/render/font.scm165
-rw-r--r--configure.ac10
-rw-r--r--doc/api.texi21
-rw-r--r--examples/text.scm3
-rw-r--r--guix.scm16
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+))