source: project/wiki/Wrapping simple c structs @ 36372

Last change on this file since 36372 was 33298, checked in by John Foerch, 4 years ago

Wrapping simple structs: add a finalizer in foreigners example

  • Property svnwiki:tags set to foreign define-foreign-type
File size: 2.0 KB
Line 
1Here's a little example wrapping c structs in a scheme blob. Since they might be moved around by garbage collection, you cannot store pointers to them, but for simple structs it should suffice.
2
3<enscript highlight=scheme>
4(use lolevel)
5
6(foreign-declare "#include <SDL/SDL.h>")
7
8;; SDL_Rect is defined thusly:
9;
10;typedef struct{
11;  Sint16 x, y;
12;  Uint16 w, h;
13;} SDL_Rect;
14
15(define sizeof-SDL_Rect (foreign-value "sizeof(SDL_Rect)" int))
16
17(define-record sdl-rect buffer)
18
19(define-foreign-type sdl-rect scheme-pointer sdl-rect-buffer)
20
21(define sdl-rect-x
22  (foreign-lambda* short ((sdl-rect rect))
23    "C_return(((SDL_Rect*)rect)->x);"))
24
25(define sdl-rect-x-set!
26  (foreign-lambda* void ((sdl-rect rect) (short value))
27    "((SDL_Rect*)rect)->x = value;"))
28
29;; behold
30
31(define foo (make-sdl-rect (make-blob sizeof-SDL_Rect)))
32(sdl-rect-x-set! foo 30)
33(sdl-rect-x foo) ==> 30
34
35</enscript>
36
37
38; Using Foreigners
39
40Here is another way to wrap the same struct, this time using define-foreign-record-type from foreigners.
41
42<enscript highlight="scheme">
43(use foreigners lolevel)
44
45(foreign-declare "#include <SDL/SDL.h>")
46
47(define-foreign-record-type (sdl-rect SDL_Rect)
48  (short x sdl-rect-x sdl-rect-x-set!)
49  (short y sdl-rect-y sdl-rect-y-set!)
50  (unsigned-short w sdl-rect-w sdl-rect-w-set!)
51  (unsigned-short h sdl-rect-h sdl-rect-h-set!))
52
53(define (make-sdl-rect x y w h)
54  (let ((r ((foreign-lambda* sdl-rect
55                ((short x) (short y) (unsigned-short w) (unsigned-short h))
56              "SDL_Rect* r = (SDL_Rect*)malloc(sizeof(SDL_Rect));"
57              "r->x = x;"
58              "r->y = y;"
59              "r->w = w;"
60              "r->h = h;"
61              "C_return(r);")
62            x y w h)))
63    (set-finalizer! r free)
64    r))
65
66(define a (make-sdl-rect 10 20 30 40))
67
68(print a ": " (sdl-rect-x a) " " (sdl-rect-y a) " "
69       (sdl-rect-w a) " " (sdl-rect-h a) " ")
70
71(sdl-rect-x-set! a 5)
72(sdl-rect-y-set! a 10)
73(sdl-rect-w-set! a 15)
74(sdl-rect-h-set! a 20)
75
76(print a ": " (sdl-rect-x a) " " (sdl-rect-y a) " "
77       (sdl-rect-w a) " " (sdl-rect-h a) " ")
78</enscript>
Note: See TracBrowser for help on using the repository browser.