render: Add SDL_QueryTexture binding.

* sdl2/bindings.scm (sdl-query-texture): New variable.
* sdl2/render.scm (query-texture): New variable.
* doc/api.texi: Document it here.

3 files changed, 67 insertions, 1 deletions

diff --git a/doc/api.texi b/doc/api.texi
index f1075b9..ed79da5 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1217,6 +1217,10 @@ requires that renderer was created with the @code{texture} flag.
 @end itemize
 @end deffn
 
+@deffn {Procedure} query-texture texture
+Return 4 values for the format, access, width and height of a texture.
+@end deffn
+
 @deffn {Procedure} surface->texture renderer surface
 Convert @var{surface} to a texture suitable for @var{renderer}.
 @end deffn
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index aea12c9..373f3aa 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -306,6 +306,9 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
 (define-foreign sdl-destroy-texture
   void "SDL_DestroyTexture" '(*))
 
+(define-foreign sdl-query-texture
+  int "SDL_QueryTexture" '(* * * * *))
+
 (define-foreign sdl-set-texture-color-mod
   int "SDL_SetTextureColorMod" (list '* uint8 uint8 uint8))
 
diff --git a/sdl2/render.scm b/sdl2/render.scm
index 948e256..e51e476 100644
--- a/sdl2/render.scm
+++ b/sdl2/render.scm
@@ -67,7 +67,8 @@
 
             make-texture
             delete-texture!
-            surface->texture))
+            surface->texture
+            query-texture))
 
 
 ;;;
@@ -344,6 +345,64 @@ created with 'texture')"
   "Free the memory used by TEXTURE."
   (ffi:sdl-destroy-texture (unwrap-texture texture)))
 
+(define (query-texture texture)
+  "Return 4 values for the format, access, width and height of
+TEXTURE."
+  (let ((bv (make-bytevector (+ (sizeof uint32)
+                                (* 3 (sizeof int)))
+                             0)))
+    (unless (zero?
+             (ffi:sdl-query-texture
+              (unwrap-texture texture)
+              (bytevector->pointer bv)
+              (bytevector->pointer bv (sizeof uint32))
+              (bytevector->pointer bv (+ (sizeof uint32) (sizeof int)))
+              (bytevector->pointer bv (+ (sizeof uint32) (* 2 (sizeof int))))))
+      (sdl-error "query-texture" "Failed to query texture"))
+    (values
+     (match (bytevector-uint-ref bv 0 (native-endianness) (sizeof uint32))
+       (ffi:SDL_PIXELFORMAT_INDEX1LSB 'index1lsb)
+       (ffi:SDL_PIXELFORMAT_INDEX1MSB 'index1msb)
+       (ffi:SDL_PIXELFORMAT_INDEX4LSB 'index4lsb)
+       (ffi:SDL_PIXELFORMAT_INDEX4MSB 'index4msb)
+       (ffi:SDL_PIXELFORMAT_INDEX8 'index8)
+       (ffi:SDL_PIXELFORMAT_RGB332 'rgb332)
+       (ffi:SDL_PIXELFORMAT_RGB444 'rgb444)
+       (ffi:SDL_PIXELFORMAT_RGB555 'rgb555)
+       (ffi:SDL_PIXELFORMAT_BGR555 'bgr555)
+       (ffi:SDL_PIXELFORMAT_ARGB4444 'argb4444)
+       (ffi:SDL_PIXELFORMAT_RGBA4444 'rgba4444)
+       (ffi:SDL_PIXELFORMAT_ABGR4444 'abgr4444)
+       (ffi:SDL_PIXELFORMAT_BGRA4444 'bgra4444)
+       (ffi:SDL_PIXELFORMAT_ARGB1555 'argb1555)
+       (ffi:SDL_PIXELFORMAT_RGBA5551 'rgba5551)
+       (ffi:SDL_PIXELFORMAT_ABGR1555 'abgr1555)
+       (ffi:SDL_PIXELFORMAT_BGRA5551 'bgra5551)
+       (ffi:SDL_PIXELFORMAT_RGB565 'rgb565)
+       (ffi:SDL_PIXELFORMAT_BGR565 'bgr565)
+       (ffi:SDL_PIXELFORMAT_RGB24 'rgb24)
+       (ffi:SDL_PIXELFORMAT_BGR24 'bgr24)
+       (ffi:SDL_PIXELFORMAT_RGB888 'rgb888)
+       (ffi:SDL_PIXELFORMAT_RGBX8888 'rgbx8888)
+       (ffi:SDL_PIXELFORMAT_BGR888 'bgr888)
+       (ffi:SDL_PIXELFORMAT_BGRX8888 'bgrx8888)
+       (ffi:SDL_PIXELFORMAT_ARGB8888 'argb8888)
+       (ffi:SDL_PIXELFORMAT_RGBA8888 'rgba8888)
+       (ffi:SDL_PIXELFORMAT_ABGR8888 'abgr8888)
+       (ffi:SDL_PIXELFORMAT_BGRA8888 'bgra8888)
+       (ffi:SDL_PIXELFORMAT_ARGB2101010 'argb2101010)
+       (ffi:SDL_PIXELFORMAT_YV12 'yv12)
+       (ffi:SDL_PIXELFORMAT_IYUV 'iyuv)
+       (ffi:SDL_PIXELFORMAT_YUY2 'yuy2)
+       (ffi:SDL_PIXELFORMAT_UYVY 'uyvy)
+       (ffi:SDL_PIXELFORMAT_YVYU 'yvyu))
+     (match (bytevector-uint-ref bv (sizeof int) (native-endianness) (sizeof int))
+       (ffi:SDL_TEXTUREACCESS_STATIC    'static)
+       (ffi:SDL_TEXTUREACCESS_STREAMING 'streaming)
+       (ffi:SDL_TEXTUREACCESS_TARGET    'target))
+     (bytevector-uint-ref bv (* 2 (sizeof int)) (native-endianness) (sizeof int))
+     (bytevector-uint-ref bv (* 3 (sizeof int)) (native-endianness) (sizeof int)))))
+
 (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))