Changeset 20640 in project

Timestamp:

10/04/10 10:20:08 (10 years ago)

Author:

felix winkelmann

Message:

squares fixes and bind version

Location:

demonstrations/foreign-functions

Files:

• squares-bind.scm (added)
• squares-plain.scm (modified) (3 diffs)

demonstrations/foreign-functions/squares-plain.scm

@@ -1 @@
-;;;; squares.scm - draw random squares
-
-
-(use foreigners)
+;;;; squares-plain.scm - draw random squares
 
 
@@ -27 +24 @@
 ;;; Foreign record types
 
-(define-foreign-record-type (sdl-rect SDL_Rect)
-  (constructor: make-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-foreign-type sdl-rect (c-pointer "SDL_Rect"))
 
-(define-foreign-record-type (sdl-surface SDL_Surface)
-  ((c-pointer "SDL_PixelFormat") format sdl-surface-format))
+(define make-sdl-rect
+  (foreign-lambda* sdl-rect () 
+    "C_return((SDL_Rect *)malloc(sizeof(SDL_Rect)));"))
 
-(define-foreign-record-type (sdl-event SDL_Event)
-  (constructor: make-sdl-event)
-  (int type sdl-event-type))
+(define sdl-rect-x
+  (foreign-lambda* short ((sdl-rect r)) "C_return(r->x);"))
+
+(define sdl-rect-y
+  (foreign-lambda* short ((sdl-rect r)) "C_return(r->y);"))
+
+(define sdl-rect-x-set!
+  (foreign-lambda* void ((sdl-rect r) (short n)) "r->x = n;"))
+
+(define sdl-rect-y-set!
+  (foreign-lambda* void ((sdl-rect r) (short n)) "r->y = n;"))
+
+(define sdl-rect-w
+  (foreign-lambda* unsigned-short ((sdl-rect r)) "C_return(r->w);"))
+
+(define sdl-rect-h
+  (foreign-lambda* unsigned-short ((sdl-rect r)) "C_return(r->w);"))
+
+(define sdl-rect-w-set!
+  (foreign-lambda* void ((sdl-rect r) (unsigned-short n)) "r->w = n;"))
+
+(define sdl-rect-h-set!
+  (foreign-lambda* void ((sdl-rect r) (unsigned-short n)) "r->h = n;"))
+
+(define-foreign-type sdl-surface (c-pointer "SDL_Surface"))
+(define-foreign-type sdl-pixel-format (c-pointer "SDL_PixelFormat"))
+
+(define sdl-surface-format
+  (foreign-lambda* sdl-pixel-format ((sdl-surface s)) "C_return(s->format);"))
+
+(define-foreign-type sdl-event (c-pointer "SDL_Event"))
+
+(define make-sdl-event
+  (foreign-lambda* sdl-event () 
+    "C_return((SDL_Event *)malloc(sizeof(SDL_Event)));"))
+
+(define sdl-event-type
+  (foreign-lambda* int ((sdl-event e)) "C_return(e->type);"))
 
 
@@ -48 +76 @@
 
 (define SDL_SetVideoMode
-  (foreign-lambda sdl-screen "SDL_SetVideoMode" int int int unsigned-int32))
+  (foreign-lambda sdl-surface "SDL_SetVideoMode" int int int unsigned-int32))
 
 (define SDL_FillRect