From 74448f9ac2ef9f8eb2e68639da7c966f4eb2d6e2 Mon Sep 17 00:00:00 2001 From: David Thompson Date: Mon, 7 Jan 2019 22:51:58 -0500 Subject: Add rect module. * sdl2/rect.scm: New file. * Makefile.am (SOURCES): Add it. --- sdl2/rect.scm | 58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 58 insertions(+) create mode 100644 sdl2/rect.scm (limited to 'sdl2') diff --git a/sdl2/rect.scm b/sdl2/rect.scm new file mode 100644 index 0000000..8b71622 --- /dev/null +++ b/sdl2/rect.scm @@ -0,0 +1,58 @@ +;;; guile-sdl2 --- FFI bindings for SDL2 +;;; Copyright © 2018 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 rect) + #:use-module (rnrs bytevectors) + #:use-module ((sdl2 bindings) #:prefix ffi:) + #:use-module (srfi srfi-9) + #:use-module (system foreign) + #:export (make-rect + rect? + rect-x + rect-y + rect-width + rect-height)) + +(define-record-type + (%make-rect bv ptr) + rect? + (bv rect-bv) + (ptr unwrap-rect)) + +(define (make-rect x y width height) + (let ((bv (s32vector x y width height))) + (%make-rect bv (bytevector->pointer bv)))) + +(define (rect-x rect) + (s32vector-ref (rect-bv rect) 0)) + +(define (rect-y rect) + (s32vector-ref (rect-bv rect) 1)) + +(define (rect-width rect) + (s32vector-ref (rect-bv rect) 2)) + +(define (rect-height rect) + (s32vector-ref (rect-bv rect) 3)) -- cgit v1.2.3