From 5edce04c698cd92149004ead1cad77c481c682e8 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 17 Oct 2022 08:14:18 -0400 Subject: Rename (chickadee graphics font) to (chickadee graphics text). --- Makefile.am | 2 +- chickadee/cli/play.scm | 2 +- chickadee/graphics/font.scm | 715 ------------------------------------------- chickadee/graphics/text.scm | 715 +++++++++++++++++++++++++++++++++++++++++++ examples/9-patch.scm | 2 +- examples/audio.scm | 2 +- examples/game-controller.scm | 2 +- examples/grid.scm | 4 +- examples/model.scm | 2 +- examples/particles.scm | 2 +- examples/path.scm | 2 +- examples/quadtree.scm | 2 +- examples/sprite-batch.scm | 2 +- examples/text.scm | 81 ++++- examples/tile-map.scm | 2 +- 15 files changed, 805 insertions(+), 732 deletions(-) delete mode 100644 chickadee/graphics/font.scm create mode 100644 chickadee/graphics/text.scm diff --git a/Makefile.am b/Makefile.am index 767e76d..04b56a0 100644 --- a/Makefile.am +++ b/Makefile.am @@ -82,7 +82,7 @@ SOURCES = \ chickadee/graphics/framebuffer.scm \ chickadee/graphics/sprite.scm \ chickadee/graphics/9-patch.scm \ - chickadee/graphics/font.scm \ + chickadee/graphics/text.scm \ chickadee/graphics/tile-map.scm \ chickadee/graphics/particles.scm \ chickadee/graphics/skybox.scm \ diff --git a/chickadee/cli/play.scm b/chickadee/cli/play.scm index 31fae99..db2c0d6 100644 --- a/chickadee/cli/play.scm +++ b/chickadee/cli/play.scm @@ -117,7 +117,7 @@ Play the game defined in FILE.~%") (chickadee audio) (chickadee graphics color) (chickadee graphics engine) - (chickadee graphics font) + (chickadee graphics text) (chickadee graphics texture) (chickadee math) (chickadee math matrix) diff --git a/chickadee/graphics/font.scm b/chickadee/graphics/font.scm deleted file mode 100644 index 4e21ba0..0000000 --- a/chickadee/graphics/font.scm +++ /dev/null @@ -1,715 +0,0 @@ -;;; Chickadee Game Toolkit -;;; Copyright © 2017, 2020, 2021, 2022 David Thompson -;;; -;;; 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 -;;; . - -;;; Commentary: -;; -;; Bitmap font rendering. -;; -;;; Code: - -(define-module (chickadee graphics 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 data array-list) - #:use-module (chickadee freetype) - #:use-module (chickadee math) - #:use-module (chickadee math matrix) - #:use-module (chickadee math rect) - #:use-module (chickadee math vector) - #:use-module (chickadee graphics blend) - #:use-module (chickadee graphics color) - #:use-module (chickadee graphics engine) - #:use-module (chickadee graphics shader) - #:use-module (chickadee graphics sprite) - #:use-module (chickadee graphics texture) - #: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-texture-region - 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 - (make-glyph id texture-region offset dimensions advance) - glyph? - (id glyph-id) - (texture-region glyph-texture-region) - (offset glyph-offset) - (dimensions glyph-dimensions) - (advance glyph-advance)) - -(define-record-type - (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 font) - (font-line-height font) - (font-bold? font) - (font-italic? font))) - -(set-record-type-printer! 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)) - "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)) - (texture-size (min (graphics-engine-max-texture-size) 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)) - ;; 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 (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) - (hashv-set! chars char - (make-glyph 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))) - (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 (load-image file)) - (atlas (split-texture 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) - (texture-atlas-ref atlas 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)) - (region (make-texture-region (hashv-ref pages page) - (make-rect x y width height))) - (char (make-glyph id - region - (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 - (%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 - (%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 - (%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 null-texture) - (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)) - (texture (glyph-texture-region glyph)) - ;; Not all glyphs have a visual representation, such as - ;; the space character. - (batch (and texture - (page-batch page (texture-parent texture))))) - (set-rect-x! rect (+ (vec2-x position) (vec2-x offset))) - (set-rect-y! rect (+ (- (vec2-y size) (vec2-y position)) (vec2-y offset))) - (set-rect-width! rect (vec2-x dimensions)) - (set-rect-height! rect (vec2-y dimensions)) - (rect-union! bb rect) ; expand bounding box to include this char - (when batch - (sprite-batch-add* batch rect - (or (composited-glyph-matrix cglyph) - %identity-matrix) - #:texture-region texture - #: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 #:blend-mode blend-mode)) - (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)))) diff --git a/chickadee/graphics/text.scm b/chickadee/graphics/text.scm new file mode 100644 index 0000000..42c6fa5 --- /dev/null +++ b/chickadee/graphics/text.scm @@ -0,0 +1,715 @@ +;;; Chickadee Game Toolkit +;;; Copyright © 2017, 2020, 2021, 2022 David Thompson +;;; +;;; 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 +;;; . + +;;; 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 math) + #:use-module (chickadee math matrix) + #:use-module (chickadee math rect) + #:use-module (chickadee math vector) + #:use-module (chickadee graphics blend) + #:use-module (chickadee graphics color) + #:use-module (chickadee graphics engine) + #:use-module (chickadee graphics shader) + #:use-module (chickadee graphics sprite) + #:use-module (chickadee graphics texture) + #: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-texture-region + 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 + (make-glyph id texture-region offset dimensions advance) + glyph? + (id glyph-id) + (texture-region glyph-texture-region) + (offset glyph-offset) + (dimensions glyph-dimensions) + (advance glyph-advance)) + +(define-record-type + (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 font) + (font-line-height font) + (font-bold? font) + (font-italic? font))) + +(set-record-type-printer! 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)) + "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)) + (texture-size (min (graphics-engine-max-texture-size) 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)) + ;; 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 (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) + (hashv-set! chars char + (make-glyph 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))) + (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 (load-image file)) + (atlas (split-texture 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) + (texture-atlas-ref atlas 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)) + (region (make-texture-region (hashv-ref pages page) + (make-rect x y width height))) + (char (make-glyph id + region + (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 + (%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 + (%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 + (%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 null-texture) + (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)) + (texture (glyph-texture-region glyph)) + ;; Not all glyphs have a visual representation, such as + ;; the space character. + (batch (and texture + (page-batch page (texture-parent texture))))) + (set-rect-x! rect (+ (vec2-x position) (vec2-x offset))) + (set-rect-y! rect (+ (- (vec2-y size) (vec2-y position)) (vec2-y offset))) + (set-rect-width! rect (vec2-x dimensions)) + (set-rect-height! rect (vec2-y dimensions)) + (rect-union! bb rect) ; expand bounding box to include this char + (when batch + (sprite-batch-add* batch rect + (or (composited-glyph-matrix cglyph) + %identity-matrix) + #:texture-region texture + #: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 #:blend-mode blend-mode)) + (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)))) diff --git a/examples/9-patch.scm b/examples/9-patch.scm index feb02b0..debc69d 100644 --- a/examples/9-patch.scm +++ b/examples/9-patch.scm @@ -1,8 +1,8 @@ (use-modules (chickadee) (chickadee math rect) (chickadee math vector) - (chickadee graphics font) (chickadee graphics 9-patch) + (chickadee graphics text) (chickadee graphics texture)) (define image #f) diff --git a/examples/audio.scm b/examples/audio.scm index 4ea697f..72826b9 100644 --- a/examples/audio.scm +++ b/examples/audio.scm @@ -1,7 +1,7 @@ (use-modules (chickadee) (chickadee audio) (chickadee math vector) - (chickadee graphics font) + (chickadee graphics text) (ice-9 match)) (define effect #f) diff --git a/examples/game-controller.scm b/examples/game-controller.scm index f166939..d8a6002 100644 --- a/examples/game-controller.scm +++ b/examples/game-controller.scm @@ -1,8 +1,8 @@ (use-modules (chickadee) (chickadee math vector) (chickadee graphics color) - (chickadee graphics font) (chickadee graphics sprite) + (chickadee graphics text) (chickadee graphics texture) (ice-9 match)) diff --git a/examples/grid.scm b/examples/grid.scm index c83dac7..4a5dbd2 100644 --- a/examples/grid.scm +++ b/examples/grid.scm @@ -3,9 +3,9 @@ (chickadee math vector) (chickadee math rect) (chickadee graphics color) - (chickadee graphics font) (chickadee graphics path) - (chickadee graphics sprite)) + (chickadee graphics sprite) + (chickadee graphics text)) (define grid (make-grid)) (define item-color (make-color 0.7 0.0 0.0 0.7)) diff --git a/examples/model.scm b/examples/model.scm index 26067b6..4fa42c7 100644 --- a/examples/model.scm +++ b/examples/model.scm @@ -4,7 +4,7 @@ (chickadee math vector) (chickadee graphics engine) (chickadee graphics model) - (chickadee graphics font) + (chickadee graphics text) (ice-9 format)) (define projection (perspective-projection (/ pi 3) (/ 4.0 3.0) 0.1 500.0)) diff --git a/examples/particles.scm b/examples/particles.scm index f7d096e..cab390b 100644 --- a/examples/particles.scm +++ b/examples/particles.scm @@ -2,9 +2,9 @@ (chickadee math rect) (chickadee math vector) (chickadee graphics color) - (chickadee graphics font) (chickadee graphics particles) (chickadee graphics sprite) + (chickadee graphics text) (chickadee graphics texture) (chickadee scripting) (ice-9 format)) diff --git a/examples/path.scm b/examples/path.scm index 202a859..44cabdb 100644 --- a/examples/path.scm +++ b/examples/path.scm @@ -1,7 +1,7 @@ (use-modules (chickadee) (chickadee graphics color) - (chickadee graphics font) (chickadee graphics path) + (chickadee graphics text) (chickadee math) (chickadee math vector) (chickadee scripting)) diff --git a/examples/quadtree.scm b/examples/quadtree.scm index 31b8138..d95c00f 100644 --- a/examples/quadtree.scm +++ b/examples/quadtree.scm @@ -5,10 +5,10 @@ (chickadee math rect) (chickadee math vector) (chickadee graphics color) - (chickadee graphics font) (chickadee graphics path) (chickadee graphics sprite) (chickadee graphics texture) + (chickadee graphics text) (chickadee scripting) (ice-9 format) (ice-9 match) diff --git a/examples/sprite-batch.scm b/examples/sprite-batch.scm index b63179f..e62d1e4 100644 --- a/examples/sprite-batch.scm +++ b/examples/sprite-batch.scm @@ -3,8 +3,8 @@ (chickadee math rect) (chickadee math vector) (chickadee graphics color) - (chickadee graphics font) (chickadee graphics sprite) + (chickadee graphics text) (chickadee graphics texture) (chickadee scripting) (ice-9 format) diff --git a/examples/text.scm b/examples/text.scm index 3d2b3b5..d4d6489 100644 --- a/examples/text.scm +++ b/examples/text.scm @@ -1,9 +1,82 @@ (use-modules (chickadee) + (chickadee graphics text) (chickadee math vector) - (chickadee graphics font)) + (chickadee scripting)) + +(define start-time 0.0) +(define avg-frame-time 16.0) +(define stats-text "") +(define stats-position (vec2 4.0 704.0)) +(define position (vec2 140.0 0.0)) +(define text + "This is the \"Are you tired of *this*?\" part of the infomercial. Read the next few paragraphs +and picture me, in black and white, struggling to hold a large stack of boxes, all labeled +\"software.\" I continue struggling to balance the boxes as you read. When you've reached the last +paragraph of the section, I fall over, the boxes land on top of me and all over the floor, I'm +covered in spaghetti, and in an exasperated voice I shout \"There's gotta be a better way!\" + +When setting up a new computer for software development, I want to go from `git clone` to `make` in +as little time as possible (adjust that for your VCS and build system of choice.) In the old days, +this meant manually installing the dependencies through the distro package manager. If things are +organized, the project README will have a list of what is needed and it's not so bad. If things are +less organized, it's a cycle of installing packages and running `./configure` or whatever until it +succeeds. Hopefully none of the dependencies are too new to be found in the distro. And when +working on multiple projects, hopefully there's no conflicts between the dependencies required for +each of them, because your development environment is the entire system and there's no way to +isolate different projects from each other. + +Of course, different programming languages provide their own sets of tools for managing multiple +projects. Python has virtualenv, Ruby has rvm and bundler, Node has nvm and npm, etc. But their +domain is restricted to only the dependencies for that language and their runtimes. A system +package manager is needed to bootstrap their use. + +Nowadays it's \"just use Docker.\" Docker's take is that all this package management stuff is just +too complicated. Instead, just create a disk image per project that encapsulates this hodgepodge of +package managers and bespoke, artisinal, small-batch builds that gets run in isolation via Linux +namespace magic. It works, of course, but I think Dockerfiles are clunky and the rather extreme +level of isolation is usually unnecessary and makes things overly complicated for projects that need +to interact with, say, the windowing system of the host computer. A lot of people are happy with +Docker, though. Maybe you are, too. That's fine! + +What I really want to say is \"Computer, provision a development environment containing Guile 3, +SDL2, make, and texinfo!\" and have Majel Barrett-Roddenberry tell me that all of those things have +been made available to me on my host system. No container, no virtual machine. It shouldn't matter +if I have Guile 2 installed system-wide, Guile 3 should still be what's used in the context of the +project. This is how Guix works and it's very good and cool and I'm going to tell you all about how +I use it." + ;; "The quick brown fox jumps over the lazy dog.\nFive hexing wizard bots jump quickly." + ) + +(define (stats-message) + (format #f "fps: ~1,2f" + (/ 1.0 avg-frame-time))) + +(define (load) + (script + (forever + (sleep 60) + (set! stats-text (stats-message))))) (define (draw alpha) - (draw-text "The quick brown fox jumps over the lazy dog.\nFive hexing wizard bots jump quickly." - (vec2 140.0 240.0))) + (draw-text text position) + (draw-text stats-text stats-position) + (let ((current-time (elapsed-time))) + (set! avg-frame-time + (+ (* (- current-time start-time) 0.1) + (* avg-frame-time 0.9))) + (set! start-time current-time))) + +(define (update dt) + (update-agenda 1)) + +(define (key-press key modifiers repeat?) + (when (eq? key 'q) + (abort-game))) -(run-game #:draw draw) +(run-game #:draw draw + #:key-press key-press + #:load load + #:update update + #:window-title "text rendering" + #:window-width 1280 + #:window-height 720) diff --git a/examples/tile-map.scm b/examples/tile-map.scm index ae1342b..7aea4ca 100644 --- a/examples/tile-map.scm +++ b/examples/tile-map.scm @@ -2,7 +2,7 @@ (chickadee math vector) (chickadee math rect) (chickadee graphics color) - (chickadee graphics font) + (chickadee graphics text) (chickadee graphics tile-map) (ice-9 format) (ice-9 match) -- cgit v1.2.3