From db3dea0c6ab3a2a8407035b44a1aaa4e8cdbdd86 Mon Sep 17 00:00:00 2001
From: David Thompson <dthompson2@worcester.edu>
Date: Sun, 20 Dec 2015 16:03:03 -0500
Subject: surface: Add useful selectors.

* sdl2/surface.scm (pointer-int-ref, surface-width, surface-height)
(surface-pitch, surface-pixels): New procedures.
(%int-size, %pointer-size, %width-offset, %height-offset, %pitch-offset)
(%pixels-offset): New variables.
---
 sdl2/surface.scm | 46 +++++++++++++++++++++++++++++++++++++++++++++-
 1 file changed, 45 insertions(+), 1 deletion(-)

(limited to 'sdl2')

diff --git a/sdl2/surface.scm b/sdl2/surface.scm
index dee9781..1537c58 100644
--- a/sdl2/surface.scm
+++ b/sdl2/surface.scm
@@ -26,13 +26,18 @@
 (define-module (sdl2 surface)
   #:use-module (ice-9 format)
   #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
   #:use-module (system foreign)
   #:use-module ((sdl2 bindings) #:prefix ffi:)
   #:use-module (sdl2)
   #:export (surface?
             delete-surface!
             call-with-surface
-            load-bmp))
+            load-bmp
+            surface-width
+            surface-height
+            surface-pitch
+            surface-pixels))
 
 (define-wrapped-pointer-type <surface>
   surface?
@@ -64,3 +69,42 @@ PROC."
     (if (null-pointer? ptr)
         (sdl-error "load-bmp" "failed to load bitmap")
         (wrap-surface ptr))))
+
+(define %int-size (sizeof int))
+(define %pointer-size (sizeof '*))
+
+(define (pointer-int-ref pointer offset)
+  (bytevector-sint-ref (pointer->bytevector pointer %int-size offset)
+                       0 (native-endianness) %int-size))
+
+;; The offsets below correspond to the SDL_Surface struct elements
+;; that come before the element in question.
+(define %width-offset (sizeof (list uint32 '*)))
+(define %height-offset (sizeof (list uint32 '* int)))
+(define %pitch-offset (sizeof (list uint32 '* int int)))
+(define %pixels-offset 32)
+
+(define (surface-width surface)
+  "Return the width of SURFACE in pixels."
+  (pointer-int-ref (unwrap-surface surface) %width-offset))
+
+(define (surface-height surface)
+  "Return the height of SURFACE in pixels."
+  (pointer-int-ref (unwrap-surface surface) %height-offset))
+
+(define (surface-pitch surface)
+  "Return the length of a row of pixels in SURFACE in bytes."
+  (pointer-int-ref (unwrap-surface surface) %pitch-offset))
+
+(define (surface-pixels surface)
+  "Return a bytevector containing the raw pixel data in SURFACE."
+  (let* ((ptr (unwrap-surface surface))
+         (height (pointer-int-ref ptr %height-offset))
+         (pitch (pointer-int-ref ptr %pitch-offset))
+         (pixels-ptr (pointer->bytevector ptr %pointer-size %pixels-offset))
+         (pixels (make-pointer
+                  (bytevector-uint-ref pixels-ptr
+                                       0
+                                       (native-endianness)
+                                       %pointer-size))))
+    (pointer->bytevector pixels (* height pitch))))
-- 
cgit v1.2.3