diff options
| -rw-r--r-- | Makefile.am | 1 | ||||
| -rw-r--r-- | sdl2/bindings.scm | 19 | ||||
| -rw-r--r-- | sdl2/surface.scm | 66 |
3 files changed, 86 insertions, 0 deletions
diff --git a/Makefile.am b/Makefile.am index bb37cb4..543b734 100644 --- a/Makefile.am +++ b/Makefile.am @@ -44,6 +44,7 @@ SOURCES = \ sdl2.scm \ sdl2/config.scm \ sdl2/bindings.scm \ + sdl2/surface.scm \ sdl2/render.scm \ sdl2/video.scm diff --git a/sdl2/bindings.scm b/sdl2/bindings.scm index 8925e6f..64e4313 100644 --- a/sdl2/bindings.scm +++ b/sdl2/bindings.scm @@ -228,3 +228,22 @@ RETURN-TYPE and accept arguments of ARG-TYPES." (define-foreign sdl-get-ticks uint32 "SDL_GetTicks" '()) + + +;;; +;;; File I/O +;;; + +(define-foreign sdl-rw-from-file + '* "SDL_RWFromFile" (list '* '*)) + + +;;; +;;; Surface +;;; + +(define-foreign sdl-free-surface + void "SDL_FreeSurface" '(*)) + +(define-foreign sdl-load-bmp-rw + '* "SDL_LoadBMP_RW" (list '* int)) diff --git a/sdl2/surface.scm b/sdl2/surface.scm new file mode 100644 index 0000000..b0a018b --- /dev/null +++ b/sdl2/surface.scm @@ -0,0 +1,66 @@ +;;; guile-sdl2 --- FFI bindings for SDL2 +;;; Copyright © 2015 David Thompson <davet@gnu.org> +;;; +;;; This file is part of guile-sdl2. +;;; +;;; Guile-sdl2 is free software; you can redistribute it and/or modify +;;; it under the terms of the GNU Lesser General Public License as +;;; published by the Free Software Foundation; either version 3 of the +;;; License, or (at your option) any later version. +;;; +;;; Guile-sdl2 is distributed in the hope that it will be useful, but +;;; WITHOUT ANY WARRANTY; without even the implied warranty of +;;; MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the GNU +;;; General Public License for more details. +;;; +;;; You should have received a copy of the GNU Lesser General Public +;;; License along with guile-sdl2. If not, see +;;; <http://www.gnu.org/licenses/>. + +;;; Commentary: +;; +;; SDL surface manipulation. +;; +;;; Code: + +(define-module (sdl2 surface) + #:use-module (ice-9 format) + #:use-module (ice-9 match) + #:use-module (system foreign) + #:use-module ((sdl2 bindings) #:prefix ffi:) + #:use-module (sdl2) + #:export (surface? + delete-surface! + call-with-surface + load-bmp)) + +(define-wrapped-pointer-type <surface> + surface? + wrap-surface unwrap-surface + (lambda (context port) + (format port "#<surface ~x>" + (pointer-address (unwrap-surface context))))) + +(define (delete-surface! surface) + "Free the memory used by SURFACE." + (ffi:sdl-free-surface (unwrap-surface surface))) + +(define (call-with-surface surface proc) + "Call PROC, passing it SURFACE and deleting SURFACE upon exit of +PROC." + (dynamic-wind + (const #t) + (lambda () + (proc surface)) + (lambda () + (delete-surface! surface)))) + +;; The equivalent of the SDL_LoadBMP C macro. +(define (load-bmp file) + "Create a new surface from the bitmap data in FILE." + (let ((ptr (ffi:sdl-load-bmp-rw (ffi:sdl-rw-from-file (string->pointer file) + (string->pointer "rb")) + 1))) + (if (null-pointer? ptr) + (sdl-error "load-bmp" "failed to load bitmap") + (wrap-surface ptr)))) |