diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | chickadee/config.scm.in | 2 | ||||
| -rw-r--r-- | chickadee/freetype.scm | 356 | ||||
| -rw-r--r-- | chickadee/render/font.scm | 165 | ||||
| -rw-r--r-- | configure.ac | 10 | ||||
| -rw-r--r-- | doc/api.texi | 21 | ||||
| -rw-r--r-- | examples/text.scm | 3 | ||||
| -rw-r--r-- | guix.scm | 16 |
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) @@ -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+)) |