diff options
author | David Thompson <dthompson2@worcester.edu> | 2019-01-07 22:51:58 -0500 |
---|---|---|
committer | David Thompson <dthompson2@worcester.edu> | 2019-01-07 22:51:58 -0500 |
commit | 74448f9ac2ef9f8eb2e68639da7c966f4eb2d6e2 (patch) | |
tree | 95b32b0dcd48ecc5dcef49ec26ef25699e117b2c /sdl2 | |
parent | ecc007fd0a576a96382fd12a507138121e377ad6 (diff) |
Add rect module.
* sdl2/rect.scm: New file.
* Makefile.am (SOURCES): Add it.
Diffstat (limited to 'sdl2')
-rw-r--r-- | sdl2/rect.scm | 58 |
1 files changed, 58 insertions, 0 deletions
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 <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 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 <rect> + (%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)) |