Changeset 27311 in project


Ignore:
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:
1 added
2 edited

Legend:

Unmodified
Added
Removed
  • release/4/sdl/trunk/sdl.scm

    r27310 r27311  
    696696                   (cdr e)))))
    697697
    698 (define-syntax pointer-to-record-lambda
    699   (ir-macro-transformer
    700    (lambda (e i c)
    701      (let ((record-name (cadr e)))
    702        `(lambda (pointer)
    703           (and pointer
    704                (,(i (string->symbol
    705                      (string-append "make-"(symbol->string (i record-name))))) pointer)))))))
    706 
     698(define-record sdl-version pointer)
     699(define-record sdl-rect buffer)
     700(define-record sdl-pixel-format pointer)
     701(define-record sdl-surface pointer)
     702(define-record sdl-video-info pointer)
     703(define-record sdl-event buffer)
     704(define-record sdl-color buffer)
     705(define-record sdl-joystick pointer)
     706
     707(include "sdl-foreign-types-include.scm")
    707708(include "keysym.scm")
    708709
     
    840841;---------------------------------------------------------------------------
    841842
    842 (define-record sdl-version pointer)
    843 
    844843(define-record-printer (sdl-version o out)
    845844  (for-each (lambda (x) (display x out))
     
    849848                  (sdl-version-patch o)
    850849                  ">")))
    851 
    852 (define-foreign-type SDL_version (c-pointer "SDL_version")
    853   sdl-version-pointer
    854   (pointer-to-record-lambda sdl-version))
    855850
    856851(define sdl-version-major
     
    888883(define-foreign-variable sizeof-sdl-rect int "sizeof(SDL_Rect)")
    889884
    890 (define-record sdl-rect buffer)
    891 
    892885(let ((maker make-sdl-rect))
    893886  (set! make-sdl-rect
     
    908901                  (sdl-rect-h s)">")))
    909902
    910 (define (-sdl-unbox-rect e)
    911   (let ((p (##sys#make-pointer)))
    912     (if e (##core#inline "C_pointer_to_block" p (sdl-rect-buffer e)))
    913     p))
    914 
    915 (define-foreign-type SDL_Rect (c-pointer "SDL_Rect")
    916   -sdl-unbox-rect)
    917 
    918903(define sdl-rect-x (foreign-lambda* short ((SDL_Rect c)) "C_return(c->x);"))
    919904(define sdl-rect-y (foreign-lambda* short ((SDL_Rect c)) "C_return(c->y);"))
     
    928913;---------------------------------------------------------------------------
    929914
    930 (define-record sdl-pixel-format pointer)
    931 
    932915(define-record-printer (sdl-pixel-format p out)
    933916  (for-each (lambda (x) (display x out))
    934917            (list "#<sdl-pixel-format "(sdl-pixel-format-pointer p)">")))
    935 
    936 (define-foreign-type SDL_PixelFormat (c-pointer "SDL_PixelFormat")
    937   sdl-pixel-format-pointer
    938   (pointer-to-record-lambda sdl-pixel-format))
    939918
    940919(define sdl-pixel-format-bytes-per-pixel
     
    957936;---------------------------------------------------------------------------
    958937
    959 (define-record sdl-surface pointer)
    960 
    961938(define-record-printer (sdl-surface s out)
    962939  (for-each (lambda (x) (display x out))
    963940            (list "#<sdl-surface "(sdl-surface-pointer s)">")))
    964 
    965 (define-foreign-type SDL_Surface (c-pointer "SDL_Surface")
    966   sdl-surface-pointer
    967   (lambda (p) (set-finalizer!
    968                ((pointer-to-record-lambda sdl-surface) p)
    969                sdl-free-surface)))
    970941
    971942(define (sdl-surface-flags s)
     
    1002973;; SDL_VideoInfo
    1003974;;
    1004 
    1005 (define-record sdl-video-info pointer)
    1006975
    1007976(define-record-printer (sdl-video-info o out)
     
    1022991                  (sdl-video-info-current-h o)
    1023992                  ">")))
    1024 
    1025 (define-foreign-type SDL_VideoInfo (c-pointer "SDL_VideoInfo")
    1026   sdl-video-info-pointer
    1027   (pointer-to-record-lambda sdl-video-info))
    1028993
    1029994(define sdl-video-info-hw-available
     
    11881153(define-foreign-variable sizeof-sdl-event int "sizeof(SDL_Event)")
    11891154
    1190 (define-record sdl-event buffer)
    1191 
    11921155(let ((maker make-sdl-event))
    11931156  (set! make-sdl-event
     
    12001163  (for-each (lambda (x) (display x out))
    12011164            (list "#<sdl-event "(sdl-event-type s)">")))
    1202 
    1203 (define (-sdl-unbox-event e)
    1204   (let ((p (##sys#make-pointer)))
    1205     (##core#inline "C_pointer_to_block" p (sdl-event-buffer e))
    1206     p))
    1207 
    1208 (define-foreign-type SDL_Event (c-pointer "SDL_Event")
    1209   -sdl-unbox-event)
    12101165
    12111166(define sdl-event-type (foreign-lambda* unsigned-byte ((SDL_Event e)) "C_return(e->type);"))
     
    14591414(define-foreign-variable sizeof-sdl-color int "sizeof(SDL_Color)")
    14601415
    1461 (define-record sdl-color buffer)
    1462 
    14631416(let ((maker make-sdl-color))
    14641417  (set! make-sdl-color
     
    14741427                  (sdl-color-b s)">")))
    14751428
    1476 (define (-sdl-unbox-color e)
    1477   (let ((p (##sys#make-pointer)))
    1478     (##core#inline "C_pointer_to_block" p (sdl-color-buffer e))
    1479     p))
    1480 
    1481 (define-foreign-type SDL_Color (c-pointer "SDL_Color")
    1482   -sdl-unbox-color)
    1483 
    14841429(define (fill-sdl-color! c r g b)
    14851430  ((foreign-lambda* void ((SDL_Color c) (unsigned-byte r) (unsigned-byte g) (unsigned-byte b))
     
    14931438
    14941439;---------------------------------------------------------------------------
    1495 (define-record sdl-joystick pointer)
    1496 
    14971440(define-record-printer (sdl-joystick p out)
    14981441  (for-each (lambda (x) (display x out))
    14991442            (list "#<sdl-joystick "(sdl-joystick-pointer p)">")))
    1500 
    1501 (define-foreign-type SDL_Joystick (c-pointer "SDL_Joystick")
    1502   sdl-joystick-pointer
    1503   (pointer-to-record-lambda sdl-joystick))
    15041443
    15051444(define sdl-joystick-event-state (foreign-lambda int "SDL_JoystickEventState"
  • release/4/sdl/trunk/sdl.setup

    r27100 r27311  
    4141                           (with-input-from-pipe "sdl-config --libs" read-line))))
    4242       (types? (version>=? (chicken-version) "4.7.4"))
    43        (files (append '("sdl.so" "sdl.import.so")
     43       (files (append '("sdl.so"
     44                        "sdl.import.so"
     45                        "sdl-foreign-types-include.scm")
    4446                      (if types? '("sdl.types") '()))))
    4547  (compile ,@(if types? '(-emit-type-file sdl.types) '())
Note: See TracChangeset for help on using the changeset viewer.