Changeset 27311 in project

Timestamp:

08/27/12 16:04:03 (9 years ago)

Author:

megane

Message:

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

Location:

release/4/sdl/trunk

Files:

• sdl-foreign-types-include.scm (added)
• sdl.scm (modified) (14 diffs)
• sdl.setup (modified) (1 diff)

release/4/sdl/trunk/sdl.scm

@@ -696 +696 @@
                    (cdr e)))))
 
-(define-syntax pointer-to-record-lambda
-  (ir-macro-transformer
-   (lambda (e i c)
-     (let ((record-name (cadr e)))
-       `(lambda (pointer)
-          (and pointer
-               (,(i (string->symbol
-                     (string-append "make-"(symbol->string (i record-name))))) pointer)))))))
-
+(define-record sdl-version pointer)
+(define-record sdl-rect buffer)
+(define-record sdl-pixel-format pointer)
+(define-record sdl-surface pointer)
+(define-record sdl-video-info pointer)
+(define-record sdl-event buffer)
+(define-record sdl-color buffer)
+(define-record sdl-joystick pointer)
+
+(include "sdl-foreign-types-include.scm")
 (include "keysym.scm")
 
@@ -840 +841 @@
 ;---------------------------------------------------------------------------
 
-(define-record sdl-version pointer)
-
 (define-record-printer (sdl-version o out)
   (for-each (lambda (x) (display x out))
@@ -849 +848 @@
                   (sdl-version-patch o) 
                   ">")))
-
-(define-foreign-type SDL_version (c-pointer "SDL_version")
-  sdl-version-pointer
-  (pointer-to-record-lambda sdl-version))
 
 (define sdl-version-major
@@ -888 +883 @@
 (define-foreign-variable sizeof-sdl-rect int "sizeof(SDL_Rect)")
 
-(define-record sdl-rect buffer)
-
 (let ((maker make-sdl-rect))
   (set! make-sdl-rect
@@ -908 +901 @@
                   (sdl-rect-h s)">")))
 
-(define (-sdl-unbox-rect e)
-  (let ((p (##sys#make-pointer)))
-    (if e (##core#inline "C_pointer_to_block" p (sdl-rect-buffer e)))
-    p))
-
-(define-foreign-type SDL_Rect (c-pointer "SDL_Rect")
-  -sdl-unbox-rect)
-
 (define sdl-rect-x (foreign-lambda* short ((SDL_Rect c)) "C_return(c->x);"))
 (define sdl-rect-y (foreign-lambda* short ((SDL_Rect c)) "C_return(c->y);"))
@@ -928 +913 @@
 ;---------------------------------------------------------------------------
 
-(define-record sdl-pixel-format pointer)
-
 (define-record-printer (sdl-pixel-format p out)
   (for-each (lambda (x) (display x out))
             (list "#<sdl-pixel-format "(sdl-pixel-format-pointer p)">")))
-
-(define-foreign-type SDL_PixelFormat (c-pointer "SDL_PixelFormat")
-  sdl-pixel-format-pointer
-  (pointer-to-record-lambda sdl-pixel-format))
 
 (define sdl-pixel-format-bytes-per-pixel
@@ -957 +936 @@
 ;---------------------------------------------------------------------------
 
-(define-record sdl-surface pointer)
-
 (define-record-printer (sdl-surface s out)
   (for-each (lambda (x) (display x out))
             (list "#<sdl-surface "(sdl-surface-pointer s)">")))
-
-(define-foreign-type SDL_Surface (c-pointer "SDL_Surface")
-  sdl-surface-pointer
-  (lambda (p) (set-finalizer!
-               ((pointer-to-record-lambda sdl-surface) p)
-               sdl-free-surface)))
 
 (define (sdl-surface-flags s)
@@ -1002 +973 @@
 ;; SDL_VideoInfo
 ;;
-
-(define-record sdl-video-info pointer)
 
 (define-record-printer (sdl-video-info o out)
@@ -1022 +991 @@
                   (sdl-video-info-current-h o)
                   ">")))
-
-(define-foreign-type SDL_VideoInfo (c-pointer "SDL_VideoInfo")
-  sdl-video-info-pointer
-  (pointer-to-record-lambda sdl-video-info))
 
 (define sdl-video-info-hw-available
@@ -1188 +1153 @@
 (define-foreign-variable sizeof-sdl-event int "sizeof(SDL_Event)")
 
-(define-record sdl-event buffer)
-
 (let ((maker make-sdl-event))
   (set! make-sdl-event
@@ -1200 +1163 @@
   (for-each (lambda (x) (display x out))
             (list "#<sdl-event "(sdl-event-type s)">")))
-
-(define (-sdl-unbox-event e)
-  (let ((p (##sys#make-pointer)))
-    (##core#inline "C_pointer_to_block" p (sdl-event-buffer e))
-    p))
-
-(define-foreign-type SDL_Event (c-pointer "SDL_Event")
-  -sdl-unbox-event)
 
 (define sdl-event-type (foreign-lambda* unsigned-byte ((SDL_Event e)) "C_return(e->type);"))
@@ -1459 +1414 @@
 (define-foreign-variable sizeof-sdl-color int "sizeof(SDL_Color)")
 
-(define-record sdl-color buffer)
-
 (let ((maker make-sdl-color))
   (set! make-sdl-color
@@ -1474 +1427 @@
                   (sdl-color-b s)">")))
 
-(define (-sdl-unbox-color e)
-  (let ((p (##sys#make-pointer)))
-    (##core#inline "C_pointer_to_block" p (sdl-color-buffer e))
-    p))
-
-(define-foreign-type SDL_Color (c-pointer "SDL_Color")
-  -sdl-unbox-color)
-
 (define (fill-sdl-color! c r g b)
   ((foreign-lambda* void ((SDL_Color c) (unsigned-byte r) (unsigned-byte g) (unsigned-byte b))
@@ -1493 +1438 @@
 
 ;---------------------------------------------------------------------------
-(define-record sdl-joystick pointer)
-
 (define-record-printer (sdl-joystick p out)
   (for-each (lambda (x) (display x out))
             (list "#<sdl-joystick "(sdl-joystick-pointer p)">")))
-
-(define-foreign-type SDL_Joystick (c-pointer "SDL_Joystick")
-  sdl-joystick-pointer
-  (pointer-to-record-lambda sdl-joystick))
 
 (define sdl-joystick-event-state (foreign-lambda int "SDL_JoystickEventState"

release/4/sdl/trunk/sdl.setup

@@ -41 +41 @@
                            (with-input-from-pipe "sdl-config --libs" read-line))))
        (types? (version>=? (chicken-version) "4.7.4"))
-       (files (append '("sdl.so" "sdl.import.so")
+       (files (append '("sdl.so"
+                        "sdl.import.so"
+                        "sdl-foreign-types-include.scm")
                       (if types? '("sdl.types") '()))))
   (compile ,@(if types? '(-emit-type-file sdl.types) '())