diff options
Diffstat (limited to 'chickadee/graphics/texture.scm')
-rw-r--r-- | chickadee/graphics/texture.scm | 39 |
1 files changed, 21 insertions, 18 deletions
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)) |