path: root/chickadee/graphics/text.scm

;;; Chickadee Game Toolkit
;;; Copyright © 2017, 2020, 2021, 2022 David Thompson <dthompson2@worcester.edu>
;;;
;;; Licensed under the Apache License, Version 2.0 (the "License");
;;; you may not use this file except in compliance with the License.
;;; You may obtain a copy of the License at
;;;
;;;    http://www.apache.org/licenses/LICENSE-2.0
;;;
;;; Unless required by applicable law or agreed to in writing, software
;;; distributed under the License is distributed on an "AS IS" BASIS,
;;; WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied.
;;; See the License for the specific language governing permissions and
;;; limitations under the License.

;;; Commentary:
;;
;; Bitmap font rendering.
;;
;;; Code:

(define-module (chickadee graphics text)
  #: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 data array-list)
  #:use-module (chickadee freetype)
  #:use-module (chickadee graphics)
  #:use-module (chickadee graphics color)
  #:use-module (chickadee graphics pipeline)
  #:use-module (chickadee graphics pixbuf)
  #:use-module (chickadee graphics shader)
  #:use-module (chickadee graphics sprite)
  #:use-module (chickadee graphics texture)
  #:use-module (chickadee math)
  #:use-module (chickadee math matrix)
  #:use-module (chickadee math rect)
  #:use-module (chickadee math vector)
  #:use-module (chickadee utils)
  #:use-module (rnrs bytevectors)
  #:export (load-tile-font
            load-bitmap-font
            load-font
            font?
            font-face
            font-ascent
            font-descent
            font-glyph
            font-glyph*
            font-line-height
            font-line-width
            font-bold?
            font-italic?
            default-font

            glyph?
            glyph-id
            glyph-sprite
            glyph-offset
            glyph-dimensions
            glyph-advance

            make-compositor
            compositor?
            compositor-cursor
            compositor-reset!
            typeset-lrtb

            make-page
            page?
            page-bounding-box
            page-reset!
            page-write!
            draw-page
            draw-text*
            draw-text))


;;;
;;; Fonts
;;;

(define-record-type <glyph>
  (make-glyph id sprite offset dimensions advance)
  glyph?
  (id glyph-id)
  (sprite glyph-sprite)
  (offset glyph-offset)
  (dimensions glyph-dimensions)
  (advance glyph-advance))

(define-record-type <font>
  (make-font face bold? italic? ascent descent line-height glyphs kernings)
  font?
  (face font-face)
  (bold? font-bold?)
  (italic? font-italic?)
  (ascent font-ascent)
  (descent font-descent)
  (line-height font-line-height)
  (glyphs font-glyphs)
  (kernings font-kernings))

(define (display-font font port)
  (format port "#<font face: ~a line-height: ~d bold?: ~a italic?: ~a>"
          (font-face font)
          (font-line-height font)
          (font-bold? font)
          (font-italic? font)))

(set-record-type-printer! <font> display-font)

(define (font-line-width font text)
  "Return the width of TEXT when rendered with FONT."
  (let loop ((width 0.0)
             (i 0))
    (if (< i (string-length text))
        (let ((char (font-glyph* font (string-ref text i))))
          (loop (+ width (vec2-x (glyph-advance char)))
                (+ i 1)))
        width)))

(define (font-kerning font a b)
  (let ((t (hashv-ref (font-kernings font) b)))
    (and t (hashv-ref t a))))

(define freetype-handle
  (delay (init-freetype)))

(define* (load-font file-name point-size #:key (char-set char-set:ascii) (smooth? #t))
  "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.
If SMOOTH? is #t (the default), text rendered with this font will have
a smoother appearance when text is rotated or scaled, otherwise
non-smooth scaling will be 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))
        (texture-size (min (gpu-limits-max-texture-dimension-2d
                            (gpu-limits (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))
        (for-range ((column width)
                    (row height))
          (let ((gray (u8vector-ref glyph-pixels
                                    (+ (* row pitch) column)))
                (offset (+ (* (- height (+ y row) 1) 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)))
        (let ((spec (list char x y width height left top advance)))
          ;; 1 pixel of padding to avoid artifacts when texture is
          ;; scaled up.
          (set! x (+ x width 1))
          (set! next-y (max next-y (+ y height 1)))
          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))
             (texture-filter (if smooth? 'linear 'nearest))
             ;; TODO: Use multiple textures if needed.
             (texture (pixbuf->texture
                       (bytevector->pixbuf pixels texture-size texture-size)))
             (texture-view (texture-view texture)))
        ;; 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 (hashv-ref kernings left)))
                  (unless (and (zero? kx) (zero? ky))
                    (let ((kv (vec2 (/ kx 64.0) (/ ky 64.0))))
                      (if t
                          (hashv-set! t right kv)
                          (let ((t (make-hash-table)))
                            (hashv-set! t right kv)
                            (hashv-set! kernings left t)))))))
              char-set)))
         char-set)
        ;; Build chars.
        (for-each (match-lambda
                    ((char x y width height left top advance)
                     (let* ((rect (and x y (make-rect x y width height)))
                            (sprite (and rect (make-sprite texture-view rect))))
                       (hashv-set! chars char
                                   (make-glyph char sprite
                                               (vec2 left (- top height))
                                               (vec2 width height)
                                               (vec2 advance 0.0))))))
                  specs)))
    (let ((style (face-style-name face)))
      (match (size-metrics (face-size face))
        ((_ _ _ _ ascent descent height _)
         (make-font (face-family-name face)
                    (and (string-match ".*[B,b]old.*" style) #t)
                    (and (string-match ".*[I,i]talic.*" style) #t)
                    (/ ascent 64.0)
                    (/ descent 64.0)
                    (/ height 64.0)
                    chars
                    kernings))))))

(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
characters in the string CHARACTERS that are TILE-WIDTH by TILE-HEIGHT
pixels in size.  The characters in the image *must* appear in the
order that they are specified in the character set or text will not
render properly.  Optionally, each tile may have SPACING pixels of
horizontal and vertical space between surrounding tiles and the entire
image may have MARGIN pixels of empty space around its border."
  (let* ((texture (texture-view (load-image file)))
         (sheet (tileset texture tile-width tile-height
                         #:margin margin
                         #:spacing spacing))
         (chars
          (let ((table (make-hash-table)))
            (string-for-each-index
             (lambda (i)
               (hashv-set! table (string-ref characters i)
                           (make-glyph (string-ref characters i)
                                       (sprite-sheet-ref sheet i)
                                       (vec2 0.0 0.0)
                                       (vec2 tile-width tile-height)
                                       (vec2 tile-width 0.0))))
             characters)
            table))
         ;; These fonts are by definition monospace fonts, so no
         ;; kerning.
         (kernings (make-hash-table)))
    (make-font face #f #f (exact->inexact tile-height) 0.0
               (exact->inexact tile-height) chars kernings)))

(define (load-bitmap-font file)
  "Load the AngelCode formatted bitmap font within FILE.  The file
extension must be either .xml or .fnt."
  (cond
   ((string-suffix? ".xml" file)
    (parse-bmfont-sxml file (call-with-input-file file xml->sxml)))
   ((string-suffix? ".fnt" file)
    (parse-bmfont-sxml file (parse-fnt file)))
   (else
    (error "unknown bmfont file type: " file))))

(define (parse-fnt file)
  (define (newline? char)
    (eqv? char #\newline))
  (define (whitespace? char)
    (and (not (newline? char))
         (char-set-contains? char-set:whitespace char)))
  (define (letter? char)
    (char-set-contains? char-set:letter char))
  (define (consume-whitespace port)
    (match (peek-char port)
      ((? eof-object?) *unspecified*)
      ((? whitespace?)
       (read-char port)
       (consume-whitespace port))
      (_ *unspecified*)))
  (define (read-tag port)
    (list->symbol
     (let loop ()
       (match (peek-char port)
         ((? letter? char)
          (read-char port)
          (cons char (loop)))
         ((? whitespace? char)
          '())))))
  (define (read-key port)
    (list->symbol
     (let loop ()
       (match (read-char port)
         (#\= '())
         ((? letter? char)
          (cons char (loop)))))))
  (define (read-quoted-string port)
    (match (read-char port)
      (#\" #t))
    (list->string
     (let loop ()
       (match (read-char port)
         (#\"
          (if (or (whitespace? (peek-char port))
                  (newline? (peek-char port)))
              '()
              (cons #\" (loop))))
         (char (cons char (loop)))))))
  (define (read-unquoted-string port)
    (list->string
     (let loop ()
       (match (peek-char port)
         ((or (? whitespace?)
              (? newline?))
          '())
         (char
          (read-char port)
          (cons char (loop)))))))
  (define (read-value port)
    (match (peek-char port)
      (#\"
       (read-quoted-string port))
      (_ (read-unquoted-string port))))
  (define (read-key/value-pair port)
    (list (read-key port) (read-value port)))
  (define (read-key/value-pairs port)
    (cons '@
     (let loop ()
       (consume-whitespace port)
       (match (peek-char port)
         ((? newline?)
          (read-char port)
          '())
         ((? letter?)
          (cons (read-key/value-pair port)
                (loop)))))))
  (define (read-line port)
    (list (read-tag port) (read-key/value-pairs port)))
  `(*TOP*
    (font
     ,@(call-with-input-file file
         (lambda (port)
           (let loop ((pages '()))
             (match (peek-char port)
               ((? eof-object?)
                `((pages (@ (count ,(number->string (length pages))))
                         ,@pages)))
               ((? newline?)
                (read-char port)
                (loop pages))
               ((? letter?)
                (match (read-line port)
                  ((tag ('@ ('count count)))
                   (cons (cons* tag
                                `(@ (count ,count))
                                (list-tabulate (string->number count)
                                               (lambda (i)
                                                 (read-line port))))
                         (loop pages)))
                  ((and ('page . _) page)
                   (loop (cons page pages)))
                  (exp (cons exp (loop pages))))))))))))

(define (parse-bmfont-sxml file tree)
  (define directory (dirname file))
  (define* (attr tree name #:optional (parse identity))
    (let ((result ((sxpath `(@ ,name *text*)) tree)))
      (if (null? result)
          #f
          (parse (car result)))))
  (define (parse-pages nodes)
    (let ((table (make-hash-table)))
      (for-each (lambda (node)
                  (let* ((id (attr node 'id string->number))
                         (file (attr node 'file))
                         (texture (load-image
                                   (string-append directory "/" file))))
                    (hashv-set! table id texture)))
                nodes)
      table))
  (define (string->character s)
    (integer->char (string->number s)))
  (define (parse-chars nodes pages image-width image-height line-height)
    (define (x->s x)
      (exact->inexact (/ x image-width)))
    (define (y->t y)
      (exact->inexact (/ y image-height)))
    (let ((table (make-hash-table)))
      (for-each (lambda (node)
                  (let* ((id (attr node 'id string->character))
                         (width (attr node 'width string->number))
                         (height (attr node 'height string->number))
                         (x (attr node 'x string->number))
                         ;; Invert the y axis.  Our origin is the
                         ;; bottom-left corner, not top-left.
                         (y (- image-height height
                               (attr node 'y string->number)))
                         (x-offset (attr node 'xoffset string->number))
                         (y-offset (- line-height height
                                      (attr node 'yoffset string->number)))
                         (x-advance (attr node 'xadvance string->number))
                         (page (or (attr node 'page string->number) 0))
                         (sprite (make-sprite (hashv-ref pages page)
                                              (make-rect x y width height)))
                         (char (make-glyph id sprite
                                           (vec2 x-offset y-offset)
                                           (vec2 width height)
                                           (vec2 x-advance 0.0))))
                    (hashv-set! table id char)))
                nodes)
      table))
  (define (parse-kernings nodes)
    (let ((table (make-hash-table)))
      (for-each (lambda (node)
                  (let* ((first (attr node 'first string->character))
                         (second (attr node 'second string->character))
                         (x-offset (attr node 'amount string->number))
                         (inner-table (hashv-ref table first)))
                    (if inner-table
                        (hashv-set! inner-table second (vec2 x-offset 0.0))
                        (let ((inner-table (make-hash-table)))
                          (hashv-set! inner-table second (vec2 x-offset 0.0))
                          (hashv-set! table first inner-table)))))
                nodes)
      table))
  (let* ((info ((sxpath '(font info)) tree))
         (common ((sxpath '(font common)) tree))
         (face (attr info 'face))
         (bold? (attr info 'bold (const #t)))
         (italic? (attr info 'italic (const #t)))
         (line-height (exact->inexact (attr common 'lineHeight string->number)))
         (image-width (attr common 'scaleW string->number))
         (image-height (attr common 'scaleH string->number))
         (pages (parse-pages ((sxpath '(font pages page)) tree)))
         (chars (parse-chars ((sxpath '(font chars char)) tree)
                             pages
                             image-width
                             image-height
                             line-height))
         (kernings (parse-kernings ((sxpath '(font kernings kerning)) tree))))
    (make-font face bold? italic? line-height 0.0 line-height chars kernings)))

(define (font-glyph font char)
  "Return the glyph for CHAR in FONT, or #f if the char is not
represented in FONT."
  (hashv-ref (font-glyphs font) char))

(define (font-glyph* font char)
  "Return the glyph for CHAR in FONT, or a placeholder glyph if the char
is not represented in FONT."
  (or (font-glyph font char) (font-glyph font #\?)))


;;;
;;; Typesetting
;;;

;; Using an old printing press metaphor here.  The compositor was the
;; person who arranged the individual characters for printing.  A
;; composited glyph is a glyph that has been placed in a particular
;; location, assigned a color, and, optionally, given an arbitrary
;; transformation matrix.
(define-record-type <composited-glyph>
  (%make-composited-glyph position)
  composited-glyph?
  (glyph composited-glyph-glyph set-composited-glyph-glyph!)
  (position composited-glyph-position)
  (color composited-glyph-color set-composited-glyph-color!)
  (matrix composited-glyph-matrix set-composited-glyph-matrix!))

;; A compositor manages the state of the typesetting process.  It does
;; not know anything about typesetting techniques, as even something
;; as fundamental as which way the text is read varies greatly.
;; English reads left to right.  Arabic reads right to left.  Japanese
;; can read left to right or top to bottom.  Since layout decisions
;; are so context sensitive, we leave glyph placement up to a user
;; provided compositing procedure.
;;
;; The coordinate space of the compositor is *different* than the
;; coordinate space of OpenGL in that the positive Y axis points
;; *down*, not up.  This just makes more sense for text since we read
;; from the top of a page.  The Y coordinates will be inverted later
;; when assembling the vertex data.
(define-record-type <compositor>
  (%make-compositor cursor free-cglyphs cglyphs size)
  compositor?
  ;; The position where glyphs will be placed.
  (cursor compositor-cursor)
  (free-cglyphs compositor-free-cglyphs)
  (cglyphs compositor-cglyphs)
  ;; Tracking the extremes of the cursor position.  Currently only the
  ;; Y value is tracked, for the purposes of inverting coordinates
  ;; later.
  (size compositor-size))

(define (make-compositor)
  (%make-compositor (vec2 0.0 0.0)
                    (make-array-list)
                    (make-array-list)
                    (vec2 0.0 0.0)))

(define (compositor-free-composited-glyph compositor)
  (let ((free-cglyphs (compositor-free-cglyphs compositor)))
    (if (array-list-empty? free-cglyphs)
        (%make-composited-glyph (vec2 0.0 0.0))
        (array-list-pop! free-cglyphs))))

(define (make-composited-glyph compositor glyph color matrix)
  (let ((cglyph (compositor-free-composited-glyph compositor)))
    (vec2-copy! (compositor-cursor compositor)
                (composited-glyph-position cglyph))
    (set-composited-glyph-glyph! cglyph glyph)
    (set-composited-glyph-color! cglyph color)
    (set-composited-glyph-matrix! cglyph matrix)
    cglyph))

(define* (compositor-put-glyph! compositor glyph color #:optional (matrix #f))
  (let ((size (compositor-size compositor)))
    (array-list-push! (compositor-cglyphs compositor)
                      (make-composited-glyph compositor glyph color matrix))
    (set-vec2-y! size
                 (max (vec2-y size)
                      (vec2-y (compositor-cursor compositor))))))

(define (compositor-reset! compositor)
  (let ((cglyphs (compositor-cglyphs compositor))
        (free-cglyphs (compositor-free-cglyphs compositor)))
    (set-vec2! (compositor-cursor compositor) 0.0 0.0)
    (set-vec2! (compositor-size compositor) 0.0 0.0)
    (while (not (array-list-empty? cglyphs))
      (array-list-push! free-cglyphs (array-list-pop! cglyphs)))))

;; Simple left to right, top to bottom typesetting for a single font
;; and color.
(define* (typeset-lrtb compositor font text color #:key
                       (start 0) (end (string-length text)))
  (let ((cursor (compositor-cursor compositor)))
    (let loop ((i start)
               (prev #f))
      (when (< i end)
        (let ((c (string-ref text i)))
          (case c
            ((#\newline)
             (set-vec2-x! cursor 0.0)
             (set-vec2-y! cursor (+ (vec2-y cursor)
                                    (font-line-height font))))
            (else
             (let* ((glyph (font-glyph* font c))
                    (k (font-kerning font c prev)))
               ;; Adjust cursor with kerning, if present.
               (when k
                 (set-vec2-x! cursor (+ (vec2-x cursor) (vec2-x k))))
               ;; Add glyph.
               (compositor-put-glyph! compositor glyph color)
               ;; Move forward to where the next character needs to be drawn.
               (set-vec2-x! cursor
                            (+ (vec2-x cursor)
                               (vec2-x
                                (glyph-advance glyph)))))))
          (loop (+ i 1) c))))))


;;;
;;; Rendering
;;;

;; A page is the "printed" form of a collection of composited glyphs.
;; It is a collection of sprite batches that are ready to be rendered.
;; By compiling text strings to pages, large amounts of static text
;; containing multiple colors, fonts, and transformations can be
;; cached and rendered cheaply.
(define-record-type <page>
  (%make-page free-batches batches scratch-rect bounding-box)
  page?
  (free-batches page-free-batches)
  (batches page-batches)
  (scratch-rect page-scratch-rect)
  (bounding-box page-bounding-box))

(define (make-page)
  (%make-page (make-array-list)
              (make-hash-table)
              (make-null-rect)
              (make-null-rect)))

(define (page-reset! page)
  (let ((free-batches (page-free-batches page))
        (bb (page-bounding-box page)))
    (hash-for-each (lambda (texture batch)
                     (array-list-push! free-batches batch))
                   (page-batches page))
    (hash-clear! (page-batches page))
    (set-rect-x! bb 0.0)
    (set-rect-y! bb 0.0)
    (set-rect-width! bb 0.0)
    (set-rect-height! bb 0.0)))

(define (page-free-batch page)
  (let ((free-batches (page-free-batches page)))
    (if (array-list-empty? free-batches)
        (make-sprite-batch #f)
        (array-list-pop! free-batches))))

(define (make-page-batch page texture)
  (let ((batch (page-free-batch page)))
    (set-sprite-batch-texture! batch texture)
    batch))

(define (page-batch page texture)
  (let ((batches (page-batches page)))
    (or (hashq-ref batches texture)
        (let ((batch (make-page-batch page texture)))
          (hashq-set! batches texture batch)
          (sprite-batch-clear! batch)
          batch))))

(define %identity-matrix (make-identity-matrix4))
(define (page-write! page compositor)
  (let ((rect (page-scratch-rect page))
        (bb (page-bounding-box page))
        (size (compositor-size compositor)))
    (define (write-glyph i cglyph)
      (let* ((glyph (composited-glyph-glyph cglyph))
             (position (composited-glyph-position cglyph))
             (offset (glyph-offset glyph))
             (dimensions (glyph-dimensions glyph))
             (advance (glyph-advance glyph))
             (sprite (glyph-sprite glyph))
             (x (vec2-x position))
             (y (- (vec2-y size) (vec2-y position)))
             ;; Not all glyphs have a visual representation, such as
             ;; the space character.
             (batch (and sprite
                         (page-batch page (sprite-texture-view sprite)))))
        ;; Setup bounding box.
        (set-rect-x! rect x)
        (set-rect-y! rect y)
        (set-rect-width! rect (vec2-x advance))
        (set-rect-height! rect (vec2-y dimensions))
        (rect-union! bb rect) ; expand bounding box to include this char
        (when batch
          ;; Reuse rect for sprite dimensions.
          (set-rect-x! rect (+ x (vec2-x offset)))
          (set-rect-y! rect (+ y (vec2-y offset)))
          (set-rect-width! rect (vec2-x dimensions))
          (sprite-batch-add* batch rect
                             (or (composited-glyph-matrix cglyph)
                                 %identity-matrix)
                             #:texcoords (sprite-rect-uv sprite)
                             #:tint (composited-glyph-color cglyph)))))
    (array-list-for-each write-glyph (compositor-cglyphs compositor))))

(define* (draw-page page matrix #:key (blend-mode blend:alpha))
  (hash-for-each (lambda (texture batch)
                   (draw-sprite-batch* batch matrix))
                 (page-batches page)))

(define draw-text*
  (let ((compositor (make-compositor))
        (page (make-page)))
    (lambda* (font text matrix #:key (blend-mode blend:alpha)
                   (color white) (start 0) (end (string-length text))
                   (typeset typeset-lrtb))
      (compositor-reset! compositor)
      (page-reset! page)
      (typeset compositor font text color #:start start #:end end)
      (page-write! page compositor)
      (draw-page page matrix #:blend-mode blend-mode))))

(define %default-scale (vec2 1.0 1.0))
(define %null-vec2 (vec2 0.0 0.0))
(define %default-font
  (delay (load-font (scope-datadir "fonts/Inconsolata-Regular.otf") 12)))

(define (default-font)
  (force %default-font))

(define draw-text
  (let ((matrix (make-null-matrix4)))
    (lambda* (text
              position
              #:key
              (font (default-font))
              (color white)
              (origin %null-vec2)
              (rotation 0)
              (scale %default-scale)
              (blend-mode blend:alpha)
              (start 0)
              (end (string-length text))
              (typeset typeset-lrtb))
      "Draw the string TEXT with the first character starting at
POSITION using FONT."
      (matrix4-2d-transform! matrix
                             #:origin origin
                             #:position position
                             #:rotation rotation
                             #:scale scale)
      (draw-text* font text matrix
                  #:blend-mode blend-mode
                  #:color color
                  #:start start
                  #:end end))))