From 0e85e89d730b99472454ca9327c228362dbe136d Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Hugo=20H=C3=B6rnquist?= <hugo@lysator.liu.se>
Date: Sun, 9 Jun 2019 20:48:21 +0200
Subject: 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.
---
 doc/api.texi      | 16 ++++++++++++++++
 sdl2/bindings.scm | 12 ++++++++++++
 sdl2/render.scm   | 38 ++++++++++++++++++++++++++++++++++++++
 3 files changed, 66 insertions(+)

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."
-- 
cgit v1.2.3