diff options
| -rw-r--r-- | sly/render/font.scm | 25 | ||||
| -rw-r--r-- | sly/render/texture.scm | 35 |
2 files changed, 21 insertions, 39 deletions
diff --git a/sly/render/font.scm b/sly/render/font.scm index e50c96a..a4140d8 100644 --- a/sly/render/font.scm +++ b/sly/render/font.scm @@ -92,28 +92,9 @@ HEIGHT, 32 bit color bytevector." (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)) - (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 linear)) - (gl-texture-parameter (texture-target texture-2d) - (texture-parameter-name texture-mag-filter) - (texture-mag-filter linear)) - (gl-texture-image-2d (texture-target texture-2d) - 0 - (pixel-format rgba) - width - height - 0 - (pixel-format rgba) - (color-pointer-type unsigned-byte) - pixels)) - (make-texture texture-id #f - (SDL:surface:w surface) - (SDL:surface:h surface) - 0 0 1 1))) + width height))) + ;; Need to flip pixels so that origin is on the bottom-left. + (bytevector->texture pixels width height 'linear 'linear))) (define* (make-label font text #:optional #:key (anchor 'top-left) diff --git a/sly/render/texture.scm b/sly/render/texture.scm index a462ae4..b2b747e 100644 --- a/sly/render/texture.scm +++ b/sly/render/texture.scm @@ -35,6 +35,7 @@ #:use-module (sly wrappers freeimage) #:export (make-texture make-texture-region + bytevector->texture load-texture texture? texture-region? @@ -107,13 +108,14 @@ that will be rendered, in pixels." (unless (texture-region? texture) (gl-delete-texture (texture-id texture))))) -(define (bitmap->texture bitmap min-filter mag-filter) - "Translates a freeimage bitmap into an OpenGL texture." - (let ((texture-id (gl-generate-texture)) - (pixels (freeimage-get-bits bitmap))) +(define* (bytevector->texture pixels width height min-filter mag-filter + #:optional (format (pixel-format rgba))) + "Translate the bytevector PIXELS into an OpenGL texture with +dimensions WIDTHxHEIGHT where each pixel corresponds to the given +OpenGL pixel FORMAT. The generated textured uses MIN-FILTER for +downscaling and MAG-FILTER for upscaling." + (let ((texture-id (gl-generate-texture))) (with-gl-bind-texture (texture-target texture-2d) texture-id - ;; Use "nearest" scaling method so that pixel art doesn't become - ;; blurry when scaled. (gl-texture-parameter (texture-target texture-2d) (texture-parameter-name texture-min-filter) (match min-filter @@ -125,19 +127,18 @@ that will be rendered, in pixels." ('nearest (texture-mag-filter nearest)) ('linear (texture-mag-filter linear)))) (gl-texture-image-2d (texture-target texture-2d) - 0 - (pixel-format rgba) - (freeimage-get-width bitmap) - (freeimage-get-height bitmap) - 0 - (version-1-2 bgra) + 0 (pixel-format rgba) width height 0 format (color-pointer-type unsigned-byte) pixels)) - (make-texture texture-id - #f - (freeimage-get-width bitmap) - (freeimage-get-height bitmap) - 0 0 1 1))) + (make-texture texture-id #f width height 0 0 1 1))) + +(define (bitmap->texture bitmap min-filter mag-filter) + "Translates a freeimage bitmap into an OpenGL texture." + (bytevector->texture (freeimage-get-bits bitmap) + (freeimage-get-width bitmap) + (freeimage-get-height bitmap) + min-filter mag-filter + (version-1-2 bgra))) (define (load-bitmap filename) ;; Throw an error if image file does not exist or else we will |