diff options
Diffstat (limited to 'sly/render/font.scm')
| -rw-r--r-- | sly/render/font.scm | 34 |
1 files changed, 8 insertions, 26 deletions
diff --git a/sly/render/font.scm b/sly/render/font.scm index 433e4bc..f9d1a91 100644 --- a/sly/render/font.scm +++ b/sly/render/font.scm @@ -27,8 +27,9 @@ #:use-module (srfi srfi-4) #:use-module (srfi srfi-9) #:use-module (system foreign) - #:use-module ((sdl sdl) #:prefix SDL:) - #:use-module ((sdl ttf) #:prefix SDL:) + #:use-module ((sdl2) #:prefix sdl2:) + #:use-module ((sdl2 surface) #:prefix sdl2:) + #:use-module ((sdl2 ttf) #:prefix sdl2:) #:use-module (gl) #:use-module (sly wrappers gl) #:use-module (sly render color) @@ -47,7 +48,7 @@ ;;; (define (enable-fonts) - (SDL:ttf-init)) + (sdl2:ttf-init)) (define-record-type <font> (make-font ttf point-size) @@ -58,7 +59,7 @@ (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) + (make-font (sdl2:load-font filename point-size) point-size) (error "File not found!" filename))) (define* (load-default-font #:optional (point-size 12)) @@ -66,33 +67,14 @@ argument with a default value of 12." (load-font (string-append %datadir "/fonts/DejaVuSans.ttf") point-size)) -(define (flip-pixels-vertically pixels width height) - "Create a new bytevector that reverses the rows in PIXELS, a WIDTH x -HEIGHT, 32 bit color bytevector." - (let ((buffer (make-u8vector (bytevector-length pixels))) - (row-width (* width 4))) ; assuming 32 bit color - (let loop ((y 0)) - (when (< y height) - (let* ((y* (- height y 1)) - (source-start (* y row-width)) - (target-start (* y* row-width))) - (bytevector-copy! pixels source-start buffer target-start row-width) - (loop (1+ y))))) - buffer)) +(define %sdl-white (sdl2:make-color 255 255 255 255)) (define (render-text font text) "Return a new texture with TEXT rendered using FONT." ;; An empty string will result in a surface value of #f, in which ;; case 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)) - (width (SDL:surface:w surface)) - (height (SDL:surface:h surface)) - ;; Need to flip pixels so that origin is on the bottom-left. - (pixels (flip-pixels-vertically (SDL:surface-pixels surface) - width height))) - ;; Need to flip pixels so that origin is on the bottom-left. - (bytevector->texture pixels width height 'linear 'linear))) + (let ((surface (sdl2:render-font-blended (font-ttf font) text %sdl-white))) + ((@@ (sly render texture) surface->texture) surface 'linear 'linear))) (define* (make-label font text #:key (anchor 'top-left)) "Create a sprite that displays TEXT rendered using FONT. ANCHOR |