summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--doc/api.texi23
-rw-r--r--sdl2/bindings.scm13
-rw-r--r--sdl2/render.scm41
3 files changed, 77 insertions, 0 deletions
diff --git a/doc/api.texi b/doc/api.texi
index 44d6506..53a3e09 100644
--- a/doc/api.texi
+++ b/doc/api.texi
@@ -1098,6 +1098,29 @@ Fill @var{rectangle} onto @var{renderer}.
Fill the list @var{rectangles} onto @var{renderer}.
@end deffn
+@deffn {Procedure} set-render-target! renderer texture
+Sets the render target for @var{renderer} to @var{texture}, making all
+comming draw requests redirect to @var{texture}.
+
+Pass @code{#f} to reset it to the default target.
+@end deffn
+
+@deffn {Procedure} get-render-target renderer
+Returns the current render target of @var{renderer} or @code{#f} if
+it's a texture.
+@end deffn
+
+@deffn {Procedure} make-texture format access width height
+Returns a new texture for @var{renderer} with pixel @var{format}.
+@var{access} is one of the symbols:
+
+@itemize
+@item static, changes rarely, not lockable
+@item streaming, changes frequently, lockable
+@item target, can be used as a render target
+requires that renderer was created with the @code{texture} flag.
+@end itemize
+@end deffn
@deffn {Procedure} surface->texture renderer surface
Convert @var{surface} to a texture suitable for @var{renderer}.
diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm
index ae7f0d0..2ebc2ed 100644
--- a/sdl2/bindings.scm
+++ b/sdl2/bindings.scm
@@ -240,6 +240,19 @@ RETURN-TYPE and accept arguments of ARG-TYPES."
(define-foreign sdl-render-copy-ex
int "SDL_RenderCopyEx" (list '* '* '* '* double '* int))
+(define-public SDL_TEXTUREACCESS_STATIC 0)
+(define-public SDL_TEXTUREACCESS_STREAMING 1)
+(define-public SDL_TEXTUREACCESS_TARGET 2)
+
+(define-foreign sdl-create-texture
+ '* "SDL_CreateTexture" (list '* uint32 int int int))
+
+(define-foreign sdl-set-render-target
+ int "SDL_SetRenderTarget" '(* *))
+
+(define-foreign sdl-get-render-target
+ '* "SDL_GetRenderTarget" '(*))
+
(define-foreign sdl-create-texture-from-surface
'* "SDL_CreateTextureFromSurface" '(* *))
diff --git a/sdl2/render.scm b/sdl2/render.scm
index 6504ce9..57a0e17 100644
--- a/sdl2/render.scm
+++ b/sdl2/render.scm
@@ -38,6 +38,8 @@
clear-renderer
present-renderer
render-copy
+ set-render-target!
+ get-render-target
set-render-draw-color
render-draw-line
render-draw-lines
@@ -48,6 +50,7 @@
render-fill-rect
render-fill-rects
+ make-texture
delete-texture!
surface->texture))
@@ -203,6 +206,25 @@ color."
(format port "#<texture ~x>"
(pointer-address (unwrap-texture context)))))
+(define (make-texture renderer format access width height)
+ "Returns a new texture for RENDERER with pixel FORMAT.
+ACCESS is one of the symbols:
+
+* static: changes rarely, not lockable
+* streaming: changes frequently, lockable
+* target: can be used as a render target (requires that renderer was
+created with 'texture')"
+ (let ((ptr (ffi:sdl-create-texture (unwrap-renderer renderer)
+ ((@@ (sdl2 surface) symbol->sdl-pixel-format) format)
+ (match access
+ ('static ffi:SDL_TEXTUREACCESS_STATIC)
+ ('streaming ffi:SDL_TEXTUREACCESS_STREAMING)
+ ('target ffi:SDL_TEXTUREACCESS_TARGET))
+ width height)))
+ (if (null-pointer? ptr)
+ (sdl-error "make-texture" "Failed to create texture")
+ (wrap-texture ptr))))
+
(define (surface->texture renderer surface)
"Convert SURFACE to a texture suitable for RENDERER."
(let ((ptr (ffi:sdl-create-texture-from-surface
@@ -235,3 +257,22 @@ color."
0)))
(unless (zero? result)
(sdl-error "render-copy" "failed to copy texture"))))
+
+(define (set-render-target! renderer texture)
+ "Sets the render target for RENDERER to TEXTURE, making all comming draw
+requests redirect to TEXTURE.
+
+Pass #f to reset it to the default target."
+ (let ((result (ffi:sdl-set-render-target
+ (unwrap-renderer renderer)
+ (if texture
+ (unwrap-texture texture)
+ %null-pointer))))
+ (unless (zero? result)
+ (sdl-error "set-render-target!" "failed to set render target"))))
+
+(define (get-render-target renderer)
+ "Returns the current render target of RENDERER. #f if it's a texture."
+ (let ((ptr (ffi:sdl-get-render-target (unwrap-renderer renderer))))
+ (if (null-pointer? ptr)
+ #f (wrap-texture ptr))))