From 4a5a9fed0841eee5cf1a52074d57af0cffdc45a4 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 30 Mar 2014 20:50:52 -0400 Subject: Fix crash when the empty string is used for a label. * 2d/font.scm (render-text): Bail when surface is #f. (make-label): Don't make vertices when there is no texture. (draw-label): Don't draw when there is no texture. --- 2d/font.scm | 26 +++++++++++++++----------- 1 file changed, 15 insertions(+), 11 deletions(-) (limited to '2d/font.scm') diff --git a/2d/font.scm b/2d/font.scm index 5cdc9cf..a9e178f 100644 --- a/2d/font.scm +++ b/2d/font.scm @@ -22,6 +22,7 @@ ;;; Code: (define-module (2d font) + #:use-module (srfi srfi-2) #:use-module (srfi srfi-9) #:use-module (system foreign) #:use-module ((sdl sdl) #:prefix SDL:) @@ -85,10 +86,12 @@ argument with a default value of 12." (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))) + ;; An empty string will result in a surface value of #f, in which we + ;; want to abort the texture creation process. + (and-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) @@ -139,16 +142,17 @@ argument with a default value of 12." 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)) + (vertices (and texture (make-label-vertices texture))) (anchor (anchor-texture texture anchor))) (%make-label font text position anchor color texture vertices))) (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))) + (when (label-texture label) + (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*) -- cgit v1.2.3