diff options
| -rw-r--r-- | chickadee/render/texture.scm | 38 |
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)))) ;;; |