summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorDavid Thompson <dthompson2@worcester.edu>2023-03-25 14:16:07 -0400
committerDavid Thompson <dthompson2@worcester.edu>2023-03-25 14:16:07 -0400
commitdb2c6ec9bc4d6b0026084b07705d421621858a48 (patch)
tree60400b6241eb755103bd943ebd4ada2c1811bb16
parent58acb5b6b1fa5150822cf8cb6cea7ec6dbbd32c1 (diff)
graphics: texture: make-texture now expects a pixbuf.
-rw-r--r--chickadee/graphics/text.scm3
-rw-r--r--chickadee/graphics/texture.scm39
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))