render: font: Simplify implementation with texture regions.
[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>
45c5d680 47 (make-font-char id texture-region offset dimensions advance)
233d13ca
DT
48 font-char?
49 (id font-char-id)
45c5d680 50 (texture-region font-char-texture-region)
233d13ca
DT
51 (offset font-char-offset)
52 (dimensions font-char-dimensions)
53 (advance font-char-advance))
54
55(define-record-type <font>
56 (make-font face bold? italic? line-height chars kerning)
57 font?
58 (face font-face)
59 (bold? font-bold?)
60 (italic? font-italic?)
61 (line-height font-line-height)
62 (chars font-chars)
63 (kerning font-kerning))
64
65(define (display-font font port)
66 (format port "#<font face: ~a line-height: ~d bold?: ~a italic?: ~a>"
67 (font-face font)
68 (font-line-height font)
69 (font-bold? font)
70 (font-italic? font)))
71
72(set-record-type-printer! <font> display-font)
73
74(define (load-font file)
75 "Load the Angel Code XML formatted font within FILE."
76 (define directory (dirname file))
77 (define* (attr tree name #:optional (parse identity))
78 (let ((result ((sxpath `(@ ,name *text*)) tree)))
79 (if (null? result)
80 #f
81 (parse (car result)))))
82 (define (parse-pages nodes)
83 (let ((table (make-hash-table)))
84 (for-each (lambda (node)
85 (let* ((id (attr node 'id string->number))
86 (file (attr node 'file))
87 (texture (load-image
88 (string-append directory "/" file))))
89 (hash-set! table id texture)))
90 nodes)
91 table))
92 (define (string->character s)
93 (integer->char (string->number s)))
94 (define (parse-chars nodes pages image-width image-height line-height)
95 (define (x->s x)
96 (exact->inexact (/ x image-width)))
97 (define (y->t y)
98 (exact->inexact (/ y image-height)))
99 (let ((table (make-hash-table)))
100 (for-each (lambda (node)
101 (let* ((id (attr node 'id string->character))
102 (width (attr node 'width string->number))
103 (height (attr node 'height string->number))
104 (x (attr node 'x string->number))
105 ;; Invert the y axis. Our origin is the
106 ;; bottom-left corner, not top-left.
107 (y (- image-height height
108 (attr node 'y string->number)))
109 (x-offset (attr node 'xoffset string->number))
110 (y-offset (- line-height height
111 (attr node 'yoffset string->number)))
112 (x-advance (attr node 'xadvance string->number))
113 (page (or (attr node 'page string->number) 0))
45c5d680
DT
114 (region (make-texture-region (hash-ref pages page)
115 x y width height))
233d13ca 116 (char (make-font-char id
233d13ca
DT
117 region
118 (vec2 x-offset y-offset)
119 (vec2 width height)
120 (vec2 x-advance 0.0))))
121 (hash-set! table id char)))
122 nodes)
123 table))
124 (define (parse-kernings nodes)
125 (let ((table (make-hash-table)))
126 (for-each (lambda (node)
127 (let* ((first (attr node 'first string->character))
128 (second (attr node 'second string->character))
129 (x-offset (attr node 'amount string->number))
130 (inner-table (hash-ref table first)))
131 (if inner-table
132 (hash-set! inner-table second (vec2 x-offset 0.0))
133 (let ((inner-table (make-hash-table)))
134 (hash-set! inner-table second (vec2 x-offset 0.0))
135 (hash-set! table first inner-table)))))
136 nodes)
137 table))
138 (let* ((tree (call-with-input-file file xml->sxml))
139 (info ((sxpath '(font info)) tree))
140 (common ((sxpath '(font common)) tree))
141 (face (attr info 'face))
142 (bold? (attr info 'bold (const #t)))
143 (italic? (attr info 'italic (const #t)))
144 (line-height (attr common 'lineHeight string->number))
145 (image-width (attr common 'scaleW string->number))
146 (image-height (attr common 'scaleH string->number))
147 (pages (parse-pages ((sxpath '(font pages page)) tree)))
148 (chars (parse-chars ((sxpath '(font chars char)) tree)
149 pages
150 image-width
151 image-height
152 line-height))
153 (kernings (parse-kernings ((sxpath '(font kernings kerning)) tree))))
154 (make-font face bold? italic? line-height chars kernings)))
155
156(define (font-ref font char)
157 (hashv-ref (font-chars font) char))
158
159(define draw-text
45c5d680
DT
160 (let ((cursor (vec2 0.0 0.0))
161 (char-pos (vec2 0.0 0.0)))
233d13ca
DT
162 (lambda* (font text position #:key scale rotation (blend-mode 'alpha))
163 "Draw the string TEXT with the first character starting at
164POSITION using FONT."
165 ;; TODO: Respect kerning.
166 (define (render-char c)
167 (let* ((char (font-ref font c))
168 (dimensions (font-char-dimensions char))
169 (offset (font-char-offset char)))
45c5d680
DT
170 (set-vec2-x! char-pos (+ (vec2-x cursor) (vec2-x offset)))
171 (set-vec2-y! char-pos (+ (vec2-y cursor) (vec2-y offset)))
172 (draw-sprite (font-char-texture-region char)
173 char-pos
233d13ca
DT
174 #:scale scale
175 #:rotation rotation
176 #:blend-mode blend-mode)
177 ;; Move forward to where the next character needs to be drawn.
45c5d680
DT
178 (set-vec2-x! cursor
179 (+ (vec2-x cursor)
233d13ca
DT
180 (vec2-x
181 (font-char-advance char))))))
45c5d680 182 (vec2-copy! position cursor) ; initialize position
233d13ca
DT
183 (with-batched-sprites
184 (string-for-each render-char text)))))