Changeset 27311 in project
- Timestamp:
- 08/27/12 16:04:03 (9 years ago)
- Location:
- release/4/sdl/trunk
- Files:
-
- 1 added
- 2 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/sdl/trunk/sdl.scm
r27310 r27311 696 696 (cdr e))))) 697 697 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") 707 708 (include "keysym.scm") 708 709 … … 840 841 ;--------------------------------------------------------------------------- 841 842 842 (define-record sdl-version pointer)843 844 843 (define-record-printer (sdl-version o out) 845 844 (for-each (lambda (x) (display x out)) … … 849 848 (sdl-version-patch o) 850 849 ">"))) 851 852 (define-foreign-type SDL_version (c-pointer "SDL_version")853 sdl-version-pointer854 (pointer-to-record-lambda sdl-version))855 850 856 851 (define sdl-version-major … … 888 883 (define-foreign-variable sizeof-sdl-rect int "sizeof(SDL_Rect)") 889 884 890 (define-record sdl-rect buffer)891 892 885 (let ((maker make-sdl-rect)) 893 886 (set! make-sdl-rect … … 908 901 (sdl-rect-h s)">"))) 909 902 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 918 903 (define sdl-rect-x (foreign-lambda* short ((SDL_Rect c)) "C_return(c->x);")) 919 904 (define sdl-rect-y (foreign-lambda* short ((SDL_Rect c)) "C_return(c->y);")) … … 928 913 ;--------------------------------------------------------------------------- 929 914 930 (define-record sdl-pixel-format pointer)931 932 915 (define-record-printer (sdl-pixel-format p out) 933 916 (for-each (lambda (x) (display x out)) 934 917 (list "#<sdl-pixel-format "(sdl-pixel-format-pointer p)">"))) 935 936 (define-foreign-type SDL_PixelFormat (c-pointer "SDL_PixelFormat")937 sdl-pixel-format-pointer938 (pointer-to-record-lambda sdl-pixel-format))939 918 940 919 (define sdl-pixel-format-bytes-per-pixel … … 957 936 ;--------------------------------------------------------------------------- 958 937 959 (define-record sdl-surface pointer)960 961 938 (define-record-printer (sdl-surface s out) 962 939 (for-each (lambda (x) (display x out)) 963 940 (list "#<sdl-surface "(sdl-surface-pointer s)">"))) 964 965 (define-foreign-type SDL_Surface (c-pointer "SDL_Surface")966 sdl-surface-pointer967 (lambda (p) (set-finalizer!968 ((pointer-to-record-lambda sdl-surface) p)969 sdl-free-surface)))970 941 971 942 (define (sdl-surface-flags s) … … 1002 973 ;; SDL_VideoInfo 1003 974 ;; 1004 1005 (define-record sdl-video-info pointer)1006 975 1007 976 (define-record-printer (sdl-video-info o out) … … 1022 991 (sdl-video-info-current-h o) 1023 992 ">"))) 1024 1025 (define-foreign-type SDL_VideoInfo (c-pointer "SDL_VideoInfo")1026 sdl-video-info-pointer1027 (pointer-to-record-lambda sdl-video-info))1028 993 1029 994 (define sdl-video-info-hw-available … … 1188 1153 (define-foreign-variable sizeof-sdl-event int "sizeof(SDL_Event)") 1189 1154 1190 (define-record sdl-event buffer)1191 1192 1155 (let ((maker make-sdl-event)) 1193 1156 (set! make-sdl-event … … 1200 1163 (for-each (lambda (x) (display x out)) 1201 1164 (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)1210 1165 1211 1166 (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)") 1460 1415 1461 (define-record sdl-color buffer)1462 1463 1416 (let ((maker make-sdl-color)) 1464 1417 (set! make-sdl-color … … 1474 1427 (sdl-color-b s)">"))) 1475 1428 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 1484 1429 (define (fill-sdl-color! c r g b) 1485 1430 ((foreign-lambda* void ((SDL_Color c) (unsigned-byte r) (unsigned-byte g) (unsigned-byte b)) … … 1493 1438 1494 1439 ;--------------------------------------------------------------------------- 1495 (define-record sdl-joystick pointer)1496 1497 1440 (define-record-printer (sdl-joystick p out) 1498 1441 (for-each (lambda (x) (display x out)) 1499 1442 (list "#<sdl-joystick "(sdl-joystick-pointer p)">"))) 1500 1501 (define-foreign-type SDL_Joystick (c-pointer "SDL_Joystick")1502 sdl-joystick-pointer1503 (pointer-to-record-lambda sdl-joystick))1504 1443 1505 1444 (define sdl-joystick-event-state (foreign-lambda int "SDL_JoystickEventState" -
release/4/sdl/trunk/sdl.setup
r27100 r27311 41 41 (with-input-from-pipe "sdl-config --libs" read-line)))) 42 42 (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") 44 46 (if types? '("sdl.types") '())))) 45 47 (compile ,@(if types? '(-emit-type-file sdl.types) '())
Note: See TracChangeset
for help on using the changeset viewer.