From 8a3a26bb77c61784dc426d4cc3dd66a8071b5e49 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Sun, 13 Dec 2015 22:51:33 -0500 Subject: Add a few surface bindings. * sdl2/bindings.scm (sdl-rw-from-file, sdl-free-surface, sdl-load-bmp-rw): New procedures. * sdl2/surface.scm: New file. * Makefile.am (SOURCES): Add it. --- sdl2/bindings.scm | 19 ++++++++++++++++ sdl2/surface.scm | 66 +++++++++++++++++++++++++++++++++++++++++++++++++++++++ 2 files changed, 85 insertions(+) create mode 100644 sdl2/surface.scm (limited to 'sdl2') 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 +;;; +;;; 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 +;;; . + +;;; 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? + wrap-surface unwrap-surface + (lambda (context port) + (format port "#" + (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)))) -- cgit v1.2.3