Wrapping simple c structs - The CHICKEN Scheme wiki

Here'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.

(import (chicken foreign))

(foreign-declare "#include <SDL/SDL.h>")

;; SDL_Rect is defined thusly:
;
;typedef struct{
;  Sint16 x, y;
;  Uint16 w, h;
;} SDL_Rect;

(define sizeof-SDL_Rect (foreign-value "sizeof(SDL_Rect)" int))

(define-record sdl-rect buffer)

(define-foreign-type sdl-rect scheme-pointer sdl-rect-buffer)

(define sdl-rect-x
  (foreign-lambda* short ((sdl-rect rect))
    "C_return(((SDL_Rect*)rect)->x);"))

(define sdl-rect-x-set!
  (foreign-lambda* void ((sdl-rect rect) (short value))
    "((SDL_Rect*)rect)->x = value;"))

;; behold

(define foo (make-sdl-rect (make-blob sizeof-SDL_Rect)))
(sdl-rect-x-set! foo 30)
(sdl-rect-x foo) ==> 30

Using Foreigners

Here is another way to wrap the same struct, this time using define-foreign-record-type from foreigners.

(import foreigners (chicken base) (chicken gc) (chicken foreign))

(foreign-declare "#include <SDL/SDL.h>")

(define-foreign-record-type (sdl-rect SDL_Rect)
  (short x sdl-rect-x sdl-rect-x-set!)
  (short y sdl-rect-y sdl-rect-y-set!)
  (unsigned-short w sdl-rect-w sdl-rect-w-set!)
  (unsigned-short h sdl-rect-h sdl-rect-h-set!))

(define (make-sdl-rect x y w h)
  (let ((r ((foreign-lambda* sdl-rect
                ((short x) (short y) (unsigned-short w) (unsigned-short h))
              "SDL_Rect* r = (SDL_Rect*)malloc(sizeof(SDL_Rect));"
              "r->x = x;"
              "r->y = y;"
              "r->w = w;"
              "r->h = h;"
              "C_return(r);")
            x y w h)))
    (set-finalizer! r free)
    r))

(define a (make-sdl-rect 10 20 30 40))

(print a ": " (sdl-rect-x a) " " (sdl-rect-y a) " "
       (sdl-rect-w a) " " (sdl-rect-h a) " ")

(sdl-rect-x-set! a 5)
(sdl-rect-y-set! a 10)
(sdl-rect-w-set! a 15)
(sdl-rect-h-set! a 20)

(print a ": " (sdl-rect-x a) " " (sdl-rect-y a) " "
       (sdl-rect-w a) " " (sdl-rect-h a) " ")