summaryrefslogtreecommitdiff
path: root/sdl2/surface.scm
blob: 98ddf700bffe6e18c3bc497bfcd75810aa284a6a (plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
;;; guile-sdl2 --- FFI bindings for SDL2
;;; Copyright © 2015 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 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
            surface-width
            surface-height
            surface-pitch
            surface-pixels

            convert-surface-format))

(define-wrapped-pointer-type <surface>
  surface?
  wrap-surface unwrap-surface
  (lambda (surface port)
    (format port "#<surface ~x>"
            (pointer-address (unwrap-surface surface)))))

(define (delete-surface! surface)
  "Free the memory used by SURFACE."
  (ffi:sdl-free-surface (unwrap-surface surface)))

(define (call-with-surface surface proc)
  "Call PROC, passing it SURFACE and deleting SURFACE upon exit of
PROC."
  (dynamic-wind
    (const #t)
    (lambda ()
      (proc surface))
    (lambda ()
      (delete-surface! surface))))

;; The equivalent of the SDL_LoadBMP C macro.
(define (load-bmp file)
  "Create a new surface from the bitmap data in FILE."
  (let ((ptr (ffi:sdl-load-bmp-rw (ffi:sdl-rw-from-file (string->pointer file)
                                                        (string->pointer "rb"))
                                  1)))
    (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))))

(define (symbol->sdl-pixel-format sym)
  (match sym
    ('index1lsb   ffi:SDL_PIXELFORMAT_INDEX1LSB)
    ('index1msb   ffi:SDL_PIXELFORMAT_INDEX1MSB)
    ('index4lsb   ffi:SDL_PIXELFORMAT_INDEX4LSB)
    ('index4msb   ffi:SDL_PIXELFORMAT_INDEX4MSB)
    ('index8      ffi:SDL_PIXELFORMAT_INDEX8)
    ('rgb332      ffi:SDL_PIXELFORMAT_RGB332)
    ('rgb444      ffi:SDL_PIXELFORMAT_RGB444)
    ('rgb555      ffi:SDL_PIXELFORMAT_RGB555)
    ('bgr555      ffi:SDL_PIXELFORMAT_BGR555)
    ('argb4444    ffi:SDL_PIXELFORMAT_ARGB4444)
    ('rgba4444    ffi:SDL_PIXELFORMAT_RGBA4444)
    ('abgr4444    ffi:SDL_PIXELFORMAT_ABGR4444)
    ('bgra4444    ffi:SDL_PIXELFORMAT_BGRA4444)
    ('argb1555    ffi:SDL_PIXELFORMAT_ARGB1555)
    ('rgba5551    ffi:SDL_PIXELFORMAT_RGBA5551)
    ('abgr1555    ffi:SDL_PIXELFORMAT_ABGR1555)
    ('bgra5551    ffi:SDL_PIXELFORMAT_BGRA5551)
    ('rgb565      ffi:SDL_PIXELFORMAT_RGB565)
    ('bgr565      ffi:SDL_PIXELFORMAT_BGR565)
    ('rgb24       ffi:SDL_PIXELFORMAT_RGB24)
    ('bgr24       ffi:SDL_PIXELFORMAT_BGR24)
    ('rgb888      ffi:SDL_PIXELFORMAT_RGB888)
    ('rgbx8888    ffi:SDL_PIXELFORMAT_RGBX8888)
    ('bgr888      ffi:SDL_PIXELFORMAT_BGR888)
    ('bgrx8888    ffi:SDL_PIXELFORMAT_BGRX8888)
    ('argb8888    ffi:SDL_PIXELFORMAT_ARGB8888)
    ('rgba8888    ffi:SDL_PIXELFORMAT_RGBA8888)
    ('abgr8888    ffi:SDL_PIXELFORMAT_ABGR8888)
    ('bgra8888    ffi:SDL_PIXELFORMAT_BGRA8888)
    ('argb2101010 ffi:SDL_PIXELFORMAT_ARGB2101010)
    ('yv12        ffi:SDL_PIXELFORMAT_YV12)
    ('iyuv        ffi:SDL_PIXELFORMAT_IYUV)
    ('yuy2        ffi:SDL_PIXELFORMAT_YUY2)
    ('uyvy        ffi:SDL_PIXELFORMAT_UYVY)
    ('yvyu        ffi:SDL_PIXELFORMAT_YVYU)))

(define (convert-surface-format surface format)
  "Convert the pixels in SURFACE to FORMAT, a symbol representing a
specific pixel format, and return a new surface object.

Valid format types are:

- index1lsb
- index1msb
- index4lsb
- index4msb
- index8
- rgb332
- rgb444
- rgb555
- bgr555
- argb4444
- rgba4444
- abgr4444
- bgra4444
- argb1555
- rgba5551
- abgr1555
- bgra5551
- rgb565
- bgr565
- rgb24
- bgr24
- rgb888
- rgbx8888
- bgr888
- bgrx8888
- argb8888
- rgba8888
- abgr8888
- bgra8888
- argb2101010
- yv12
- iyuv
- yuy2
- uyvy
- yvyu"
  (let ((ptr (ffi:sdl-convert-surface-format (unwrap-surface surface)
                                             (symbol->sdl-pixel-format format)
                                             0)))
    (if (null-pointer? ptr)
        (sdl-error "convert-surface-format" "failed to convert surface format")
        (wrap-surface surface))))