source: project/release/4/sdl/trunk/sdl-foreign-types-include.scm @ 27311

Last change on this file since 27311 was 27311, checked in by megane, 9 years ago

sdl: moved foreign types to sdl-foreign-types-include.scm

File size: 1.6 KB
Line 
1(define-syntax pointer-to-record-lambda
2  (ir-macro-transformer
3   (lambda (e i c)
4     (let ((record-name (cadr e)))
5       `(lambda (pointer)
6          (and pointer
7               (,(i (string->symbol
8                     (string-append "make-"(symbol->string (i record-name))))) pointer)))))))
9
10(define-foreign-type SDL_version (c-pointer "SDL_version")
11  sdl-version-pointer
12  (pointer-to-record-lambda sdl-version))
13
14(define (-sdl-unbox-rect e)
15  (let ((p (##sys#make-pointer)))
16    (if e (##core#inline "C_pointer_to_block" p (sdl-rect-buffer e)))
17    p))
18
19(define-foreign-type SDL_Rect (c-pointer "SDL_Rect")
20  -sdl-unbox-rect)
21
22(define-foreign-type SDL_PixelFormat (c-pointer "SDL_PixelFormat")
23  sdl-pixel-format-pointer
24  (pointer-to-record-lambda sdl-pixel-format))
25
26(define-foreign-type SDL_Surface (c-pointer "SDL_Surface")
27  sdl-surface-pointer
28  (lambda (p) (set-finalizer!
29               ((pointer-to-record-lambda sdl-surface) p)
30               sdl-free-surface)))
31
32(define (-sdl-unbox-color e)
33  (let ((p (##sys#make-pointer)))
34    (##core#inline "C_pointer_to_block" p (sdl-color-buffer e))
35    p))
36
37(define-foreign-type SDL_Color (c-pointer "SDL_Color")
38  -sdl-unbox-color)
39
40(define (-sdl-unbox-event e)
41  (let ((p (##sys#make-pointer)))
42    (##core#inline "C_pointer_to_block" p (sdl-event-buffer e))
43    p))
44
45(define-foreign-type SDL_Event (c-pointer "SDL_Event")
46  -sdl-unbox-event)
47
48(define-foreign-type SDL_Joystick (c-pointer "SDL_Joystick")
49  sdl-joystick-pointer
50  (pointer-to-record-lambda sdl-joystick))
51
52(define-foreign-type SDL_VideoInfo (c-pointer "SDL_VideoInfo")
53  sdl-video-info-pointer
54  (pointer-to-record-lambda sdl-video-info))
Note: See TracBrowser for help on using the repository browser.