From 29228696345c2d19be81daebea4da5170f35694e Mon Sep 17 00:00:00 2001 From: David Thompson Date: Fri, 1 Jan 2016 11:06:29 -0500 Subject: surface: Fix SDL_Surface struct parsing. The code worked fine on Guile 2.0.11, but Guile master revealed how bad it was to use 'sizeof' to calculate byte offsets into structs due to the padding calculations it does. On Guile master, the offset for surface height and pitch were the same, and that lead to bad news when trying to use that incorrectly parsed data to inspect the pixel buffer. * sdl2/surface.scm (%width-offset, %height-offset, %pitch-offset) (%pixels-offset): Delete. (%surface-types): New variable. (surface-parse-match): New syntax. (surface-width, surface-height, surface-pitch, surface-pixels): Use new struct parsing method. * .dirlocals.el: Add new indenting rule. --- .dir-locals.el | 3 ++- sdl2/surface.scm | 41 ++++++++++++++++++++++------------------- 2 files changed, 24 insertions(+), 20 deletions(-) diff --git a/.dir-locals.el b/.dir-locals.el index ecadef4..6b4443d 100644 --- a/.dir-locals.el +++ b/.dir-locals.el @@ -1,4 +1,5 @@ ((scheme-mode . ((eval . (put 'call-with-window 'scheme-indent-function 1)) - (eval . (put 'call-with-renderer 'scheme-indent-function 1))))) + (eval . (put 'call-with-renderer 'scheme-indent-function 1)) + (eval . (put 'surface-parse-match 'scheme-indent-function 1))))) diff --git a/sdl2/surface.scm b/sdl2/surface.scm index 24846c2..4eb5212 100644 --- a/sdl2/surface.scm +++ b/sdl2/surface.scm @@ -79,37 +79,40 @@ PROC." (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) +;; A partial list of surface types so that we can parse the data we +;; need out of the SDL_Surface struct pointer. +(define %surface-types + (list uint32 ; flags + '* ; format + int ; width + int ; height + int ; pitch + '*)) ; pixels + +(define-syntax-rule (surface-parse-match surface matchers ...) + (match (parse-c-struct (unwrap-surface surface) %surface-types) + matchers ...)) (define (surface-width surface) "Return the width of SURFACE in pixels." - (pointer-int-ref (unwrap-surface surface) %width-offset)) + (surface-parse-match surface + ((_ _ width _ _ _) width))) (define (surface-height surface) "Return the height of SURFACE in pixels." - (pointer-int-ref (unwrap-surface surface) %height-offset)) + (surface-parse-match surface + ((_ _ _ height _ _) height))) (define (surface-pitch surface) "Return the length of a row of pixels in SURFACE in bytes." - (pointer-int-ref (unwrap-surface surface) %pitch-offset)) + (surface-parse-match surface + ((_ _ _ _ pitch _) pitch))) (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)))) + (surface-parse-match surface + ((_ _ _ height pitch pixels) + (pointer->bytevector pixels (* height pitch))))) (define (symbol->sdl-pixel-format sym) (match sym -- cgit v1.2.3