Changeset 27337 in project
- Timestamp:
- 08/30/12 12:17:32 (9 years ago)
- Location:
- release/4/sdl-ttf/trunk
- Files:
-
- 2 added
- 3 edited
Legend:
- Unmodified
- Added
- Removed
-
release/4/sdl-ttf/trunk/sdl-ttf.meta
r27336 r27337 1 ;;; sdl .meta -*- Hen-*-1 ;;; sdl-ttf.meta -*- scheme -*- 2 2 3 3 ((category graphics) 4 (author " Tony Garnock-Jones")5 (synopsis " Basic SDLsupport")4 (author "") 5 (synopsis "SDL-ttf support") 6 6 (license "LGPL-2.1") 7 (doc-from-wiki) 8 (egg "sdl.egg") 9 (files "COPYING" "Makefile" "timer.scm" "sdl.release-info" "test-sdl-body.scm" "sdl-csi.scm" "test-heap.scm" "sdl.meta" "sdl.scm" "heap.scm" "test-net.scm" "sdl.setup" "unknown2-scale8.jpg" "test-sdl.scm")) 7 (egg "sdl-ttf.egg") 8 (files "COPYING" 9 "Makefile" 10 "sdl-ttf.meta" 11 "sdl-ttf.scm" 12 "sdl-ttf.setup")) -
release/4/sdl-ttf/trunk/sdl-ttf.scm
r27336 r27337 1 ;;;; sdl.scm - Simple SDL binding for Chicken2 1 ; Copyright (C) 2002-2004 Tony Garnock-Jones <tonyg@kcbbs.gen.nz> 3 2 ; … … 16 15 ; Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 17 16 ; USA 18 19 ; --------------------------------------------------------------------------- 20 21 (module sdl 22 23 ( *sdl-egg-version* 24 25 SDL_BUTTON 26 sdl-version-major 27 sdl-version-minor 28 sdl-version-patch 29 sdl-version-at-least 30 sdl-compiled-version 31 sdl-linked-version 32 ; sdl gfx 33 make-sdl-rect 34 sdl-rect? 35 sdl-rect-x 36 sdl-rect-y 37 sdl-rect-w 38 sdl-rect-h 39 make-sdl-pixel-format 40 sdl-pixel-format? 41 sdl-pixel-format-bytes-per-pixel 42 sdl-pixel-format-rmask 43 sdl-pixel-format-gmask 44 sdl-pixel-format-bmask 45 sdl-pixel-format-amask 46 sdl-surface-flags 47 sdl-surface-pixel-format 48 sdl-surface-width 49 sdl-surface-height 50 sdl-surface-pitch 51 sdl-surface-pixels 52 sdl-surface-pixels-length 53 sdl-get-video-info 54 sdl-video-info-hw-available 55 sdl-video-info-wm-available 56 sdl-video-info-blit-hw 57 sdl-video-info-blit-hw-cc 58 sdl-video-info-blit-hw-a 59 sdl-video-info-blit-sw 60 sdl-video-info-blit-sw-cc 61 sdl-video-info-blit-sw-a 62 sdl-video-info-blit-fill 63 sdl-video-info-video-mem 64 sdl-video-info-vfmt 65 sdl-video-info-current-w 66 sdl-video-info-current-h 67 sdl-get-clip-rect! 68 sdl-set-clip-rect! 69 sdl-set-color-key! 70 sdl-set-alpha! 71 sdl-display-format 72 sdl-display-format-alpha 73 sdl-convert-surface 74 75 ; sdl system stuff 76 sdl-init 77 sdl-init-sub-system 78 sdl-quit-sub-system 79 sdl-quit 80 sdl-was-init 81 sdl-get-error 82 sdl-clear-error! 83 sdl-wm-set-caption 84 sdl-wm-get-caption-title 85 sdl-wm-get-caption-icon 86 sdl-wm-get-caption 87 sdl-wm-set-icon 88 sdl-wm-iconify-window 89 sdl-wm-toggle-full-screen 90 sdl-wm-grab-input 91 sdl-get-ticks 92 sdl-delay 93 timer? 94 get-time-of-day 95 get-time-of-day 96 sdl-add-relative-timer! 97 make-sdl-event 98 sdl-event? 99 sdl-event-type 100 sdl-pump-events 101 sdl-poll-event! 102 sdl-wait-event!* 103 sdl-wait-event! 104 sdl-push-event 105 sdl-event-state! 106 sdl-get-mouse-state 107 sdl-warp-mouse 108 sdl-enable-unicode 109 sdl-get-video-surface 110 sdl-video-driver-name 111 sdl-set-video-mode 112 sdl-video-mode-ok 113 sdl-show-cursor 114 sdl-map-rgb 115 sdl-map-rgba 116 sdl-fill-rect 117 sdl-flip 118 sdl-surface? 119 sdl-create-rgb-surface 120 sdl-free-surface 121 sdl-blit-surface 122 sdl-with-clip-rect 123 make-sdl-color 124 sdl-color? 125 sdl-color-r 126 sdl-color-g 127 sdl-color-b 128 129 make-sdl-joystick 130 sdl-joystick? 131 sdl-joystick-event-state 132 sdl-joystick-update 133 sdl-num-joysticks 134 sdl-joystick-name 135 sdl-joystick-open 136 sdl-joystick-opened 137 sdl-joystick-index 138 sdl-joystick-num-axes 139 sdl-joystick-num-balls 140 sdl-joystick-num-hats 141 sdl-joystick-num-buttons 142 sdl-joystick-update 143 sdl-joystick-get-axis 144 sdl-joystick-get-hat 145 sdl-joystick-get-button 146 sdl-joystick-close 147 sdl-gl-swap-buffers 148 sdl-gl-set-attribute 149 sdl-gl-get-attribute 150 151 ; SDL ttf 152 ttf-init 17 (module sdl-ttf 18 19 ( ttf-init 153 20 ttf-was-init 154 21 ttf-quit … … 162 29 ttf-get-font-style 163 30 ttf-set-font-style 31 ttf-size-text! 32 ttf-size-utf8! 33 164 34 ttf-font-height 165 35 ttf-font-ascent … … 170 40 ttf-font-face-family-name 171 41 ttf-font-face-style-name 172 ttf-size-text! 173 ttf-size-utf8! 42 174 43 ttf-render-text-solid 175 44 ttf-render-utf8-solid … … 182 51 ttf-render-glyph-blended 183 52 184 ; SDL image 185 img-init 186 img-quit 187 img-load 188 rotozoom-surface 189 zoom-surface 190 191 ;SDL net 192 make-sdl-ip-address 193 sdl-ip-address? 194 sdl-ip-address-a 195 sdl-ip-address-b 196 sdl-ip-address-c 197 sdl-ip-address-d 198 sdl-ip-address-port 199 sdl-net-init 200 sdl-net-quit 201 sdl-net-resolve-host! 202 sdl-net-resolve-ip 203 sdl-net-resolve-host 204 make-sdl-tcp-socket 205 sdl-tcp-socket? 206 sdl-net-tcp-open 207 sdl-net-tcp-accept 208 sdl-net-tcp-get-peer-address 209 sdl-net-tcp-send 210 sdl-net-tcp-recv 211 sdl-net-tcp-close 212 sdl-net-tcp-send-string 213 sdl-net-tcp-recv-string 214 sdl-net-tcp-add-socket! 215 sdl-net-tcp-del-socket! 216 sdl-net-check-sockets 217 sdl-net-socket-ready? 218 sdl-net-socket-set? 219 sdl-net-socket-set-pointer-set! 220 sdl-net-write-16 221 sdl-net-write-32 222 sdl-net-read-16 223 sdl-net-read-32 224 225 sdl-event? 226 sdl-event-gain 227 set-sdl-event-gain! 228 sdl-event-which 229 set-sdl-event-which! 230 sdl-event-state 231 set-sdl-event-state! 232 sdl-event-scancode 233 set-sdl-event-scancode! 234 sdl-event-sym 235 set-sdl-event-sym! 236 sdl-event-mod 237 set-sdl-event-mod! 238 sdl-event-unicode 239 set-sdl-event-unicode! 240 sdl-event-x 241 set-sdl-event-x! 242 sdl-event-y 243 set-sdl-event-y! 244 sdl-event-xrel 245 set-sdl-event-xrel! 246 sdl-event-yrel 247 set-sdl-event-yrel! 248 sdl-event-axis 249 set-sdl-event-axis! 250 sdl-event-ball 251 set-sdl-event-ball! 252 sdl-event-hat 253 set-sdl-event-hat! 254 sdl-event-value 255 set-sdl-event-value! 256 sdl-event-button 257 set-sdl-event-button! 258 sdl-event-w 259 set-sdl-event-w! 260 sdl-event-h 261 set-sdl-event-h! 262 sdl-event-buffer-set! 263 heap? 53 make-ttf-glyph 54 ttf-glyph-metrics 55 ttf-glyph-minx 56 ttf-glyph-maxx 57 ttf-glyph-miny 58 ttf-glyph-maxy 59 ttf-glyph-advance 264 60 265 266 ; constants267 268 SDL_INIT_TIMER269 SDL_INIT_AUDIO270 SDL_INIT_VIDEO271 SDL_INIT_CDROM272 SDL_INIT_JOYSTICK273 SDL_INIT_EVERYTHING274 SDL_INIT_NOPARACHUTE275 276 ;; For sdl-creatergbsurface or sdl-setvideomode277 SDL_SWSURFACE278 SDL_HWSURFACE279 SDL_ASYNCBLIT280 ;; For sdl-setvideomode281 SDL_ANYFORMAT282 SDL_HWPALETTE283 SDL_DOUBLEBUF284 SDL_FULLSCREEN285 SDL_OPENGL286 SDL_OPENGLBLIT287 SDL_RESIZABLE288 SDL_NOFRAME289 ;; Read-only - internal290 SDL_HWACCEL291 SDL_SRCCOLORKEY292 SDL_RLEACCELOK293 SDL_RLEACCEL294 SDL_SRCALPHA295 SDL_PREALLOC296 297 SDL_BYTEORDER298 SDL_LIL_ENDIAN299 SDL_BIG_ENDIAN300 301 ;; For sdl-wm-grabinput302 SDL_GRAB_QUERY303 SDL_GRAB_OFF304 SDL_GRAB_ON305 306 307 SDL_NOEVENT ; Unused (do not remove)308 SDL_ACTIVEEVENT ; Application loses/gains visibility309 SDL_APPMOUSEFOCUS ; Mouse focus gained/lost310 SDL_APPINPUTFOCUS ; Input focus gained/lost311 SDL_APPACTIVE ; Application iconified/restored312 SDL_KEYDOWN ; Keys pressed313 SDL_KEYUP ; Keys released314 SDL_MOUSEMOTION ; Mouse moved315 SDL_MOUSEBUTTONDOWN ; Mouse button pressed316 SDL_MOUSEBUTTONUP ; Mouse button released317 SDL_JOYAXISMOTION ; Joystick axis motion318 SDL_JOYBALLMOTION ; Joystick trackball motion319 SDL_JOYHATMOTION ; Joystick hat position change320 SDL_JOYBUTTONDOWN ; Joystick button pressed321 SDL_JOYBUTTONUP ; Joystick button released322 SDL_QUIT ; User-requested quit323 SDL_SYSWMEVENT ; System specific event324 SDL_EVENT_RESERVEDA ; Reserved for future use..325 SDL_EVENT_RESERVEDB ; Reserved for future use..326 SDL_VIDEORESIZE ; User resized video mode327 SDL_VIDEOEXPOSE ; Screen needs to be redrawn328 SDL_EVENT_RESERVED2 ; Reserved for future use..329 SDL_EVENT_RESERVED3 ; Reserved for future use..330 SDL_EVENT_RESERVED4 ; Reserved for future use..331 SDL_EVENT_RESERVED5 ; Reserved for future use..332 SDL_EVENT_RESERVED6 ; Reserved for future use..333 SDL_EVENT_RESERVED7 ; Reserved for future use..334 SDL_USEREVENT ; SDL_USEREVENT .. SDL_NUMEVENTS are for client use335 SDL_NUMEVENTS336 337 SDL_ACTIVEEVENTMASK338 SDL_KEYDOWNMASK339 SDL_KEYUPMASK340 SDL_MOUSEMOTIONMASK341 SDL_MOUSEBUTTONDOWNMASK342 SDL_MOUSEBUTTONUPMASK343 SDL_MOUSEEVENTMASK344 SDL_JOYAXISMOTIONMASK345 SDL_JOYBALLMOTIONMASK346 SDL_JOYHATMOTIONMASK347 SDL_JOYBUTTONDOWNMASK348 SDL_JOYBUTTONUPMASK349 SDL_JOYEVENTMASK350 SDL_VIDEORESIZEMASK351 SDL_VIDEOEXPOSEMASK352 SDL_QUITMASK353 SDL_SYSWMEVENTMASK354 SDL_ALLEVENTS355 ; General button/key states356 SDL_PRESSED357 SDL_RELEASED358 ; Mouse button states359 SDL_BUTTON_LEFT360 SDL_BUTTON_MIDDLE361 SDL_BUTTON_RIGHT362 SDL_BUTTON_WHEELUP363 SDL_BUTTON_WHEELDOWN364 SDL_BUTTON_LMASK ; = SDL_BUTTON(SDL_BUTTON_LEFT)365 SDL_BUTTON_MMASK ; = SDL_BUTTON(SDL_BUTTON_MIDDLE)366 SDL_BUTTON_RMASK ; = SDL_BUTTON(SDL_BUTTON_RIGHT)367 SDL_QUERY368 SDL_IGNORE369 SDL_DISABLE370 SDL_ENABLE371 372 SDL_GL_RED_SIZE373 SDL_GL_GREEN_SIZE374 SDL_GL_BLUE_SIZE375 SDL_GL_ALPHA_SIZE376 SDL_GL_BUFFER_SIZE377 SDL_GL_DOUBLEBUFFER378 SDL_GL_DEPTH_SIZE379 SDL_GL_STENCIL_SIZE380 SDL_GL_ACCUM_RED_SIZE381 SDL_GL_ACCUM_GREEN_SIZE382 SDL_GL_ACCUM_BLUE_SIZE383 SDL_GL_ACCUM_ALPHA_SIZE384 SDL_GL_STEREO385 SDL_GL_MULTISAMPLEBUFFERS386 SDL_GL_MULTISAMPLESAMPLES387 SDL_GL_SWAP_CONTROL388 SDL_GL_ACCELERATED_VISUAL389 390 61 TTF_STYLE_NORMAL 391 62 TTF_STYLE_BOLD 392 63 TTF_STYLE_ITALIC 393 64 TTF_STYLE_UNDERLINE 394 395 ;; SDL_image396 IMG_INIT_JPG397 IMG_INIT_PNG398 IMG_INIT_TIF399 400 ;; scancodes401 402 SDLK_UNKNOWN403 SDLK_FIRST404 SDLK_BACKSPACE405 SDLK_TAB406 SDLK_CLEAR407 SDLK_RETURN408 SDLK_PAUSE409 SDLK_ESCAPE410 SDLK_SPACE411 SDLK_EXCLAIM412 SDLK_QUOTEDBL413 SDLK_HASH414 SDLK_DOLLAR415 SDLK_AMPERSAND416 SDLK_QUOTE417 SDLK_LEFTPAREN418 SDLK_RIGHTPAREN419 SDLK_ASTERISK420 SDLK_PLUS421 SDLK_COMMA422 SDLK_MINUS423 SDLK_PERIOD424 SDLK_SLASH425 SDLK_0426 SDLK_1427 SDLK_2428 SDLK_3429 SDLK_4430 SDLK_5431 SDLK_6432 SDLK_7433 SDLK_8434 SDLK_9435 SDLK_COLON436 SDLK_SEMICOLON437 SDLK_LESS438 SDLK_EQUALS439 SDLK_GREATER440 SDLK_QUESTION441 SDLK_AT442 SDLK_LEFTBRACKET443 SDLK_BACKSLASH444 SDLK_RIGHTBRACKET445 SDLK_CARET446 SDLK_UNDERSCORE447 SDLK_BACKQUOTE448 SDLK_a449 SDLK_b450 SDLK_c451 SDLK_d452 SDLK_e453 SDLK_f454 SDLK_g455 SDLK_h456 SDLK_i457 SDLK_j458 SDLK_k459 SDLK_l460 SDLK_m461 SDLK_n462 SDLK_o463 SDLK_p464 SDLK_q465 SDLK_r466 SDLK_s467 SDLK_t468 SDLK_u469 SDLK_v470 SDLK_w471 SDLK_x472 SDLK_y473 SDLK_z474 SDLK_DELETE475 SDLK_WORLD_0476 SDLK_WORLD_1477 SDLK_WORLD_2478 SDLK_WORLD_3479 SDLK_WORLD_4480 SDLK_WORLD_5481 SDLK_WORLD_6482 SDLK_WORLD_7483 SDLK_WORLD_8484 SDLK_WORLD_9485 SDLK_WORLD_10486 SDLK_WORLD_11487 SDLK_WORLD_12488 SDLK_WORLD_13489 SDLK_WORLD_14490 SDLK_WORLD_15491 SDLK_WORLD_16492 SDLK_WORLD_17493 SDLK_WORLD_18494 SDLK_WORLD_19495 SDLK_WORLD_20496 SDLK_WORLD_21497 SDLK_WORLD_22498 SDLK_WORLD_23499 SDLK_WORLD_24500 SDLK_WORLD_25501 SDLK_WORLD_26502 SDLK_WORLD_27503 SDLK_WORLD_28504 SDLK_WORLD_29505 SDLK_WORLD_30506 SDLK_WORLD_31507 SDLK_WORLD_32508 SDLK_WORLD_33509 SDLK_WORLD_34510 SDLK_WORLD_35511 SDLK_WORLD_36512 SDLK_WORLD_37513 SDLK_WORLD_38514 SDLK_WORLD_39515 SDLK_WORLD_40516 SDLK_WORLD_41517 SDLK_WORLD_42518 SDLK_WORLD_43519 SDLK_WORLD_44520 SDLK_WORLD_45521 SDLK_WORLD_46522 SDLK_WORLD_47523 SDLK_WORLD_48524 SDLK_WORLD_49525 SDLK_WORLD_50526 SDLK_WORLD_51527 SDLK_WORLD_52528 SDLK_WORLD_53529 SDLK_WORLD_54530 SDLK_WORLD_55531 SDLK_WORLD_56532 SDLK_WORLD_57533 SDLK_WORLD_58534 SDLK_WORLD_59535 SDLK_WORLD_60536 SDLK_WORLD_61537 SDLK_WORLD_62538 SDLK_WORLD_63539 SDLK_WORLD_64540 SDLK_WORLD_65541 SDLK_WORLD_66542 SDLK_WORLD_67543 SDLK_WORLD_68544 SDLK_WORLD_69545 SDLK_WORLD_70546 SDLK_WORLD_71547 SDLK_WORLD_72548 SDLK_WORLD_73549 SDLK_WORLD_74550 SDLK_WORLD_75551 SDLK_WORLD_76552 SDLK_WORLD_77553 SDLK_WORLD_78554 SDLK_WORLD_79555 SDLK_WORLD_80556 SDLK_WORLD_81557 SDLK_WORLD_82558 SDLK_WORLD_83559 SDLK_WORLD_84560 SDLK_WORLD_85561 SDLK_WORLD_86562 SDLK_WORLD_87563 SDLK_WORLD_88564 SDLK_WORLD_89565 SDLK_WORLD_90566 SDLK_WORLD_91567 SDLK_WORLD_92568 SDLK_WORLD_93569 SDLK_WORLD_94570 SDLK_WORLD_95571 SDLK_KP0572 SDLK_KP1573 SDLK_KP2574 SDLK_KP3575 SDLK_KP4576 SDLK_KP5577 SDLK_KP6578 SDLK_KP7579 SDLK_KP8580 SDLK_KP9581 SDLK_KP_PERIOD582 SDLK_KP_DIVIDE583 SDLK_KP_MULTIPLY584 SDLK_KP_MINUS585 SDLK_KP_PLUS586 SDLK_KP_ENTER587 SDLK_KP_EQUALS588 SDLK_UP589 SDLK_DOWN590 SDLK_RIGHT591 SDLK_LEFT592 SDLK_INSERT593 SDLK_HOME594 SDLK_END595 SDLK_PAGEUP596 SDLK_PAGEDOWN597 SDLK_F1598 SDLK_F2599 SDLK_F3600 SDLK_F4601 SDLK_F5602 SDLK_F6603 SDLK_F7604 SDLK_F8605 SDLK_F9606 SDLK_F10607 SDLK_F11608 SDLK_F12609 SDLK_F13610 SDLK_F14611 SDLK_F15612 SDLK_NUMLOCK613 SDLK_CAPSLOCK614 SDLK_SCROLLOCK615 SDLK_RSHIFT616 SDLK_LSHIFT617 SDLK_RCTRL618 SDLK_LCTRL619 SDLK_RALT620 SDLK_LALT621 SDLK_RMETA622 SDLK_LMETA623 SDLK_LSUPER624 SDLK_RSUPER625 SDLK_MODE626 SDLK_COMPOSE627 SDLK_HELP628 SDLK_PRINT629 SDLK_SYSREQ630 SDLK_BREAK631 SDLK_MENU632 SDLK_POWER633 SDLK_EURO634 SDLK_UNDO635 65 636 66 ) … … 644 74 (use srfi-18) 645 75 (use lolevel) 76 (use sdl-base) 646 77 647 78 (foreign-declare #<<EOF 648 79 649 #ifdef _WIN32650 # if _MSC_VER > 1300651 # include <winsock2.h>652 # include <ws2tcpip.h>653 # else654 # include <winsock.h>655 # endif656 #else657 # include <netinet/in.h>658 #endif659 660 #include <sys/time.h>661 662 #include "SDL.h"663 80 #include "SDL_ttf.h" 664 #include "SDL_image.h"665 #include "SDL_rotozoom.h"666 #include "SDL_keysym.h"667 #include "SDL_endian.h"668 669 81 #include <string.h> 670 #include "SDL_net.h"671 82 672 83 EOF 673 84 ) 674 675 (include "heap.scm")676 (include "timer.scm")677 678 ;---------------------------------------------------------------------------679 680 ;; The first two components are arbitrary - the main version of the library.681 ;; The third is the date (YYMMDD, with leading zeros removed).682 ;; The fourth is a counter just in case we release more than one version in683 ;; one day.684 (define *sdl-egg-version* '(0 5 91025 0))685 85 686 86 ;--------------------------------------------------------------------------- … … 696 96 (cdr e))))) 697 97 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") 708 (include "keysym.scm") 709 710 ; Subsystem definitions, for sdl-init etc. 711 (--sdl-flags "SDL_INIT_TIMER" 712 "SDL_INIT_AUDIO" 713 "SDL_INIT_VIDEO" 714 "SDL_INIT_CDROM" 715 "SDL_INIT_JOYSTICK" 716 "SDL_INIT_EVERYTHING" 717 "SDL_INIT_NOPARACHUTE") 718 719 (--sdl-flags 720 ;; For sdl-creatergbsurface or sdl-setvideomode 721 "SDL_SWSURFACE" 722 "SDL_HWSURFACE" 723 "SDL_ASYNCBLIT" 724 ;; For sdl-setvideomode 725 "SDL_ANYFORMAT" 726 "SDL_HWPALETTE" 727 "SDL_DOUBLEBUF" 728 "SDL_FULLSCREEN" 729 "SDL_OPENGL" 730 "SDL_OPENGLBLIT" 731 "SDL_RESIZABLE" 732 "SDL_NOFRAME" 733 ;; Read-only - internal 734 "SDL_HWACCEL" 735 "SDL_SRCCOLORKEY" 736 "SDL_RLEACCELOK" 737 "SDL_RLEACCEL" 738 "SDL_SRCALPHA" 739 "SDL_PREALLOC" 740 ) 741 742 (--sdl-flags 743 "SDL_BYTEORDER" 744 "SDL_LIL_ENDIAN" 745 "SDL_BIG_ENDIAN") 746 747 ; For sdl-wm-grabinput 748 (--sdl-flags "SDL_GRAB_QUERY" 749 "SDL_GRAB_OFF" 750 "SDL_GRAB_ON") 751 752 (--sdl-flags 753 "SDL_NOEVENT" ; Unused (do not remove) 754 "SDL_ACTIVEEVENT" ; Application loses/gains visibility 755 "SDL_APPMOUSEFOCUS" ; Mouse focus gained/lost 756 "SDL_APPINPUTFOCUS" ; Input focus gained/lost 757 "SDL_APPACTIVE" ; Application iconified/restored 758 "SDL_KEYDOWN" ; Keys pressed 759 "SDL_KEYUP" ; Keys released 760 "SDL_MOUSEMOTION" ; Mouse moved 761 "SDL_MOUSEBUTTONDOWN" ; Mouse button pressed 762 "SDL_MOUSEBUTTONUP" ; Mouse button released 763 "SDL_JOYAXISMOTION" ; Joystick axis motion 764 "SDL_JOYBALLMOTION" ; Joystick trackball motion 765 "SDL_JOYHATMOTION" ; Joystick hat position change 766 "SDL_JOYBUTTONDOWN" ; Joystick button pressed 767 "SDL_JOYBUTTONUP" ; Joystick button released 768 "SDL_QUIT" ; User-requested quit 769 "SDL_SYSWMEVENT" ; System specific event 770 "SDL_EVENT_RESERVEDA" ; Reserved for future use.. 771 "SDL_EVENT_RESERVEDB" ; Reserved for future use.. 772 "SDL_VIDEORESIZE" ; User resized video mode 773 "SDL_VIDEOEXPOSE" ; Screen needs to be redrawn 774 "SDL_EVENT_RESERVED2" ; Reserved for future use.. 775 "SDL_EVENT_RESERVED3" ; Reserved for future use.. 776 "SDL_EVENT_RESERVED4" ; Reserved for future use.. 777 "SDL_EVENT_RESERVED5" ; Reserved for future use.. 778 "SDL_EVENT_RESERVED6" ; Reserved for future use.. 779 "SDL_EVENT_RESERVED7" ; Reserved for future use.. 780 "SDL_USEREVENT" ; SDL_USEREVENT .. SDL_NUMEVENTS are for client use 781 "SDL_NUMEVENTS" 782 ) 783 784 (--sdl-flags 785 "SDL_ACTIVEEVENTMASK" 786 "SDL_KEYDOWNMASK" 787 "SDL_KEYUPMASK" 788 "SDL_MOUSEMOTIONMASK" 789 "SDL_MOUSEBUTTONDOWNMASK" 790 "SDL_MOUSEBUTTONUPMASK" 791 "SDL_MOUSEEVENTMASK" 792 "SDL_JOYAXISMOTIONMASK" 793 "SDL_JOYBALLMOTIONMASK" 794 "SDL_JOYHATMOTIONMASK" 795 "SDL_JOYBUTTONDOWNMASK" 796 "SDL_JOYBUTTONUPMASK" 797 "SDL_JOYEVENTMASK" 798 "SDL_VIDEORESIZEMASK" 799 "SDL_VIDEOEXPOSEMASK" 800 "SDL_QUITMASK" 801 "SDL_SYSWMEVENTMASK" 802 "SDL_ALLEVENTS" 803 ) 804 805 ; General button/key states 806 (--sdl-flags 807 "SDL_PRESSED" 808 "SDL_RELEASED") 809 810 ;; SDL_image constants 811 (--sdl-flags 812 "IMG_INIT_JPG" 813 "IMG_INIT_PNG" 814 "IMG_INIT_TIF") 815 816 ; Mouse button states 817 818 ; The macro SDL_BUTTON is parameterised, so we have to recreate it as 819 ; a function 820 821 (define (SDL_BUTTON x) 822 (arithmetic-shift SDL_PRESSED (- x 1))) 823 824 (--sdl-flags 825 "SDL_BUTTON_LEFT" 826 "SDL_BUTTON_MIDDLE" 827 "SDL_BUTTON_RIGHT" 828 "SDL_BUTTON_WHEELUP" 829 "SDL_BUTTON_WHEELDOWN" 830 "SDL_BUTTON_LMASK" ; = SDL_BUTTON(SDL_BUTTON_LEFT) 831 "SDL_BUTTON_MMASK" ; = SDL_BUTTON(SDL_BUTTON_MIDDLE) 832 "SDL_BUTTON_RMASK" ; = SDL_BUTTON(SDL_BUTTON_RIGHT) 833 ) 834 835 ; For sdl-eventstate 836 (--sdl-flags "SDL_QUERY" 837 "SDL_IGNORE" 838 "SDL_DISABLE" 839 "SDL_ENABLE") 98 (include "sdl-base-foreign-types-include.scm") 99 100 (define-syntax pointer-to-record-lambda 101 (ir-macro-transformer 102 (lambda (e i c) 103 (let ((record-name (cadr e))) 104 `(lambda (pointer) 105 (and pointer 106 (,(i (symbol-append 'make- (i record-name))) pointer))))))) 840 107 841 108 ;--------------------------------------------------------------------------- 842 109 843 (define-record-printer (sdl-version o out)844 (for-each (lambda (x) (display x out))845 (list "#<sdl-version "846 (sdl-version-major o) " "847 (sdl-version-minor o) " "848 (sdl-version-patch o)849 ">")))850 851 (define sdl-version-major852 (foreign-lambda* unsigned-byte ((SDL_version v))853 "C_return(v->major);"))854 855 (define sdl-version-minor856 (foreign-lambda* unsigned-byte ((SDL_version v))857 "C_return(v->minor);"))858 859 (define sdl-version-patch860 (foreign-lambda* unsigned-byte ((SDL_version v))861 "C_return(v->patch);"))862 863 ;; Returns #t if the first argument is at least what the rest of the864 ;; arguments indicate.865 (define (sdl-version-at-least sdl-version major minor patch)866 (cond867 ((> (sdl-version-major sdl-version) major) #t)868 ((< (sdl-version-major sdl-version) major) #f)869 ((> (sdl-version-minor sdl-version) minor) #t)870 ((< (sdl-version-minor sdl-version) minor) #f)871 ((>= (sdl-version-patch sdl-version) patch) #t)872 (#t #f)))873 874 (define sdl-compiled-version875 (foreign-lambda* SDL_version ()876 "SDL_version v; SDL_VERSION(&v); C_return(&v);"))877 878 (define sdl-linked-version879 (foreign-lambda SDL_version "SDL_Linked_Version"))880 881 ;---------------------------------------------------------------------------882 883 (define-foreign-variable sizeof-sdl-rect int "sizeof(SDL_Rect)")884 885 (let ((maker make-sdl-rect))886 (set! make-sdl-rect887 (lambda (x y w h)888 (let ((r (maker (make-blob sizeof-sdl-rect))))889 (sdl-rect-x-set! r x)890 (sdl-rect-y-set! r y)891 (sdl-rect-w-set! r w)892 (sdl-rect-h-set! r h)893 r))))894 895 (define-record-printer (sdl-rect s out)896 (for-each (lambda (x) (display x out))897 (list "#<sdl-rect "898 (sdl-rect-x s)" "899 (sdl-rect-y s)" "900 (sdl-rect-w s)" "901 (sdl-rect-h s)">")))902 903 (define sdl-rect-x (foreign-lambda* short ((SDL_Rect c)) "C_return(c->x);"))904 (define sdl-rect-y (foreign-lambda* short ((SDL_Rect c)) "C_return(c->y);"))905 (define sdl-rect-w (foreign-lambda* unsigned-short ((SDL_Rect c)) "C_return(c->w);"))906 (define sdl-rect-h (foreign-lambda* unsigned-short ((SDL_Rect c)) "C_return(c->h);"))907 908 (define sdl-rect-x-set! (foreign-lambda* void ((SDL_Rect c) (short x)) "c->x = x;"))909 (define sdl-rect-y-set! (foreign-lambda* void ((SDL_Rect c) (short y)) "c->y = y;"))910 (define sdl-rect-w-set! (foreign-lambda* void ((SDL_Rect c) (unsigned-short w)) "c->w = w;"))911 (define sdl-rect-h-set! (foreign-lambda* void ((SDL_Rect c) (unsigned-short h)) "c->h = h;"))912 913 ;---------------------------------------------------------------------------914 915 (define-record-printer (sdl-pixel-format p out)916 (for-each (lambda (x) (display x out))917 (list "#<sdl-pixel-format "(sdl-pixel-format-pointer p)">")))918 919 (define sdl-pixel-format-bytes-per-pixel920 (foreign-lambda* unsigned-byte ((SDL_PixelFormat pf))921 "C_return(pf->BytesPerPixel);"))922 923 (define sdl-pixel-format-rmask924 (foreign-lambda* unsigned-byte ((SDL_PixelFormat pf))925 "C_return(pf->Rmask);"))926 (define sdl-pixel-format-gmask927 (foreign-lambda* unsigned-byte ((SDL_PixelFormat pf))928 "C_return(pf->Gmask);"))929 (define sdl-pixel-format-bmask930 (foreign-lambda* unsigned-byte ((SDL_PixelFormat pf))931 "C_return(pf->Bmask);"))932 (define sdl-pixel-format-amask933 (foreign-lambda* unsigned-byte ((SDL_PixelFormat pf))934 "C_return(pf->Amask);"))935 936 ;---------------------------------------------------------------------------937 938 (define-record-printer (sdl-surface s out)939 (for-each (lambda (x) (display x out))940 (list "#<sdl-surface "(sdl-surface-pointer s)">")))941 942 (define (sdl-surface-flags s)943 ((foreign-lambda* unsigned-integer ((SDL_Surface s))944 "C_return(s->flags);") s))945 946 (define (sdl-surface-pixel-format s)947 ((foreign-lambda* SDL_PixelFormat ((SDL_Surface s))948 "C_return(s->format);") s))949 950 (define (sdl-surface-width s)951 ((foreign-lambda* integer ((SDL_Surface s))952 "C_return(s->w);") s))953 954 (define (sdl-surface-height s)955 ((foreign-lambda* integer ((SDL_Surface s))956 "C_return(s->h);") s))957 958 (define (sdl-surface-pitch s)959 ((foreign-lambda* unsigned-short ((SDL_Surface s))960 "C_return(s->pitch);") s))961 962 (define (sdl-surface-pixels s)963 ((foreign-lambda* (c-pointer byte) ((SDL_Surface s))964 "C_return(s->pixels);") s))965 966 ;; Computes the number of bytes of storage pointed to by967 ;; sdl-surface-pixels.968 (define (sdl-surface-pixels-length s)969 (* (sdl-surface-height s)970 (sdl-surface-pitch s)))971 972 ;;973 ;; SDL_VideoInfo974 ;;975 976 (define-record-printer (sdl-video-info o out)977 (for-each (lambda (x) (display x out))978 (list "#<sdl-video-info "979 (sdl-video-info-hw-available o) " "980 (sdl-video-info-wm-available o) " "981 (sdl-video-info-blit-hw o) " "982 (sdl-video-info-blit-hw-cc o) " "983 (sdl-video-info-blit-hw-a o) " "984 (sdl-video-info-blit-sw o) " "985 (sdl-video-info-blit-sw-cc o) " "986 (sdl-video-info-blit-sw-a o) " "987 (sdl-video-info-blit-fill o) " "988 (sdl-video-info-video-mem o) " "989 (sdl-video-info-vfmt o) " "990 (sdl-video-info-current-w o) " "991 (sdl-video-info-current-h o)992 ">")))993 994 (define sdl-video-info-hw-available995 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))996 "C_return(vi->hw_available);"))997 (define sdl-video-info-wm-available998 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))999 "C_return(vi->wm_available);"))1000 (define sdl-video-info-blit-hw1001 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1002 "C_return(vi->blit_hw);"))1003 (define sdl-video-info-blit-hw-cc1004 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1005 "C_return(vi->blit_hw_CC);"))1006 (define sdl-video-info-blit-hw-a1007 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1008 "C_return(vi->blit_hw_A);"))1009 (define sdl-video-info-blit-sw1010 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1011 "C_return(vi->blit_sw);"))1012 (define sdl-video-info-blit-sw-cc1013 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1014 "C_return(vi->blit_sw_CC);"))1015 (define sdl-video-info-blit-sw-a1016 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1017 "C_return(vi->blit_sw_A);"))1018 (define sdl-video-info-blit-fill1019 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1020 "C_return(vi->blit_fill);"))1021 (define sdl-video-info-video-mem1022 (foreign-lambda* unsigned-integer ((SDL_VideoInfo vi))1023 "C_return(vi->video_mem);"))1024 (define sdl-video-info-vfmt1025 (foreign-lambda* SDL_PixelFormat ((SDL_VideoInfo vi))1026 "C_return(vi->vfmt);"))1027 (define sdl-video-info-current-w1028 (foreign-lambda* integer ((SDL_VideoInfo vi))1029 "C_return(vi->current_w);"))1030 (define sdl-video-info-current-h1031 (foreign-lambda* integer ((SDL_VideoInfo vi))1032 "C_return(vi->current_h);"))1033 1034 (define sdl-get-video-info1035 (foreign-lambda* SDL_VideoInfo ()1036 "C_return(SDL_GetVideoInfo());"))1037 1038 1039 ;---------------------------------------------------------------------------1040 1041 ;; Modifies its second argument.1042 (define sdl-get-clip-rect! (foreign-lambda void "SDL_GetClipRect" SDL_Surface SDL_Rect))1043 1044 ;; Modifies its first argument.1045 (define sdl-set-clip-rect! (foreign-lambda bool "SDL_SetClipRect" SDL_Surface SDL_Rect))1046 1047 ;; Modifies its first argument.1048 (define sdl-set-color-key!1049 (foreign-lambda int "SDL_SetColorKey" SDL_Surface unsigned-integer unsigned-integer))1050 1051 ;; Modifies its first argument.1052 (define sdl-set-alpha!1053 (foreign-lambda int "SDL_SetAlpha" SDL_Surface unsigned-integer unsigned-byte))1054 1055 (define sdl-display-format1056 (foreign-lambda SDL_Surface "SDL_DisplayFormat" SDL_Surface))1057 (define sdl-display-format-alpha1058 (foreign-lambda SDL_Surface "SDL_DisplayFormatAlpha" SDL_Surface))1059 (define sdl-convert-surface1060 (foreign-lambda SDL_Surface "SDL_ConvertSurface" SDL_Surface SDL_PixelFormat unsigned-integer))1061 1062 ;---------------------------------------------------------------------------1063 1064 ;; NOTE: sdl-init does not work on MacOS X when called from a1065 ;; dynamically-loaded extension. Something internal to Quartz seems to1066 ;; get confused. You must call SDL_Init *directly* from your main1067 ;; program - if your main program is written in Scheme, you need to1068 ;; say something like:1069 ;;1070 ;; (declare (foreign-declare "#include <SDL.h>\n"))1071 ;; (foreign-code "SDL_Init(SDL_INIT_EVERYTHING);")1072 ;;1073 (define (sdl-init flags)1074 (zero? ((foreign-lambda int "SDL_Init" unsigned-integer) flags)))1075 1076 ;; Note: guile-sdl names these 'sdl-init-subsystem' and1077 ;; 'sdl-quit-subsystem', respectively.1078 1079 (define (sdl-init-sub-system flags)1080 (zero? ((foreign-lambda int "SDL_InitSubSystem" unsigned-integer) flags)))1081 1082 (define (sdl-quit-sub-system flags)1083 ((foreign-lambda void "SDL_QuitSubSystem" unsigned-integer) flags))1084 1085 (define (sdl-quit)1086 ((foreign-lambda void "SDL_Quit")))1087 1088 (define (sdl-was-init flags)1089 ((foreign-lambda unsigned-integer "SDL_WasInit" unsigned-integer) flags))1090 1091 (define sdl-set-error! (foreign-lambda* void ((c-string str)) "SDL_SetError(\"%s\", str);"))1092 (define sdl-get-error (foreign-lambda c-string "SDL_GetError"))1093 (define sdl-clear-error! (foreign-lambda void "SDL_ClearError"))1094 1095 ;---------------------------------------------------------------------------1096 1097 (define (sdl-wm-set-caption title icon)1098 ((foreign-lambda void "SDL_WM_SetCaption" c-string c-string) title icon))1099 1100 (define (sdl-wm-get-caption-title)1101 ((foreign-lambda* c-string ()1102 "char *t, *i;"1103 "SDL_WM_GetCaption(&t, &i);"1104 "C_return(t);")))1105 1106 (define (sdl-wm-get-caption-icon)1107 ((foreign-lambda* c-string ()1108 "char *t, *i;"1109 "SDL_WM_GetCaption(&t, &i);"1110 "C_return(i);")))1111 1112 (define (sdl-wm-get-caption)1113 (values (sdl-wm-get-caption-title)1114 (sdl-wm-get-caption-icon)))1115 1116 (define (sdl-wm-set-icon icon mask)1117 ((foreign-lambda void "SDL_WM_SetIcon" SDL_Surface blob) icon mask))1118 1119 (define (sdl-wm-iconify-window)1120 (not (zero? ((foreign-lambda integer "SDL_WM_IconifyWindow")))))1121 1122 (define (sdl-wm-toggle-full-screen surf)1123 (not (zero? ((foreign-lambda integer "SDL_WM_ToggleFullScreen" SDL_Surface) surf))))1124 1125 (define (sdl-wm-grab-input m)1126 ((foreign-lambda integer "SDL_WM_GrabInput" integer) m))1127 1128 ;---------------------------------------------------------------------------1129 1130 ; Milliseconds.1131 (define sdl-get-ticks (foreign-lambda unsigned-integer "SDL_GetTicks"))1132 (define sdl-delay (foreign-lambda void "SDL_Delay" unsigned-integer))1133 1134 (cond-expand1135 (mingw321136 (define get-time-of-day current-seconds))1137 (else1138 (define get-time-of-day1139 (foreign-lambda* double ()1140 "struct timeval tv;"1141 "gettimeofday(&tv, NULL);"1142 "C_return((double) tv.tv_sec + ((double) tv.tv_usec / 1000000.0));"))))1143 1144 (define-values (sdl-add-absolute-timer!1145 sdl-process-timer-queue!)1146 (make-timer-queue get-time-of-day))1147 1148 (define (sdl-add-relative-timer! time callback)1149 (sdl-add-absolute-timer! (+ time (get-time-of-day)) callback))1150 1151 ;---------------------------------------------------------------------------1152 1153 (define-foreign-variable sizeof-sdl-event int "sizeof(SDL_Event)")1154 1155 (let ((maker make-sdl-event))1156 (set! make-sdl-event1157 (lambda ()1158 (let ((bv (blob->u8vector (make-blob sizeof-sdl-event))))1159 (u8vector-set! bv 0 SDL_NOEVENT)1160 (maker (u8vector->blob bv))))))1161 1162 (define-record-printer (sdl-event s out)1163 (for-each (lambda (x) (display x out))1164 (list "#<sdl-event "(sdl-event-type s)">")))1165 1166 (define sdl-event-type (foreign-lambda* unsigned-byte ((SDL_Event e)) "C_return(e->type);"))1167 (define sdl-event-type-set! (foreign-lambda* void ((SDL_Event e) (unsigned-byte t)) "e->type = t;"))1168 1169 (define-syntax --sdl-event-getter-setter1170 (lambda (f r c)1171 (let ((name (cadr f))1172 (rest (cddr f)))1173 (let* ((strapp (lambda s (apply string-append1174 (map (lambda (x) (cond1175 ((symbol? x) (symbol->string x))1176 (else x)))1177 s))))1178 (symapp (lambda s (string->symbol (apply strapp s)))))1179 `(,(r 'begin)1180 (,(r 'define) (,(symapp "sdl-event-" name) e)1181 (,(r 'let) ((,(r 't) (,(r 'sdl-event-type) e)))1182 (,(r 'cond)1183 ,@(map (lambda (clause)1184 (apply (lambda (etype mem1 kind)1185 `((,(r '=) ,(r 't) ,etype) ((,(r 'foreign-lambda*)1186 ,kind ((SDL_Event e))1187 ,(strapp "C_return(e->"mem1"."name");")) e)))1188 clause))1189 rest)1190 (,(r 'else) (,(r 'error) ,(string-append "sdl-event-" (symbol->string name)1191 ": cannot extract value from this type of event")1192 (,(r 'sdl-event-type) e))))))1193 (,(r 'define) (,(symapp "set-sdl-event-" name "!") e v)1194 (,(r 'let) ((t (,(r 'sdl-event-type) e)))1195 (,(r 'cond)1196 ,@(map (lambda (clause)1197 (apply (lambda (etype mem1 kind)1198 `((,(r '=) t ,etype) ((,(r 'foreign-lambda*)1199 void ((SDL_Event e)1200 (,kind v))1201 ,(strapp "e->"mem1"."name"=v;")) e v)))1202 clause))1203 rest)1204 (,(r 'else) (,(r 'error) ,(string-append "set-sdl-event-" (symbol->string name) "!"1205 ": cannot update value for this type of event")1206 (,(r 'sdl-event-type) e)))))))))))1207 1208 (--sdl-event-getter-setter gain (SDL_ACTIVEEVENT active bool))1209 (--sdl-event-getter-setter which (SDL_KEYDOWN key unsigned-byte)1210 (SDL_KEYUP key unsigned-byte)1211 (SDL_MOUSEMOTION motion unsigned-byte)1212 (SDL_MOUSEBUTTONDOWN button unsigned-byte)1213 (SDL_MOUSEBUTTONUP button unsigned-byte)1214 (SDL_JOYAXISMOTION jaxis unsigned-byte)1215 (SDL_JOYBALLMOTION jball unsigned-byte)1216 (SDL_JOYHATMOTION jhat unsigned-byte)1217 (SDL_JOYBUTTONDOWN jbutton unsigned-byte)1218 (SDL_JOYBUTTONUP jbutton unsigned-byte))1219 (--sdl-event-getter-setter state (SDL_ACTIVEEVENT active unsigned-byte)1220 (SDL_KEYDOWN key unsigned-byte)1221 (SDL_KEYUP key unsigned-byte)1222 (SDL_MOUSEMOTION motion unsigned-byte)1223 (SDL_MOUSEBUTTONDOWN button unsigned-byte)1224 (SDL_MOUSEBUTTONUP button unsigned-byte)1225 (SDL_JOYBUTTONDOWN jbutton unsigned-byte)1226 (SDL_JOYBUTTONUP jbutton unsigned-byte))1227 (--sdl-event-getter-setter scancode (SDL_KEYDOWN key.keysym unsigned-byte)1228 (SDL_KEYUP key.keysym unsigned-byte))1229 (--sdl-event-getter-setter sym (SDL_KEYDOWN key.keysym integer)1230 (SDL_KEYUP key.keysym integer))1231 (--sdl-event-getter-setter mod (SDL_KEYDOWN key.keysym integer)1232 (SDL_KEYUP key.keysym integer))1233 (--sdl-event-getter-setter unicode (SDL_KEYDOWN key.keysym short)1234 (SDL_KEYUP key.keysym short))1235 (--sdl-event-getter-setter x (SDL_MOUSEMOTION motion unsigned-short)1236 (SDL_MOUSEBUTTONDOWN button unsigned-short)1237 (SDL_MOUSEBUTTONUP button unsigned-short))1238 (--sdl-event-getter-setter y (SDL_MOUSEMOTION motion unsigned-short)1239 (SDL_MOUSEBUTTONDOWN button unsigned-short)1240 (SDL_MOUSEBUTTONUP button unsigned-short))1241 (--sdl-event-getter-setter xrel (SDL_MOUSEMOTION motion short)1242 (SDL_JOYBALLMOTION jball short))1243 (--sdl-event-getter-setter yrel (SDL_MOUSEMOTION motion short)1244 (SDL_JOYBALLMOTION jball short))1245 (--sdl-event-getter-setter axis (SDL_JOYAXISMOTION jaxis unsigned-byte))1246 (--sdl-event-getter-setter ball (SDL_JOYBALLMOTION jball unsigned-byte))1247 (--sdl-event-getter-setter hat (SDL_JOYHATMOTION jhat unsigned-byte))1248 (--sdl-event-getter-setter value (SDL_JOYAXISMOTION jaxis short)1249 (SDL_JOYHATMOTION jhat unsigned-byte))1250 (--sdl-event-getter-setter button (SDL_MOUSEBUTTONDOWN button unsigned-byte)1251 (SDL_MOUSEBUTTONUP button unsigned-byte)1252 (SDL_JOYBUTTONDOWN jbutton unsigned-byte)1253 (SDL_JOYBUTTONUP jbutton unsigned-byte))1254 (--sdl-event-getter-setter w (SDL_VIDEORESIZE resize integer))1255 (--sdl-event-getter-setter h (SDL_VIDEORESIZE resize integer))1256 1257 (define sdl-pump-events (foreign-lambda void "SDL_PumpEvents"))1258 1259 (define (sdl-poll-event! . e)1260 (if (null? e)1261 (not (zero? ((foreign-lambda int "SDL_PollEvent" c-pointer) #f)))1262 (not (zero? ((foreign-lambda int "SDL_PollEvent" SDL_Event) (car e))))))1263 1264 ;; Now, (sdl-wait-event!) is implemented internally to SDL_event.c as:1265 ;;1266 ;; while (1) {1267 ;; SDL_PumpEvents();1268 ;; switch(SDL_PeepEvents(event, 1, SDL_GETEVENT, SDL_ALLEVENTS)) {1269 ;; case -1: return 0;1270 ;; case 1: return 1;1271 ;; case 0: SDL_Delay(10);1272 ;; }1273 ;; }1274 ;;1275 ;; Since the SDL implementation of timers uses setitimer(2), and we1276 ;; have trouble with setitimer and chicken - see the README - we1277 ;; reimplement (sdl-wait-event!) here calling out to our timer queue1278 ;; processing function.1279 1280 (define (sdl-wait-event!* delay-function . e)1281 (let loop ()1282 (sdl-pump-events)1283 (let ((peep-result ((foreign-lambda*1284 int ((SDL_Event eptr))1285 "C_return(SDL_PeepEvents(eptr, 1, SDL_GETEVENT, SDL_ALLEVENTS));")1286 (if (null? e) #f (car e)))))1287 (case peep-result1288 ((-1) #f) ;; error.1289 ((1) #t) ;; present event.1290 ((0)1291 ;; No event, yet. Check our timer queue, wait, and retry.1292 (let* ((delay-seconds (or (sdl-process-timer-queue!) 0.01))1293 (sleep-time (min delay-seconds 0.01))1294 (fix-sleep-time (inexact->exact (truncate (* 1000 sleep-time)))))1295 (delay-function fix-sleep-time)1296 (loop)))1297 (else (error "sdl-wait-event!: unexpected result from SDL_PeepEvents" peep-result))))))1298 1299 (define (sdl-wait-event! . e)1300 (apply sdl-wait-event!* sdl-delay e))1301 1302 ;; Here's the implementation of (sdl-wait-event!) that calls the1303 ;; SDL-provided routine:1304 ;;1305 ;; (define (sdl-wait-event! . e)1306 ;; (if (null? e)1307 ;; (not (zero? ((foreign-lambda int "SDL_WaitEvent" c-pointer) #f)))1308 ;; (not (zero? ((foreign-lambda int "SDL_WaitEvent" SDL_Event) (car e))))))1309 1310 (define (sdl-push-event e)1311 (zero? ((foreign-lambda int "SDL_PushEvent" SDL_Event) e)))1312 1313 (define sdl-event-state! (foreign-lambda int "SDL_EventState" unsigned-int integer))1314 1315 ; You can pass NULL for the args if you just want the button state1316 (define sdl-get-mouse-state (foreign-lambda int "SDL_GetMouseState" s32vector s32vector))1317 1318 (define sdl-warp-mouse (foreign-lambda void "SDL_WarpMouse" int int))1319 1320 (define sdl-enable-unicode (foreign-lambda bool "SDL_EnableUNICODE" bool))1321 1322 ;---------------------------------------------------------------------------1323 1324 (define sdl-get-video-surface (foreign-lambda SDL_Surface "SDL_GetVideoSurface"))1325 1326 (define (sdl-video-driver-name)1327 (let ((bv (make-blob 128)))1328 (and ((foreign-lambda bool "SDL_VideoDriverName" (c-pointer char) integer)1329 (make-locative bv)1330 (blob-size bv))1331 (substring (blob->string bv)1332 01333 (string-index (blob->string bv)1334 (integer->char 0))))))1335 1336 (define sdl-set-video-mode (foreign-lambda SDL_Surface "SDL_SetVideoMode"1337 integer ; width1338 integer ; height1339 integer ; bpp1340 unsigned-integer ; flags1341 ))1342 1343 (define (sdl-video-mode-ok w h bpp flags)1344 (let ((result ((foreign-lambda integer "SDL_VideoModeOK"1345 integer integer1346 integer unsigned-integer)1347 w h bpp flags)))1348 (and (not (zero? result))1349 result)))1350 1351 (define (sdl-show-cursor . toggle)1352 (if (null? toggle)1353 ((foreign-lambda int "SDL_ShowCursor" int) -1)1354 ((foreign-lambda int "SDL_ShowCursor" int) (if (car toggle) 1 0))))1355 1356 (define sdl-map-rgb (foreign-lambda unsigned-integer "SDL_MapRGB"1357 SDL_PixelFormat1358 unsigned-byte1359 unsigned-byte1360 unsigned-byte))1361 1362 (define sdl-map-rgba (foreign-lambda unsigned-integer "SDL_MapRGBA"1363 SDL_PixelFormat1364 unsigned-byte1365 unsigned-byte1366 unsigned-byte1367 unsigned-byte))1368 1369 ;---------------------------------------------------------------------------1370 1371 (define (sdl-fill-rect s r c)1372 (if (sdl-color? c)1373 ((foreign-lambda* int ((SDL_Surface s)1374 (SDL_Rect r)1375 (scheme-pointer cbuf))1376 "SDL_Color *c = (SDL_Color *) cbuf;"1377 "unsigned int c2 = SDL_MapRGB(s->format, c->r, c->g, c->b);"1378 "C_return(SDL_FillRect(s, r, c2));")1379 s r (sdl-color-buffer c))1380 ((foreign-lambda int "SDL_FillRect" SDL_Surface SDL_Rect unsigned-integer)1381 s r c)))1382 1383 (define sdl-flip (foreign-lambda int "SDL_Flip" SDL_Surface))1384 1385 (define sdl-create-rgb-surface (foreign-lambda SDL_Surface "SDL_CreateRGBSurface"1386 unsigned-integer ; flags1387 integer ; width1388 integer ; height1389 integer ; depth1390 unsigned-integer ; rmask1391 unsigned-integer ; gmask1392 unsigned-integer ; bmask1393 unsigned-integer)) ; amask1394 (define (sdl-free-surface surf)1395 ((foreign-lambda void "SDL_FreeSurface" SDL_Surface) surf)1396 (sdl-surface-pointer-set! surf (address->pointer 0)))1397 1398 (define sdl-blit-surface (foreign-lambda integer "SDL_BlitSurface"1399 SDL_Surface SDL_Rect ; src, srcrect1400 SDL_Surface SDL_Rect)) ; dst, dstrect1401 1402 (define (sdl-with-clip-rect s r thunk)1403 (let ((orig-clip-rect (make-sdl-rect 0 0 0 0)))1404 (dynamic-wind1405 (lambda ()1406 (sdl-get-clip-rect! s orig-clip-rect)1407 (sdl-set-clip-rect! s r))1408 thunk1409 (lambda ()1410 (sdl-set-clip-rect! s orig-clip-rect)))))1411 1412 ;---------------------------------------------------------------------------1413 1414 (define-foreign-variable sizeof-sdl-color int "sizeof(SDL_Color)")1415 1416 (let ((maker make-sdl-color))1417 (set! make-sdl-color1418 (lambda (r g b)1419 (let ((bv (make-blob sizeof-sdl-color)))1420 (fill-sdl-color! (maker bv) r g b)))))1421 1422 (define-record-printer (sdl-color s out)1423 (for-each (lambda (x) (display x out))1424 (list "#<sdl-color "1425 (sdl-color-r s)" "1426 (sdl-color-g s)" "1427 (sdl-color-b s)">")))1428 1429 (define (fill-sdl-color! c r g b)1430 ((foreign-lambda* void ((SDL_Color c) (unsigned-byte r) (unsigned-byte g) (unsigned-byte b))1431 "c->r = r; c->g = g; c->b = b;")1432 c r g b)1433 c)1434 1435 (define sdl-color-r (foreign-lambda* unsigned-byte ((SDL_Color c)) "C_return(c->r);"))1436 (define sdl-color-g (foreign-lambda* unsigned-byte ((SDL_Color c)) "C_return(c->g);"))1437 (define sdl-color-b (foreign-lambda* unsigned-byte ((SDL_Color c)) "C_return(c->b);"))1438 1439 ;---------------------------------------------------------------------------1440 (define-record-printer (sdl-joystick p out)1441 (for-each (lambda (x) (display x out))1442 (list "#<sdl-joystick "(sdl-joystick-pointer p)">")))1443 1444 (define sdl-joystick-event-state (foreign-lambda int "SDL_JoystickEventState"1445 int))1446 (define sdl-joystick-update (foreign-lambda void "SDL_JoystickUpdate"))1447 (define sdl-num-joysticks (foreign-lambda int "SDL_NumJoysticks"))1448 (define sdl-joystick-name (foreign-lambda c-string "SDL_JoystickName" int))1449 (define sdl-joystick-open (foreign-lambda SDL_Joystick "SDL_JoystickOpen" int))1450 (define sdl-joystick-opened (foreign-lambda int "SDL_JoystickOpened" int))1451 (define sdl-joystick-index (foreign-lambda int "SDL_JoystickIndex"1452 SDL_Joystick))1453 (define sdl-joystick-num-axes (foreign-lambda int "SDL_JoystickNumAxes"1454 SDL_Joystick))1455 (define sdl-joystick-num-balls (foreign-lambda int "SDL_JoystickNumBalls"1456 SDL_Joystick))1457 (define sdl-joystick-num-hats (foreign-lambda int "SDL_JoystickNumHats"1458 SDL_Joystick))1459 (define sdl-joystick-num-buttons (foreign-lambda int "SDL_JoystickNumButtons"1460 SDL_Joystick))1461 (define sdl-joystick-update (foreign-lambda void "SDL_JoystickUpdate"))1462 (define sdl-joystick-get-axis (foreign-lambda short "SDL_JoystickGetAxis"1463 SDL_Joystick int))1464 (define sdl-joystick-get-hat (foreign-lambda unsigned-char "SDL_JoystickGetHat"1465 SDL_Joystick int))1466 (define sdl-joystick-get-button (foreign-lambda unsigned-char1467 "SDL_JoystickGetButton"1468 SDL_Joystick int))1469 ;TODO: sdl-joystick-get-ball1470 (define sdl-joystick-close (foreign-lambda void "SDL_JoystickClose"1471 SDL_Joystick))1472 1473 ;---------------------------------------------------------------------------1474 ;1475 ; OpenGL stuff:1476 1477 (--sdl-flags "SDL_GL_RED_SIZE"1478 "SDL_GL_GREEN_SIZE"1479 "SDL_GL_BLUE_SIZE"1480 "SDL_GL_ALPHA_SIZE"1481 "SDL_GL_BUFFER_SIZE"1482 "SDL_GL_DOUBLEBUFFER"1483 "SDL_GL_DEPTH_SIZE"1484 "SDL_GL_STENCIL_SIZE"1485 "SDL_GL_ACCUM_RED_SIZE"1486 "SDL_GL_ACCUM_GREEN_SIZE"1487 "SDL_GL_ACCUM_BLUE_SIZE"1488 "SDL_GL_ACCUM_ALPHA_SIZE"1489 "SDL_GL_STEREO"1490 "SDL_GL_MULTISAMPLEBUFFERS"1491 "SDL_GL_MULTISAMPLESAMPLES"1492 "SDL_GL_SWAP_CONTROL"1493 "SDL_GL_ACCELERATED_VISUAL")1494 1495 (define sdl-gl-swap-buffers (foreign-lambda void "SDL_GL_SwapBuffers"))1496 (define sdl-gl-set-attribute (foreign-lambda int "SDL_GL_SetAttribute" unsigned-int int))1497 1498 (define sdl-gl-get-attribute1499 (let ((get (foreign-lambda int "SDL_GL_GetAttribute" unsigned-int (c-pointer int))))1500 (lambda (attr)1501 (let-location ((ptr int))1502 (let ((r (get attr (location ptr))))1503 (and (zero? r) ptr))))))1504 1505 ;---------------------------------------------------------------------------1506 110 1507 111 (define-record ttf-font pointer) 1508 112 1509 113 (define-record-printer (ttf-font f out) 1510 (f or-each (lambda (x) (display x out))1511 (list "#<ttf-font "(ttf-font-pointer f)">")))114 (fprintf out "#<ttf-font ~S>" 115 (ttf-font-pointer f))) 1512 116 1513 117 (define-foreign-type TTF_Font (c-pointer "TTF_Font") … … 1613 217 "C_return(TTF_RenderGlyph_Blended(font,ch,*fg));")) 1614 218 1615 ;--------------------------------------------------------------------------- 1616 1617 (define img-init (foreign-lambda unsigned-int "IMG_Init" unsigned-int)) 1618 (define img-quit (foreign-lambda void "IMG_Quit")) 1619 (define img-load (foreign-lambda SDL_Surface "IMG_Load" c-string)) 1620 1621 ;--------------------------------------------------------------------------- 1622 1623 (define rotozoom-surface (foreign-lambda SDL_Surface "rotozoomSurface" 1624 SDL_Surface ; src 1625 double ; angle 1626 double ; zoom 1627 bool)) ; smooth 1628 1629 (define zoom-surface (foreign-lambda SDL_Surface "zoomSurface" 1630 SDL_Surface ; src 1631 double ; zoomx 1632 double ; zoomy 1633 bool)) ; smooth 1634 1635 ;--------------------------------------------------------------------------- 1636 1637 (define-foreign-variable sizeof-sdl-ip-address int "sizeof(IPaddress)") 1638 (define-record sdl-ip-address buffer) 1639 1640 (let ((maker make-sdl-ip-address)) 1641 (set! make-sdl-ip-address 1642 (lambda (a b c d p) 1643 (let* ((bv (make-blob sizeof-sdl-ip-address)) 1644 (addr (maker bv))) 1645 ((foreign-lambda* void ((blob bv) 1646 (unsigned-integer host) 1647 (unsigned-short port)) 1648 "IPaddress *ipa = (IPaddress *) bv;" 1649 "ipa->host = host;" 1650 "ipa->port = htons(port);") 1651 bv 1652 (+ (* a 16777216) 1653 (* b 65536) 1654 (* c 256) 1655 d) 1656 p) 1657 addr)))) 1658 1659 (define-record-printer (sdl-ip-address s out) 1660 (for-each (lambda (x) (display x out)) 1661 (list "#<IPaddress " 1662 (sdl-ip-address-a s)"." 1663 (sdl-ip-address-b s)"." 1664 (sdl-ip-address-c s)"." 1665 (sdl-ip-address-d s)" " 1666 (sdl-ip-address-port s)">"))) 1667 1668 (define (-sdl-unbox-ip-address e) 219 ;; 220 ;; GlyphMetrics 221 ;; 222 223 (define-record ttf-glyph buffer) 224 225 (foreign-declare "typedef struct { int minx, maxx, miny, maxy, adv; } GlyphMetrics; ") 226 (define-foreign-variable sizeof-glyph-metrics int "sizeof(GlyphMetrics)") 227 228 (let ((maker make-ttf-glyph)) 229 (set! make-ttf-glyph 230 (lambda () (maker (make-blob sizeof-glyph-metrics))))) 231 232 (define (-sdl-unbox-ttf-glyph e) 1669 233 (let ((p (##sys#make-pointer))) 1670 (if e (##core#inline "C_pointer_to_block" p ( sdl-ip-address-buffer e)))234 (if e (##core#inline "C_pointer_to_block" p (ttf-glyph-buffer e))) 1671 235 p)) 1672 236 1673 (define-foreign-type IPaddress (c-pointer "IPaddress") 1674 -sdl-unbox-ip-address) 1675 1676 (define sdl-ip-address-a 1677 (foreign-lambda* unsigned-byte ((IPaddress a)) "C_return(((char *)&(a->host))[0]);")) 1678 (define sdl-ip-address-b 1679 (foreign-lambda* unsigned-byte ((IPaddress a)) "C_return(((char *)&(a->host))[1]);")) 1680 (define sdl-ip-address-c 1681 (foreign-lambda* unsigned-byte ((IPaddress a)) "C_return(((char *)&(a->host))[2]);")) 1682 (define sdl-ip-address-d 1683 (foreign-lambda* unsigned-byte ((IPaddress a)) "C_return(((char *)&(a->host))[3]);")) 1684 1685 (define sdl-ip-address-port 1686 (foreign-lambda* unsigned-short ((IPaddress a)) "C_return(ntohs(a->port));")) 1687 1688 (define sdl-ip-address-port-set! 1689 (foreign-lambda* void ((IPaddress a) 1690 (unsigned-short p)) 1691 "a->port = htons(p);")) 1692 1693 ;--------------------------------------------------------------------------- 1694 1695 (define-record sdl-tcp-socket pointer) 1696 1697 (define-record-printer (sdl-tcp-socket s out) 1698 (for-each (lambda (x) (display x out)) 1699 (list "#<sdl-tcp-socket "(sdl-tcp-socket-pointer s)">"))) 1700 1701 (define-foreign-type TCPsocket (c-pointer (struct "_TCPsocket")) 1702 sdl-tcp-socket-pointer 1703 (pointer-to-record-lambda sdl-tcp-socket)) 1704 1705 ;--------------------------------------------------------------------------- 1706 1707 (define sdl-net-init (foreign-lambda int "SDLNet_Init")) 1708 (define sdl-net-quit (foreign-lambda void "SDLNet_Quit")) 1709 1710 (define sdl-net-resolve-host! 1711 (foreign-lambda int "SDLNet_ResolveHost" IPaddress c-string unsigned-short)) 1712 1713 (define sdl-net-resolve-ip (foreign-lambda c-string "SDLNet_ResolveIP" IPaddress)) 1714 1715 (define (sdl-net-resolve-host hostname port) 1716 (let ((ipa (make-sdl-ip-address 0 0 0 0 0))) 1717 (and (zero? (sdl-net-resolve-host! ipa hostname port)) 1718 ipa))) 1719 1720 (define (-sdl-register-socket sock) 1721 (and sock 1722 (begin 1723 (set-finalizer! sock sdl-net-tcp-close) 1724 sock))) 1725 1726 (define (sdl-net-tcp-open ipa) 1727 (-sdl-register-socket ((foreign-lambda TCPsocket "SDLNet_TCP_Open" IPaddress) ipa))) 1728 1729 (define (sdl-net-tcp-accept serv) 1730 (-sdl-register-socket ((foreign-lambda TCPsocket "SDLNet_TCP_Accept" TCPsocket) serv))) 1731 1732 (define (sdl-net-tcp-get-peer-address sock) 1733 (let ((ipa (make-sdl-ip-address 0 0 0 0 0))) 1734 (if ((foreign-lambda* bool ((TCPsocket sock) 1735 (IPaddress ipa)) 1736 "IPaddress *result = SDLNet_TCP_GetPeerAddress(sock);" 1737 "if (result != NULL) {" 1738 " *ipa = *result;" 1739 " C_return(1);" 1740 "} else {" 1741 " C_return(0);" 1742 "}") 1743 sock ipa) 1744 ipa 1745 #f))) 1746 1747 (define (sdl-net-tcp-send sock bv) 1748 ((foreign-lambda int "SDLNet_TCP_Send" TCPsocket blob integer) 1749 sock bv (blob-size bv))) 1750 1751 (define sdl-net-tcp-recv (foreign-lambda int "SDLNet_TCP_Recv" TCPsocket blob integer)) 1752 1753 (define (sdl-net-tcp-close sock) 1754 (if (sdl-tcp-socket-pointer sock) 1755 (begin 1756 ((foreign-lambda void "SDLNet_TCP_Close" TCPsocket) sock) 1757 (sdl-tcp-socket-pointer-set! sock #f)))) 1758 1759 (define (sdl-net-tcp-send-string sock str) 1760 (sdl-net-tcp-send sock (string->blob str))) 1761 1762 (define (sdl-net-tcp-recv-string sock buflen) 1763 (let* ((bv (make-blob buflen)) 1764 (result (sdl-net-tcp-recv sock bv buflen))) 1765 (if (positive? result) 1766 (substring (blob->string bv) 0 result) 1767 result))) 1768 1769 ;--------------------------------------------------------------------------- 1770 1771 (define-record sdl-net-socket-set pointer) 1772 1773 (define-record-printer (sdl-net-socket-set s out) 1774 (for-each (lambda (x) (display x out)) 1775 (list "#<sdl-net-socket-set "(sdl-net-socket-set-pointer s)">"))) 1776 1777 (define-foreign-type SDLNet_SocketSet (c-pointer (struct "_SDLNet_SocketSet")) 1778 sdl-net-socket-set-pointer 1779 (pointer-to-record-lambda sdl-net-socket-set)) 1780 1781 ;--------------------------------------------------------------------------- 1782 1783 (define sdl-net-alloc-socket-set (foreign-lambda SDLNet_SocketSet "SDLNet_AllocSocketSet" int)) 1784 (define sdl-net-free-socket-set (foreign-lambda void "SDLNet_FreeSocketSet" SDLNet_SocketSet)) 1785 1786 (define sdl-net-tcp-add-socket! 1787 (foreign-lambda int "SDLNet_TCP_AddSocket" SDLNet_SocketSet TCPsocket)) 1788 1789 (define sdl-net-tcp-del-socket! 1790 (foreign-lambda int "SDLNet_TCP_DelSocket" SDLNet_SocketSet TCPsocket)) 1791 1792 (define (sdl-net-check-sockets socket-set timeout) ;; timeout in milliseconds 1793 (let ((result ((foreign-lambda int "SDLNet_CheckSockets" SDLNet_SocketSet unsigned-integer) 1794 socket-set timeout))) 1795 (if (= result -1) 1796 #f 1797 result))) 1798 1799 (define sdl-net-socket-ready? (foreign-lambda bool "SDLNet_SocketReady" TCPsocket)) 1800 1801 ;--------------------------------------------------------------------------- 1802 1803 (define sdl-net-write-16 1804 (foreign-lambda* void ((blob bv) 1805 (int offset) 1806 (unsigned-short value)) 1807 "SDLNet_Write16(value, &bv[offset]);")) 1808 1809 (define sdl-net-write-32 1810 (foreign-lambda* void ((blob bv) 1811 (int offset) 1812 (unsigned-integer value)) 1813 "SDLNet_Write32(value, &bv[offset]);")) 1814 1815 (define sdl-net-read-16 1816 (foreign-lambda* unsigned-short ((blob bv) 1817 (int offset)) 1818 "C_return(SDLNet_Read16(&bv[offset]));")) 1819 1820 (define sdl-net-read-32 1821 (foreign-lambda* unsigned-integer ((blob bv) 1822 (int offset)) 1823 "C_return(SDLNet_Read32(&bv[offset]));")) 1824 1825 ) 237 (define-foreign-type GlyphMetrics (c-pointer "GlyphMetrics") 238 -sdl-unbox-ttf-glyph) 239 240 (define-record-printer (ttf-glyph o out) 241 (fprintf out "#<ttf-glyph minx: ~S maxx: ~S miny: ~S maxy: ~S adv: ~S>" 242 (ttf-glyph-minx o) 243 (ttf-glyph-maxx o) 244 (ttf-glyph-miny o) 245 (ttf-glyph-maxy o) 246 (ttf-glyph-advance o))) 247 248 (define ttf-glyph-minx (foreign-lambda* int ((GlyphMetrics o)) "C_return(o->minx);")) 249 (define ttf-glyph-maxx (foreign-lambda* int ((GlyphMetrics o)) "C_return(o->maxx);")) 250 (define ttf-glyph-miny (foreign-lambda* int ((GlyphMetrics o)) "C_return(o->miny);")) 251 (define ttf-glyph-maxy (foreign-lambda* int ((GlyphMetrics o)) "C_return(o->maxy);")) 252 (define ttf-glyph-advance (foreign-lambda* int ((GlyphMetrics o)) "C_return(o->adv);")) 253 254 (define ttf-glyph-metrics 255 (foreign-lambda* 256 bool ((TTF_Font font) 257 (unsigned-int c) 258 (GlyphMetrics gm)) 259 "C_return((0 == TTF_GlyphMetrics(font, c, &gm->minx, &gm->maxx, &gm->miny, &gm->maxy, &gm->adv)));"))) -
release/4/sdl-ttf/trunk/sdl-ttf.setup
r27336 r27337 1 1 ;;;; sdl.setup -*- Scheme -*- 2 3 4 (define (check-depends)5 6 (let* ((lib-fun-pack '(("SDL" "SDL_Init" "libsdl1.2-dev")7 ("SDL_gfx" "polygonColor" "libsdl-gfx1.2-dev")8 ("SDL_net" "SDLNet_Init" "libsdl-net1.2-dev")9 ("SDL_ttf" "TTF_Init" "libsdl-ttf2.0-dev")10 ("SDL_image" "IMG_Init" "libsdl-image1.2-dev")))11 (missing (filter (lambda (lib-fun)12 (not (find-library (first lib-fun) (second lib-fun))))13 lib-fun-pack)))14 (for-each15 (lambda (lib-fun)16 (print "\nWARNING: You seem to be missing the library " (first lib-fun) "!"))17 missing)18 (cond-expand19 (linux20 (unless (null? missing)21 (print "\nSuggested package(s) to install: " (map third missing))))22 (else #f))))23 24 (check-depends)25 2 26 3 (let* ((escape-flags (lambda (fs) … … 35 12 (escape-flags 36 13 (with-input-from-pipe "sdl-config --cflags" read-line)))) 37 (sdl-lflags (apply string-append 38 ;; sdl-config doesn't give these 39 " -lSDL_gfx -lSDL_net -lSDL_ttf -lSDL_image" 40 (escape-flags 41 (with-input-from-pipe "sdl-config --libs" read-line)))) 14 42 15 (types? (version>=? (chicken-version) "4.7.4")) 43 (files (append '("sdl .so"44 "sdl .import.so"45 "sdl-foreign-types-include.scm")46 (if types? '("sdl.types") '()))))47 (compile ,@(if types? '(-emit-type-file sdl.types) '())48 -s -O3 - d1 sdl.scm -j sdl -lSDL ,sdl-cflags ,sdl-lflags)49 (compile -s -O3 -d0 sdl .import.scm ,sdl-cflags ,sdl-lflags)16 (files (append '("sdl-ttf.so" 17 "sdl-ttf.import.so") 18 (if types? '("sdl-ttf.types") '())))) 19 (compile ,@(if types? '(-emit-type-file sdl-ttf.types) '()) 20 -I ,(repository-path) 21 -s -O3 -v -d1 sdl-ttf.scm -j sdl-ttf ,sdl-cflags -lSDL_ttf) 22 (compile -s -O3 -d0 sdl-ttf.import.scm) 50 23 51 (install-extension 'sdl files '((version "0.5.5"))))24 (install-extension 'sdl-ttf files '((version "0.1")))) 52 25
Note: See TracChangeset
for help on using the changeset viewer.