From fc2584672c096ae63469cce9ede9abaa4a95ece7 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 16 Feb 2014 10:44:24 -0500 Subject: Rewrite font module. FTGL has been dropped in favor of SDL_ttf. * 2d/font: Rewrite everything! * 2d/wrappers/ftgl.scm: Delete it. * configure.ac: Check for SDL_ttf. * data/Makefile.am (shaders_DATA): Add font shaders. * data/shaders/font-fragment.glsl: New shader. * data/shaders/font-vertex.glsl: New shader. * examples/font.scm: Rewrite font example. * examples/fonts/AUTHORS: Delete it. * examples/fonts/Boxy-Bold.ttf: Delete it. --- 2d/font.scm | 188 ++++++++++++++++++++++++++--------------------- 2d/wrappers/ftgl.scm | 204 --------------------------------------------------- 2 files changed, 106 insertions(+), 286 deletions(-) delete mode 100644 2d/wrappers/ftgl.scm (limited to '2d') 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 - (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 - make-font - font? - font-size - load-font - draw-font - load-default-font) - -;;; -;;; Textbox -;;; +(define-record-type