summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--2d/font.scm188
-rw-r--r--2d/wrappers/ftgl.scm204
-rw-r--r--configure.ac2
-rw-r--r--data/Makefile.am4
-rw-r--r--data/shaders/font-fragment.glsl8
-rw-r--r--data/shaders/font-vertex.glsl15
-rw-r--r--examples/font.scm50
-rw-r--r--examples/fonts/AUTHORS2
-rw-r--r--examples/fonts/Boxy-Bold.ttfbin14432 -> 0 bytes
9 files changed, 175 insertions, 298 deletions
diff --git a/2d/font.scm b/2d/font.scm
index 7da74a3..0905f69 100644
--- a/2d/font.scm
+++ b/2d/font.scm
@@ -25,102 +25,126 @@
#:use-module (figl gl)
#:use-module (srfi srfi-9)
#:use-module (system foreign)
- #:use-module (2d wrappers ftgl)
+ #:use-module ((sdl sdl) #:prefix SDL:)
+ #:use-module ((sdl ttf) #:prefix SDL:)
+ #:use-module (figl gl)
+ #:use-module (figl contrib packed-struct)
#:use-module (2d color)
#:use-module (2d config)
- #:use-module (2d vector2))
+ #:use-module (2d shader)
+ #:use-module (2d signals)
+ #:use-module (2d texture)
+ #:use-module (2d vector2)
+ #:use-module (2d window)
+ #:use-module (2d wrappers gl)
+ #:export (load-font
+ load-default-font
+ font?
+ font-point-size
+ make-label
+ label?
+ label-font
+ label-text
+ label-position
+ label-color
+ draw-label))
+
+(SDL:ttf-init)
;;;
;;; Font
;;;
-;; Font objects represent an FTGL texture font at a given size.
(define-record-type <font>
- (make-font ftgl-font size)
+ (make-font ttf point-size)
font?
- (ftgl-font font-ftgl-font)
- (size font-size))
-
-(define (load-font filename size)
- "Load a font from FILENAME with the given SIZE in points."
- (let ((ftgl-font (ftgl-create-texture-font filename)))
- ;; Hardcoded 72 dpi for now.
- (ftgl-set-font-face-size ftgl-font size 72)
- (make-font ftgl-font size)))
+ (ttf font-ttf)
+ (point-size font-point-size))
-(define (flip-text font)
- "Flip current GL matrix about the x-axis and translates by the
-negative font ascender value. This is necessary before rendering text
-because guile-2d flips the y-axis so that the origin is in the
-upper-left corner rather than the bottom-left."
- (gl-scale 1 -1 1)
- (gl-translate 0 (- (ftgl-get-font-ascender (font-ftgl-font font))) 0))
+(define (load-font filename point-size)
+ "Load the TTF font in FILENAME with the given POINT-SIZE."
+ (if (file-exists? filename)
+ (make-font (SDL:load-font filename point-size) point-size)
+ (error "File not found!" filename)))
-(define (draw-font font text)
- "Renders the string text using the given font."
- (with-gl-push-matrix
- (flip-text font)
- (ftgl-render-font (font-ftgl-font font)
- text
- (ftgl-render-mode all))))
+(define* (load-default-font #:optional (point-size 12))
+ "Load the guile-2d default TTF font. POINT-SIZE is an optional
+argument with a default value of 12."
+ (load-font (string-append %pkgdatadir "/fonts/DejaVuSans.ttf") point-size))
-(define* (load-default-font #:optional (size 12))
- (load-font (string-append %pkgdatadir "/fonts/DejaVuSans.ttf") size))
+(define (render-text font text)
+ "Return a new texture with TEXT rendered using FONT."
+ (let* ((surface (SDL:render-utf8 (font-ttf font) text
+ (SDL:make-color 255 255 255) #t))
+ (pixels (SDL:surface-pixels surface))
+ (texture-id (gl-generate-texture)))
+ (with-gl-bind-texture (texture-target texture-2d) texture-id
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-min-filter)
+ (texture-min-filter nearest))
+ (gl-texture-parameter (texture-target texture-2d)
+ (texture-parameter-name texture-mag-filter)
+ (texture-mag-filter nearest))
+ (gl-texture-image-2d (texture-target texture-2d)
+ 0
+ (pixel-format rgba)
+ (SDL:surface:w surface)
+ (SDL:surface:h surface)
+ 0
+ (version-1-2 bgra)
+ (color-pointer-type unsigned-byte)
+ pixels))
+ (make-texture texture-id #f
+ (SDL:surface:w surface)
+ (SDL:surface:h surface)
+ 0 0 1 1)))
-(export <font>
- make-font
- font?
- font-size
- load-font
- draw-font
- load-default-font)
-
-;;;
-;;; Textbox
-;;;
+(define-record-type <label>
+ (%make-label font text position anchor color texture vertices)
+ label?
+ (font label-font)
+ (text label-text)
+ (position label-position)
+ (anchor label-anchor)
+ (color label-color)
+ (texture label-texture)
+ (vertices label-vertices))
-;; A textbox is a string of word-wrapped text
-(define-record-type <textbox>
- (%make-textbox font text position color alignment line-length layout)
- textbox?
- (font textbox-font)
- (text textbox-text set-textbox-text!)
- (position textbox-position set-textbox-position!)
- (color textbox-color set-textbox-color!)
- (alignment textbox-alignment)
- (line-length textbox-line-length)
- (layout textbox-layout))
+(define (make-label-vertices texture)
+ "Return a packed array of vertices for TEXTURE."
+ (let ((vertices (make-packed-array texture-vertex 4)))
+ (pack-texture-vertices vertices 0
+ (texture-width texture)
+ (texture-height texture)
+ (texture-s1 texture)
+ (texture-t1 texture)
+ (texture-s2 texture)
+ (texture-t2 texture))
+ vertices))
-(define (make-textbox font text position color alignment line-length)
- "Create a textbox that will draw TEXT with the given FONT, at vector
-POSITION, with ALIGNMENT, and a maximum LINE-LENGTH."
- (let ((layout (ftgl-create-layout)))
- (ftgl-set-layout-font layout (font-ftgl-font font))
- ;; (ftgl-set-layout-alignment layout (ftgl-text-alignment alignment))
- (ftgl-set-layout-line-length layout line-length)
- (%make-textbox font text position color alignment line-length layout)))
+(define* (make-label font text position #:optional #:key
+ (color white) (anchor 'top-left))
+ "Return a new label containing the string TEXT rendered with FONT at
+the given position. Optional arguments are COLOR with a default of
+white and ANCHOR with a default of 'top-left."
+ (let* ((texture (render-text font text))
+ (vertices (make-label-vertices texture))
+ (anchor (anchor-texture texture anchor)))
+ (%make-label font text position anchor color texture vertices)))
-(define (draw-textbox textbox)
- "Draw TEXTBOX."
- (with-gl-push-matrix
- (vector2-translate (textbox-position textbox))
- (flip-text (textbox-font textbox))
- (use-color (textbox-color textbox))
- (ftgl-render-layout (textbox-layout textbox)
- (textbox-text textbox)
- (ftgl-render-mode all))))
+(define font-shader
+ (make-shader-program
+ (load-vertex-shader (string-append %pkgdatadir
+ "/shaders/font-vertex.glsl"))
+ (load-fragment-shader (string-append %pkgdatadir
+ "/shaders/font-fragment.glsl"))))
-(export <textbox>
- make-textbox
- textbox?
- textbox-font
- textbox-text
- set-textbox-text!
- textbox-position
- set-textbox-position!
- textbox-color
- set-textbox-color!
- textbox-alignment
- textbox-line-length
- textbox-layout
- draw-textbox)
+(define (draw-label label)
+ "Draw LABEL on the screen."
+ (with-shader-program font-shader
+ (uniforms ((projection (signal-ref window-projection))
+ (position (label-position label))
+ (anchor (label-anchor label))
+ (color (label-color label)))
+ (draw-texture-vertices (label-texture label) (label-vertices label) 1)))
+ *unspecified*)
diff --git a/2d/wrappers/ftgl.scm b/2d/wrappers/ftgl.scm
deleted file mode 100644
index 1ff42d7..0000000
--- a/2d/wrappers/ftgl.scm
+++ /dev/null
@@ -1,204 +0,0 @@
-;;; guile-2d
-;;; Copyright (C) 2013 David Thompson <dthompson2@worcester.edu>
-;;;
-;;; Guile-2d is free software: you can redistribute it and/or modify it
-;;; under the terms of the GNU Lesser General Public License as
-;;; published by the Free Software Foundation, either version 3 of the
-;;; License, or (at your option) any later version.
-;;;
-;;; Guile-2d 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
-;;; Lesser General Public License for more details.
-;;;
-;;; You should have received a copy of the GNU Lesser General Public
-;;; License along with this program. If not, see
-;;; <http://www.gnu.org/licenses/>.
-
-;;; Commentary:
-;;
-;; Quick and dirty wrapper for the FTGL library.
-;;
-;;; Code:
-
-(define-module (2d wrappers ftgl)
- #:use-module (system foreign)
- #:use-module (2d wrappers util)
- #:use-module (ice-9 format))
-
-(define libftgl (dynamic-link "libftgl"))
-
-(define-syntax-rule (define-foreign name ret string-name args)
- (define name
- (pointer->procedure ret (dynamic-func string-name libftgl) args)))
-
-;;;
-;;; Enums
-;;;
-
-(define-enumeration ftgl-render-mode
- (front #x0001)
- (back #x0002)
- (side #x0004)
- (all #xffff))
-
-(define-enumeration ftgl-text-alignment
- (left 0)
- (center 1)
- (right 2)
- (justify 3))
-
-(export ftgl-render-mode
- ftgl-text-alignment)
-
-;;;
-;;; Fonts
-;;;
-
-(define-wrapped-pointer-type <ftgl-font>
- ftgl-font?
- wrap-ftgl-font unwrap-ftgl-font
- (lambda (r port)
- (let ((font (unwrap-ftgl-font r)))
- (format port
- "<ftgl-font ~x>"
- (pointer-address font)))))
-
-(define-foreign %ftgl-create-texture-font
- '* "ftglCreateTextureFont" '(*))
-
-(define-foreign %ftgl-set-font-face-size
- void "ftglSetFontFaceSize" (list '* unsigned-int unsigned-int))
-
-(define-foreign %ftgl-render-font
- void "ftglRenderFont" (list '* '* unsigned-int))
-
-(define-foreign %ftgl-get-font-descender
- float "ftglGetFontDescender" '(*))
-
-(define-foreign %ftgl-get-font-ascender
- float "ftglGetFontAscender" '(*))
-
-(define (ftgl-create-texture-font filename)
- (unless (file-exists? filename)
- (throw 'font-not-found filename))
- (let ((font (%ftgl-create-texture-font (string->pointer filename))))
- (when (null-pointer? font)
- (throw 'font-load-failure filename))
- (wrap-ftgl-font font)))
-
-(define (ftgl-set-font-face-size font size res)
- (%ftgl-set-font-face-size (unwrap-ftgl-font font) size res))
-
-(define (ftgl-render-font font text render-mode)
- (%ftgl-render-font (unwrap-ftgl-font font)
- (string->pointer text)
- render-mode))
-
-(define (ftgl-get-font-descender font)
- (%ftgl-get-font-descender (unwrap-ftgl-font font)))
-
-(define (ftgl-get-font-ascender font)
- (%ftgl-get-font-ascender (unwrap-ftgl-font font)))
-
-(export ftgl-create-texture-font
- ftgl-set-font-face-size
- ftgl-render-font
- ftgl-get-font-descender
- ftgl-get-font-ascender)
-
-;;;
-;;; SimpleLayout
-;;;
-
-(define-wrapped-pointer-type <ftgl-simple-layout>
- ftgl-simple-layout?
- wrap-ftgl-simple-layout unwrap-ftgl-simple-layout
- (lambda (r port)
- (let ((simple-layout (unwrap-ftgl-simple-layout r)))
- (format port
- "<ftgl-simple-layout ~x>"
- (pointer-address simple-layout)))))
-
-(define-foreign %ftgl-create-simple-layout
- '* "ftglCreateSimpleLayout" '())
-
-(define-foreign %ftgl-destroy-layout
- void "ftglDestroyLayout" '(*))
-
-(define-foreign %ftgl-set-layout-font
- void "ftglSetLayoutFont" '(* *))
-
-(define-foreign %ftgl-get-layout-font
- '* "ftglGetLayoutFont" '(*))
-
-(define-foreign %ftgl-set-layout-line-length
- void "ftglSetLayoutLineLength" (list '* float))
-
-(define-foreign %ftgl-get-layout-line-length
- float "ftglGetLayoutLineLength" '(*))
-
-(define-foreign %ftgl-set-layout-alignment
- void "ftglSetLayoutAlignment" (list '* int))
-
-(define-foreign %ftgl-get-layout-alignment
- int "ftglGetLayoutAlignement" '(*))
-
-(define-foreign %ftgl-set-layout-line-spacing
- void "ftglSetLayoutLineSpacing" (list '* float))
-
-;; For some reason this symbol is not found.
-;; (define-foreign %ftgl-get-layout-line-spacing
-;; float "ftglGetLayoutLineSpacing" '(*))
-
-(define-foreign %ftgl-render-layout
- void "ftglRenderLayout" (list '* '* int))
-
-(define (ftgl-create-layout)
- (wrap-ftgl-simple-layout
- (%ftgl-create-simple-layout)))
-
-(define (ftgl-destroy-layout layout)
- (%ftgl-destroy-layout (unwrap-ftgl-simple-layout layout)))
-
-(define (ftgl-set-layout-font layout font)
- (%ftgl-set-layout-font (unwrap-ftgl-simple-layout layout)
- (unwrap-ftgl-font font)))
-
-(define (ftgl-get-layout-font layout)
- (wrap-ftgl-font
- (%ftgl-get-layout-font (unwrap-ftgl-simple-layout layout))))
-
-(define (ftgl-set-layout-line-length layout line-length)
- (%ftgl-set-layout-line-length (unwrap-ftgl-simple-layout layout)
- line-length))
-
-(define (ftgl-get-layout-line-length layout)
- (%ftgl-get-layout-line-length (unwrap-ftgl-simple-layout layout)))
-
-(define (ftgl-set-layout-alignment layout alignment)
- (%ftgl-set-layout-alignment (unwrap-ftgl-simple-layout layout)
- alignment))
-
-(define (ftgl-get-layout-alignment layout)
- (%ftgl-get-layout-alignment (unwrap-ftgl-simple-layout layout)))
-
-(define (ftgl-set-layout-line-spacing layout spacing)
- (%ftgl-set-layout-line-spacing (unwrap-ftgl-simple-layout layout)
- spacing))
-
-(define (ftgl-render-layout layout text mode)
- (%ftgl-render-layout (unwrap-ftgl-simple-layout layout)
- (string->pointer text)
- mode))
-
-(export ftgl-create-layout
- ftgl-destroy-layout
- ftgl-set-layout-font
- ftgl-get-layout-font
- ftgl-set-layout-line-length
- ftgl-get-layout-line-length
- ftgl-set-layout-alignment
- ftgl-get-layout-alignment
- ftgl-set-layout-line-spacing
- ftgl-render-layout)
diff --git a/configure.ac b/configure.ac
index 93b3922..01f74b7 100644
--- a/configure.ac
+++ b/configure.ac
@@ -19,7 +19,7 @@ AC_CONFIG_FILES([Makefile doc/Makefile examples/Makefile data/Makefile])
AC_CONFIG_FILES([env], [chmod +x env])
PKG_CHECK_MODULES([SDL], [sdl <= 1.3 sdl >= 1.2])
-PKG_CHECK_MODULES([FTGL], [ftgl >= 2.1])
+PKG_CHECK_MODULES([SDL_tff], [SDL_ttf >= 2.0])
# Why doesn't freeimage have a pkg-config file?
#PKG_CHECK_MODULES([freeimage], [freeimage >= 3.0])
diff --git a/data/Makefile.am b/data/Makefile.am
index b6d0d74..8fc3a3e 100644
--- a/data/Makefile.am
+++ b/data/Makefile.am
@@ -4,4 +4,6 @@ fonts_DATA = fonts/DejaVuSans.ttf
shadersdir = $(pkgdatadir)/shaders
shaders_DATA = \
shaders/sprite-vertex.glsl \
- shaders/sprite-fragment.glsl
+ shaders/sprite-fragment.glsl \
+ shaders/font-vertex.glsl \
+ shaders/font-fragment.glsl
diff --git a/data/shaders/font-fragment.glsl b/data/shaders/font-fragment.glsl
new file mode 100644
index 0000000..3dd10f1
--- /dev/null
+++ b/data/shaders/font-fragment.glsl
@@ -0,0 +1,8 @@
+#version 120
+
+uniform sampler2D color_texture;
+uniform vec4 color;
+
+void main (void) {
+ gl_FragColor = texture2D(color_texture, gl_TexCoord[0].st) * color;
+}
diff --git a/data/shaders/font-vertex.glsl b/data/shaders/font-vertex.glsl
new file mode 100644
index 0000000..196da12
--- /dev/null
+++ b/data/shaders/font-vertex.glsl
@@ -0,0 +1,15 @@
+#version 120
+
+uniform mat4 projection;
+uniform vec2 position;
+uniform vec2 anchor;
+
+void main(void) {
+ mat4 translation = mat4(1.0, 0.0, 0.0, position.x - anchor.x,
+ 0.0, 1.0, 0.0, position.y - anchor.y,
+ 0.0, 0.0, 1.0, 0.0,
+ 0.0, 0.0, 0.0, 1.0);
+
+ gl_Position = projection * (gl_Vertex * translation);
+ gl_TexCoord[0] = gl_MultiTexCoord0;
+}
diff --git a/examples/font.scm b/examples/font.scm
index 465600c..2398b36 100644
--- a/examples/font.scm
+++ b/examples/font.scm
@@ -1,22 +1,56 @@
(use-modules (srfi srfi-9)
(figl gl)
+ (2d agenda)
+ (2d fps)
(2d color)
(2d font)
(2d game)
+ (2d mouse)
+ (2d signals)
(2d vector2)
(2d window))
(load "common.scm")
-(define textbox
- (make-textbox (load-font "fonts/Boxy-Bold.ttf" 48)
- "The quick brown fox jumped over the lazy dog."
- (vector2 240 160)
- white
- 'left
- 200))
+(define font (load-default-font 18))
+(define position (vector2 320 240))
+(define text "The quick brown fox jumped over the lazy dog.")
+(define label (make-label font text position #:anchor 'center))
-(add-hook! draw-hook (lambda (dt alpha) (draw-textbox textbox)))
+(define fps-label-position (vector2 0 0))
+(define (make-fps-label)
+ (make-label font (format #f "FPS: ~d" (fps)) fps-label-position))
+(define fps-label (make-fps-label))
+
+(define mouse-label-position (vector2 0 20))
+(define mouse-label
+ (signal-map (lambda (p)
+ (let ((text (format #f "Mouse: (~d, ~d)" (vx p) (vy p))))
+ (make-label font text mouse-label-position)))
+ mouse-position))
+
+(define gc-label-position (vector2 0 40))
+(define gc-counter (make-root-signal 0))
+(define gc-label
+ (signal-map (lambda (counter)
+ (let ((text (format #f "GCs: ~d" counter)))
+ (make-label font text gc-label-position)))
+ gc-counter))
+
+(add-hook! after-gc-hook
+ (lambda ()
+ (signal-set! gc-counter (1+ (signal-ref gc-counter)))))
+
+(schedule-interval game-agenda
+ (lambda ()
+ (set! fps-label (make-fps-label)))
+ 60)
+
+(add-hook! draw-hook (lambda (dt alpha)
+ (draw-label label)
+ (draw-label fps-label)
+ (draw-label (signal-ref mouse-label))
+ (draw-label (signal-ref gc-label))))
(with-window (make-window #:title "Fonts")
(run-game-loop))
diff --git a/examples/fonts/AUTHORS b/examples/fonts/AUTHORS
deleted file mode 100644
index 0f278b8..0000000
--- a/examples/fonts/AUTHORS
+++ /dev/null
@@ -1,2 +0,0 @@
-Clint Bellanger and William Thompson
-http://opengameart.org/content/boxy-bold-truetype-font \ No newline at end of file
diff --git a/examples/fonts/Boxy-Bold.ttf b/examples/fonts/Boxy-Bold.ttf
deleted file mode 100644
index 8076dc5..0000000
--- a/examples/fonts/Boxy-Bold.ttf
+++ /dev/null
Binary files differ
generated by cgit v1.2.3 (git 2.25.4) at 2024-11-21 20:39:09 +0000