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.

1 files changed, 45 insertions, 1 deletions

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))))