doc: scripting: Replace references to "wait" with "sleep".
[chickadee.git] / chickadee / render / font.scm
CommitLineData
233d13ca
DT
1;;; Chickadee Game Toolkit
2;;; Copyright © 2017 David Thompson <davet@gnu.org>
3;;;
4;;; Chickadee is free software: you can redistribute it and/or modify
5;;; it under the terms of the GNU General Public License as published
6;;; by the Free Software Foundation, either version 3 of the License,
7;;; or (at your option) any later version.
8;;;
9;;; Chickadee is distributed in the hope that it will be useful, but
10;;; WITHOUT ANY WARRANTY; without even the implied warranty of
11;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU
12;;; General Public License for more details.
13;;;
14;;; You should have received a copy of the GNU General Public License
15;;; along with this program. If not, see
16;;; <http://www.gnu.org/licenses/>.
17
18;;; Commentary:
19;;
20;; Bitmap font rendering.
21;;
22;;; Code:
23
24(define-module (chickadee render font)
25 #:use-module (ice-9 format)
26 #:use-module (srfi srfi-9)
27 #:use-module (srfi srfi-9 gnu)
28 #:use-module (srfi srfi-11)
29 #:use-module (sxml xpath)
30 #:use-module (sxml simple)
31 #:use-module (chickadee math matrix)
32 #:use-module (chickadee math rect)
33 #:use-module (chickadee math vector)
34 #:use-module (chickadee render)
35 #:use-module (chickadee render shader)
36 #:use-module (chickadee render sprite)
37 #:use-module (chickadee render texture)
38 #:export (load-font
39 font?
40 font-face
41 font-line-height
42 font-bold?
43 font-italic?
44 draw-text))
45
46(define-record-type <font-char>
47 (make-font-char id texture region offset dimensions advance)
48 font-char?
49 (id font-char-id)
50 (texture font-char-texture)
51 (region font-char-region)
52 (offset font-char-offset)
53 (dimensions font-char-dimensions)
54 (advance font-char-advance))
55
56(define-record-type <font>
57 (make-font face bold? italic? line-height chars kerning)
58 font?
59 (face font-face)
60 (bold? font-bold?)
61 (italic? font-italic?)
62 (line-height font-line-height)
63 (chars font-chars)
64 (kerning font-kerning))
65
66(define (display-font font port)
67 (format port "#<font face: ~a line-height: ~d bold?: ~a italic?: ~a>"
68 (font-face font)
69 (font-line-height font)
70 (font-bold? font)
71 (font-italic? font)))
72
73(set-record-type-printer! <font> display-font)
74
75(define (load-font file)
76 "Load the Angel Code XML formatted font within FILE."
77 (define directory (dirname file))
78 (define* (attr tree name #:optional (parse identity))
79 (let ((result ((sxpath `(@ ,name *text*)) tree)))
80 (if (null? result)
81 #f
82 (parse (car result)))))
83 (define (parse-pages nodes)
84 (let ((table (make-hash-table)))
85 (for-each (lambda (node)
86 (let* ((id (attr node 'id string->number))
87 (file (attr node 'file))
88 (texture (load-image
89 (string-append directory "/" file))))
90 (hash-set! table id texture)))
91 nodes)
92 table))
93 (define (string->character s)
94 (integer->char (string->number s)))
95 (define (parse-chars nodes pages image-width image-height line-height)
96 (define (x->s x)
97 (exact->inexact (/ x image-width)))
98 (define (y->t y)
99 (exact->inexact (/ y image-height)))
100 (let ((table (make-hash-table)))
101 (for-each (lambda (node)
102 (let* ((id (attr node 'id string->character))
103 (width (attr node 'width string->number))
104 (height (attr node 'height string->number))
105 (x (attr node 'x string->number))
106 ;; Invert the y axis. Our origin is the
107 ;; bottom-left corner, not top-left.
108 (y (- image-height height
109 (attr node 'y string->number)))
110 (x-offset (attr node 'xoffset string->number))
111 (y-offset (- line-height height
112 (attr node 'yoffset string->number)))
113 (x-advance (attr node 'xadvance string->number))
114 (page (or (attr node 'page string->number) 0))
115 (region (make-rect (x->s x)
116 (y->t y)
117 (x->s width)
118 (y->t height)))
119 (char (make-font-char id
120 (hash-ref pages page)
121 region
122 (vec2 x-offset y-offset)
123 (vec2 width height)
124 (vec2 x-advance 0.0))))
125 (hash-set! table id char)))
126 nodes)
127 table))
128 (define (parse-kernings nodes)
129 (let ((table (make-hash-table)))
130 (for-each (lambda (node)
131 (let* ((first (attr node 'first string->character))
132 (second (attr node 'second string->character))
133 (x-offset (attr node 'amount string->number))
134 (inner-table (hash-ref table first)))
135 (if inner-table
136 (hash-set! inner-table second (vec2 x-offset 0.0))
137 (let ((inner-table (make-hash-table)))
138 (hash-set! inner-table second (vec2 x-offset 0.0))
139 (hash-set! table first inner-table)))))
140 nodes)
141 table))
142 (let* ((tree (call-with-input-file file xml->sxml))
143 (info ((sxpath '(font info)) tree))
144 (common ((sxpath '(font common)) tree))
145 (face (attr info 'face))
146 (bold? (attr info 'bold (const #t)))
147 (italic? (attr info 'italic (const #t)))
148 (line-height (attr common 'lineHeight string->number))
149 (image-width (attr common 'scaleW string->number))
150 (image-height (attr common 'scaleH string->number))
151 (pages (parse-pages ((sxpath '(font pages page)) tree)))
152 (chars (parse-chars ((sxpath '(font chars char)) tree)
153 pages
154 image-width
155 image-height
156 line-height))
157 (kernings (parse-kernings ((sxpath '(font kernings kerning)) tree))))
158 (make-font face bold? italic? line-height chars kernings)))
159
160(define (font-ref font char)
161 (hashv-ref (font-chars font) char))
162
163(define draw-text
164 (let ((p (vec2 0.0 0.0))
165 (rect (make-rect 0.0 0.0 0.0 0.0)))
166 (lambda* (font text position #:key scale rotation (blend-mode 'alpha))
167 "Draw the string TEXT with the first character starting at
168POSITION using FONT."
169 ;; TODO: Respect kerning.
170 (define (render-char c)
171 (let* ((char (font-ref font c))
172 (dimensions (font-char-dimensions char))
173 (offset (font-char-offset char)))
174 (set-rect-x! rect (+ (vec2-x p) (vec2-x offset)))
175 (set-rect-y! rect (+ (vec2-y p) (vec2-y offset)))
176 (set-rect-width! rect (vec2-x dimensions))
177 (set-rect-height! rect (vec2-y dimensions))
178 (draw-sprite (font-char-texture char)
179 rect
2950dfa6 180 #:texcoords (font-char-region char)
233d13ca
DT
181 #:scale scale
182 #:rotation rotation
183 #:blend-mode blend-mode)
184 ;; Move forward to where the next character needs to be drawn.
185 (set-vec2-x! p
186 (+ (vec2-x p)
187 (vec2-x
188 (font-char-advance char))))))
189 (vec2-copy! position p) ; initialize position
190 (with-batched-sprites
191 (string-for-each render-char text)))))