summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorHugo Hörnquist <hugo@lysator.liu.se>2019-06-09 20:48:21 +0200
committerDavid Thompson <dthompson2@worcester.edu>2019-06-09 18:15:04 -0400
commit0e85e89d730b99472454ca9327c228362dbe136d (patch)
treef29b3664704d72c4bb364dc011c8096d2cd02ac9
parenta8afc8a54ec96e25767133d6c1e22f53354c8800 (diff)
render: Add texture color/alpha mod bindings.
* sdl2/bindings.scm (sdl-set-texture-color-mod, sdl-get-texture-color-mod, sdl-set-texture-alpha-mod, sdl-get-texture-alpha-mood): New procedures. * sdl2/render.scm (set-texture-color-mod!, set-texture-alpha-mod!, get-texture-color-mod, get-texture-alpha-mod): New procedures. * doc/api.texi: Document new procedures.
-rw-r--r--doc/api.texi16
-rw-r--r--sdl2/bindings.scm12
-rw-r--r--sdl2/render.scm38
3 files changed, 66 insertions, 0 deletions
diff --git a/doc/api.texi b/doc/api.texi
index 67bb1b2..9184ed3 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1130,6 +1130,22 @@ Convert @var{surface} to a texture suitable for @var{renderer}.
Free the memory used by @var{texture}.
@end deffn
+@deffn {Procedure} get-texture-color-mod texture
+Get color mod of @var{texture} as a list of the integers.
+@end deffn
+
+@deffn {Procedure} get-texture-alpha-mod texture
+Get alpha mod of @var{texture} as a single integer.
+@end deffn
+
+@deffn {Procedure} set-texture-color-mod! texture r g b
+Set the color mod of @var{texture}.
+@end deffn
+
+@deffn {Procedure} set-texture-alpha-mod! texture a
+Set the alpha mod of @var{texture}.
+@end deffn
+
@node Images
@section Images
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index 2ebc2ed..238320c 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -259,6 +259,18 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
(define-foreign sdl-destroy-texture
void "SDL_DestroyTexture" '(*))
+(define-foreign sdl-set-texture-color-mod
+ int "SDL_SetTextureColorMod" (list '* uint8 uint8 uint8))
+
+(define-foreign sdl-get-texture-color-mod
+ int "SDL_GetTextureColorMod" '(* * * *))
+
+(define-foreign sdl-set-texture-alpha-mod
+ int "SDL_SetTextureAlphaMod" (list '* uint8))
+
+(define-foreign sdl-get-texture-alpha-mod
+ int "SDL_GetTextureAlphaMod" '(* *))
+
(define-foreign sdl-set-render-draw-color
int "SDL_SetRenderDrawColor" (list '* uint8 uint8 uint8 uint8))
diff --git a/sdl2/render.scm b/sdl2/render.scm
index 57a0e17..d48d938 100644
--- a/sdl2/render.scm
+++ b/sdl2/render.scm
@@ -50,6 +50,11 @@
render-fill-rect
render-fill-rects
+ set-texture-color-mod!
+ get-texture-color-mod
+ set-texture-alpha-mod!
+ get-texture-alpha-mod
+
make-texture
delete-texture!
surface->texture))
@@ -238,6 +243,39 @@ created with 'texture')"
"Free the memory used by TEXTURE."
(ffi:sdl-destroy-texture (unwrap-texture texture)))
+(define (set-texture-color-mod! texture r g b)
+ "Get color mod of TEXTURE as a list of the integers."
+ (unless (zero? (ffi:sdl-set-texture-color-mod (unwrap-texture texture) r g b))
+ (sdl-error "set-texture-color-mod!" "Failed to set texture color mod")))
+
+(define (set-texture-alpha-mod! texture a)
+ "Sets alpha mod of TEXTURE."
+ (unless (zero? (ffi:sdl-set-texture-alpha-mod (unwrap-texture texture) a))
+ (sdl-error "set-texture-alpha-mod!" "Failed to set texture alpha mod")))
+
+(define (get-texture-alpha-mod texture)
+ "Get alpha mod of TEXTURE as a single integer."
+ (let ((bv (make-bytevector 1)))
+ (let ((result (ffi:sdl-get-texture-alpha-mod
+ (unwrap-texture texture)
+ (bytevector->pointer bv 0))))
+ (unless (zero? result)
+ (sdl-error "get-texture-alpha-mod" "Failed to get texture allpha mod"))
+
+ (bytevector-u8-ref bv 0))))
+
+(define (get-texture-color-mod texture)
+ "Get color mod of TEXTURE as a list of the integers."
+ (let ((bv (make-bytevector 3)))
+ (let ((result (ffi:sdl-get-texture-color-mod
+ (unwrap-texture texture)
+ (bytevector->pointer bv 0)
+ (bytevector->pointer bv 1)
+ (bytevector->pointer bv 2))))
+ (unless (zero? result)
+ (sdl-error "get-texture-color-mod" "Failed to get texture color mod"))
+ (bytevector->u8-list bv))))
+
(define* (render-copy renderer texture
#:key (angle 0) srcrect dstrect center)
"Copy TEXTURE to the rendering target of RENDERER."