summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--chickadee/render/texture.scm38
1 files changed, 29 insertions, 9 deletions
diff --git a/chickadee/render/texture.scm b/chickadee/render/texture.scm
index c376bd9..051ec4f 100644
--- a/chickadee/render/texture.scm
+++ b/chickadee/render/texture.scm
@@ -24,9 +24,10 @@
#:use-module (system foreign)
#:use-module (gl)
#:use-module (gl enums)
- #:use-module (sdl2 surface)
+ #:use-module ((sdl2 surface) #:prefix sdl2:)
#:use-module (oop goops)
#:use-module (chickadee math rect)
+ #:use-module (chickadee render color)
#:use-module (chickadee render gl)
#:use-module (chickadee render gpu)
#:export (make-texture
@@ -212,15 +213,32 @@ HEIGHT, 32 bit color bytevector."
(loop (1+ y)))))
buffer))
-(define (surface->texture surface min-filter mag-filter wrap-s wrap-t)
+(define (surface->texture surface min-filter mag-filter wrap-s wrap-t transparent-color)
"Convert SURFACE, an SDL2 surface object, into a texture that uses
the given MIN-FILTER and MAG-FILTER."
;; Convert to 32 bit RGBA color.
- (call-with-surface (convert-surface-format surface 'abgr8888)
+ (sdl2:call-with-surface (sdl2:convert-surface-format surface 'abgr8888)
(lambda (surface)
- (let* ((width (surface-width surface))
- (height (surface-height surface))
- (pixels (surface-pixels surface)))
+ (let* ((width (sdl2:surface-width surface))
+ (height (sdl2:surface-height surface))
+ (pixels (sdl2:surface-pixels surface)))
+ ;; Zero the alpha channel of pixels that match the transparent
+ ;; color key.
+ (when transparent-color
+ (let ((r (inexact->exact (* (color-r transparent-color) 255)))
+ (g (inexact->exact (* (color-g transparent-color) 255)))
+ (b (inexact->exact (* (color-b transparent-color) 255)))
+ (pixel-count (* width height 4)))
+ (let loop ((i 0))
+ (when (< i pixel-count)
+ (when (and (= r (bytevector-u8-ref pixels i))
+ (= g (bytevector-u8-ref pixels (+ i 1)))
+ (= b (bytevector-u8-ref pixels (+ i 2))))
+ (bytevector-u8-set! pixels i 255)
+ (bytevector-u8-set! pixels (+ i 1) 255)
+ (bytevector-u8-set! pixels (+ i 2) 255)
+ (bytevector-u8-set! pixels (+ i 3) 0))
+ (loop (+ i 4))))))
(make-texture pixels width height
#:min-filter min-filter
#:mag-filter mag-filter
@@ -231,14 +249,16 @@ the given MIN-FILTER and MAG-FILTER."
(min-filter 'nearest)
(mag-filter 'nearest)
(wrap-s 'repeat)
- (wrap-t 'repeat))
+ (wrap-t 'repeat)
+ transparent-color)
"Load a texture from an image in FILE. MIN-FILTER and MAG-FILTER
describe the method that should be used for minification and
magnification. Valid values are 'nearest and 'linear. By default,
'nearest is used."
- (call-with-surface ((@ (sdl2 image) load-image) file)
+ (sdl2:call-with-surface ((@ (sdl2 image) load-image) file)
(lambda (surface)
- (surface->texture surface min-filter mag-filter wrap-s wrap-t))))
+ (surface->texture surface min-filter mag-filter wrap-s wrap-t
+ transparent-color))))
;;;