diff options
| -rw-r--r-- | doc/api.texi | 23 | ||||
| -rw-r--r-- | sdl2/bindings.scm | 13 | ||||
| -rw-r--r-- | sdl2/render.scm | 41 |
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)))) |