diff options
| -rw-r--r-- | chickadee/graphics/text.scm | 3 | ||||
| -rw-r--r-- | chickadee/graphics/texture.scm | 39 |
2 files changed, 23 insertions, 19 deletions
diff --git a/chickadee/graphics/text.scm b/chickadee/graphics/text.scm index ca33cb7..f1d4359 100644 --- a/chickadee/graphics/text.scm +++ b/chickadee/graphics/text.scm @@ -39,6 +39,7 @@ #:use-module (chickadee math matrix) #:use-module (chickadee math rect) #:use-module (chickadee math vector) + #:use-module (chickadee pixbuf) #:use-module (chickadee graphics blend) #:use-module (chickadee graphics color) #:use-module (chickadee graphics engine) @@ -198,7 +199,7 @@ non-smooth scaling will be used." char-set)) (texture-filter (if smooth? 'linear 'nearest)) ;; TODO: Use multiple textures if needed. - (texture (make-texture pixels texture-size texture-size + (texture (make-texture (bytevector->pixbuf pixels texture-size texture-size) #:min-filter texture-filter #:mag-filter texture-filter))) ;; Process kernings. diff --git a/chickadee/graphics/texture.scm b/chickadee/graphics/texture.scm index af36703..dc002b9 100644 --- a/chickadee/graphics/texture.scm +++ b/chickadee/graphics/texture.scm @@ -229,7 +229,7 @@ ((rgba) (pixel-format rgba)))) -(define* (make-texture pixels width height #:key +(define* (make-texture pixbuf #:key flip? (min-filter 'nearest) (mag-filter 'nearest) @@ -248,13 +248,15 @@ symbols are: repeat (the default), mirrored-repeat, clamp, clamp-to-border, clamp-to-edge. FORMAT specifies the pixel format. Currently only 32-bit RGBA format is supported." (assert-current-graphics-engine) - (let ((texture (%make-texture (gl-generate-texture) '2d #f - min-filter mag-filter wrap-s wrap-t - 0 0 width height - (make-rect 0.0 0.0 width height) - (if flip? - (make-rect 0.0 1.0 1.0 -1.0) - (make-rect 0.0 0.0 1.0 1.0))))) + (let* ((width (pixbuf-width pixbuf)) + (height (pixbuf-height pixbuf)) + (texture (%make-texture (gl-generate-texture) '2d #f + min-filter mag-filter wrap-s wrap-t + 0 0 width height + (make-rect 0.0 0.0 width height) + (if flip? + (make-rect 0.0 1.0 1.0 -1.0) + (make-rect 0.0 0.0 1.0 1.0))))) (graphics-engine-guard! texture) (with-graphics-state! ((g:texture-0 texture)) ;; Ensure that we are using texture unit 0 because @@ -276,7 +278,7 @@ Currently only 32-bit RGBA format is supported." 0 (pixel-format rgba) width height 0 (gl-pixel-format format) (color-pointer-type unsigned-byte) - (or pixels %null-pointer)) + (pixbuf-pixels pixbuf)) ;; Generate mipmaps, if needed. (when (memq min-filter '(nearest-mipmap-nearest @@ -400,9 +402,7 @@ that should be used for minification and magnification. Valid values are 'nearest and 'linear. By default, 'nearest is used." (let* ((image* (if (image? image) image (make-image image))) (pixbuf (%load-image image* transparent-color flip?))) - (make-texture (pixbuf-pixels pixbuf) - (pixbuf-width pixbuf) - (pixbuf-height pixbuf) + (make-texture pixbuf #:min-filter min-filter #:mag-filter mag-filter #:wrap-s wrap-s @@ -448,16 +448,18 @@ are 'nearest and 'linear. By default, 'nearest is used." (define %white-texture (delay - (make-texture (u32vector #xffffffff #xffffffff #xffffffff #xffffffff) - 2 2))) + (make-texture + (bytevector->pixbuf (u32vector #xffffffff #xffffffff #xffffffff #xffffffff) + 2 2)))) (define (white-texture) (force %white-texture)) (define %gray-texture (delay - (make-texture (u32vector #xff808080 #xff808080 #xff808080 #xff808080) - 2 2))) + (make-texture + (bytevector->pixbuf (u32vector #xff808080 #xff808080 #xff808080 #xff808080) + 2 2)))) (define (gray-texture) (force %gray-texture)) @@ -473,8 +475,9 @@ are 'nearest and 'linear. By default, 'nearest is used." ;; unchanged by this normal map. (define %flat-texture (delay - (make-texture (u32vector #xffff8080 #xffff8080 #xffff8080 #xffff8080) - 2 2))) + (make-texture + (bytevector->pixbuf (u32vector #xffff8080 #xffff8080 #xffff8080 #xffff8080) + 2 2)))) (define (flat-texture) (force %flat-texture)) |