Ticket #86: sdl.diff

File sdl.diff, 18.7 KB (added by Christian Kellermann, 15 years ago)

  • sdl-csi.scm

     
     1(import foreign)
     2
    13(declare
    24 (foreign-declare "#include <SDL.h>\n")
    35 (run-time-macros)
    … …  
    68
    79(require-extension posix)
    810(require-extension sdl)
    9 (require-extension syntax-case)
    1011
    1112(handle-exceptions
    1213    exn

  • test-sdl.scm

     
    11(declare (foreign-declare "#include <SDL.h>\n"))
    22(foreign-code "SDL_Init(SDL_INIT_EVERYTHING);")
    33
    4 (require 'posix)
    5 (require 'sdl)
     4(use posix)
     5(use sdl)
     6(sdl-init SDL_INIT_EVERYTHING)
     7(include "test-sdl-body.scm")
    68
    7 (load "test-sdl-body.scm")
    8 
    99(sdl-quit)
    1010(exit 0)

  • sdl.setup

     
    1 (run (make extension))
    2 (install-extension 'sdl '("sdl.so") '((version "v0.4.51117.5")))
     1(let ((sdl-cflags (with-input-from-pipe "sdl-config --cflags" read-line))
     2      (sdl-lflags (string-append (with-input-from-pipe "sdl-config --libs" read-line) " -lSDL_gfx -lSDL_net -lSDL_ttf -lSDL_image")))
     3   (compile -s -O2 sdl.scm -j sdl -lsdl ,sdl-cflags ,sdl-lflags)
     4   (compile -c -O2 sdl.scm -unit sdl ,sdl-cflags ,sdl-lflags)
     5   (compile -s -O2 sdl.import.scm ,sdl-cflags ,sdl-lflags)
     6   (compile -O2 sdl-csi.scm ,sdl-cflags ,sdl-lflags))
     7
     8(install-extension 'sdl '("sdl.so" "sdl.import.so" "sdl.o") '((version "v0.4.51117.5")))
    39(install-program 'sdl-csi '("sdl-csi"))

  • sdl.scm

     
    1 ;;; sdl.scm - Simple SDL binding for Chicken
     1;;;; sdl.scm - Simple SDL binding for Chicken
    22; Copyright (C) 2002-2004 Tony Garnock-Jones <tonyg@kcbbs.gen.nz>
    33;
    44; This library is free software; you can redistribute it and/or modify
    … …  
    1818
    1919; ---------------------------------------------------------------------------
    2020
    21 (declare
    22  (usual-integrations)
     21(module sdl
    2322
    24  ;; %%% export declaration should go here
     23( *sdl-egg-version*
    2524
    26  (foreign-declare #<<EOF
     25  SDL_BUTTON
     26  ; sdl gfx
     27  make-sdl-rect
     28  sdl-rect?
     29  sdl-rect-x
     30  sdl-rect-y
     31  sdl-rect-w
     32  sdl-rect-h
     33  make-sdl-pixel-format
     34  sdl-pixel-format?
     35  sdl-pixel-format-bytes-per-pixel
     36  sdl-surface-flags
     37  sdl-surface-pixel-format
     38  sdl-surface-width
     39  sdl-surface-height
     40  sdl-surface-pitch
     41  sdl-surface-pixels
     42  sdl-surface-pixels-length
     43  sdl-get-clip-rect!
     44  sdl-set-clip-rect!
     45  sdl-set-color-key!
     46  sdl-set-alpha!
     47  sdl-display-format
     48  sdl-display-format-alpha
     49  sdl-convert-surface
    2750
     51  ; sdl system stuff
     52  sdl-init
     53  sdl-init-sub-system
     54  sdl-quit-sub-system
     55  sdl-quit
     56  sdl-was-init
     57  sdl-get-error
     58  sdl-clear-error!
     59  sdl-wm-set-caption
     60  sdl-wm-get-caption-title
     61  sdl-wm-get-caption-icon
     62  sdl-wm-get-caption
     63  sdl-wm-set-icon
     64  sdl-wm-iconify-window
     65  sdl-wm-toggle-full-screen
     66  sdl-wm-grab-input
     67  sdl-get-ticks
     68  sdl-delay
     69  timer?
     70  get-time-of-day
     71  get-time-of-day
     72  sdl-add-relative-timer!
     73  make-sdl-event
     74  sdl-event?
     75  sdl-event-type
     76  sdl-pump-events
     77  sdl-poll-event!
     78  sdl-wait-event!*
     79  sdl-wait-event!
     80  sdl-push-event
     81  sdl-event-state!
     82  sdl-get-mouse-state
     83  sdl-enable-unicode
     84  sdl-get-video-surface
     85  sdl-video-driver-name
     86  sdl-set-video-mode
     87  sdl-video-mode-ok
     88  sdl-show-cursor
     89  sdl-map-rgb
     90  sdl-map-rgba
     91  sdl-fill-rect
     92  sdl-flip
     93  sdl-surface?
     94  sdl-create-rgb-surface
     95  sdl-free-surface
     96  sdl-blit-surface
     97  sdl-with-clip-rect
     98  make-sdl-color
     99  sdl-color?
     100  sdl-color-r
     101  sdl-color-g
     102  sdl-color-b
     103
     104  make-sdl-joystick
     105  sdl-joystick?
     106  sdl-joystick-event-state
     107  sdl-joystick-update
     108  sdl-num-joysticks
     109  sdl-joystick-name
     110  sdl-joystick-open
     111  sdl-joystick-opened
     112  sdl-joystick-index
     113  sdl-joystick-num-axes
     114  sdl-joystick-num-balls
     115  sdl-joystick-num-hats
     116  sdl-joystick-num-buttons
     117  sdl-joystick-update
     118  sdl-joystick-get-axis
     119  sdl-joystick-get-hat
     120  sdl-joystick-get-button
     121  sdl-joystick-close
     122  sdl-gl-swap-buffers
     123  sdl-gl-set-attribute
     124  sdl-gl-get-attribute
     125
     126  ; SDL ttf
     127  ttf-init
     128  ttf-was-init
     129  ttf-quit
     130  ttf-font?
     131  ttf-font-pointer
     132  ttf-open-font
     133  ttf-open-font-index
     134  ttf-close-font
     135  ttf-get-font-style
     136  ttf-set-font-style
     137  ttf-font-height
     138  ttf-font-ascent
     139  ttf-font-descent
     140  ttf-font-line-skip
     141  ttf-font-faces
     142  ttf-font-face-is-fixed-width?
     143  ttf-font-face-family-name
     144  ttf-font-face-style-name
     145  ttf-size-text!
     146  ttf-size-utf8!
     147  ttf-render-text-solid
     148  ttf-render-utf8-solid
     149  ttf-render-text-shaded
     150  ttf-render-utf8-shaded
     151  ttf-render-text-blended
     152  ttf-render-utf8-blended
     153
     154  ; SDL image
     155  img-load
     156  rotozoom-surface
     157  zoom-surface
     158
     159  ;SDL net
     160  make-sdl-ip-address
     161  sdl-ip-address?
     162  sdl-ip-address-a
     163  sdl-ip-address-b
     164  sdl-ip-address-c
     165  sdl-ip-address-d
     166  sdl-ip-address-port
     167  sdl-net-init
     168  sdl-net-quit
     169  sdl-net-resolve-host!
     170  sdl-net-resolve-ip
     171  sdl-net-resolve-host
     172  make-sdl-tcp-socket
     173  sdl-tcp-socket?
     174  sdl-net-tcp-open
     175  sdl-net-tcp-accept
     176  sdl-net-tcp-get-peer-address
     177  sdl-net-tcp-send
     178  sdl-net-tcp-recv
     179  sdl-net-tcp-close
     180  sdl-net-tcp-send-string
     181  sdl-net-tcp-recv-string
     182  sdl-net-tcp-add-socket!
     183  sdl-net-tcp-del-socket!
     184  sdl-net-check-sockets
     185  sdl-net-socket-ready?
     186  sdl-net-socket-set?
     187  sdl-net-socket-set-pointer-set!
     188  sdl-net-write-16
     189  sdl-net-write-32
     190  sdl-net-read-16
     191  sdl-net-read-32
     192
     193  sdl-event?
     194  sdl-event-gain
     195  set-sdl-event-gain!
     196  sdl-event-which
     197  set-sdl-event-which!
     198  sdl-event-state
     199  set-sdl-event-state!
     200  sdl-event-scancode
     201  set-sdl-event-scancode!
     202  sdl-event-sym
     203  set-sdl-event-sym!
     204  sdl-event-mod
     205  set-sdl-event-mod!
     206  sdl-event-unicode
     207  set-sdl-event-unicode!
     208  sdl-event-x
     209  set-sdl-event-x!
     210  sdl-event-y
     211  set-sdl-event-y!
     212  sdl-event-xrel
     213  set-sdl-event-xrel!
     214  sdl-event-yrel
     215  set-sdl-event-yrel!
     216  sdl-event-axis
     217  set-sdl-event-axis!
     218  sdl-event-ball
     219  set-sdl-event-ball!
     220  sdl-event-hat
     221  set-sdl-event-hat!
     222  sdl-event-value
     223  set-sdl-event-value!
     224  sdl-event-button
     225  set-sdl-event-button!
     226  sdl-event-w
     227  set-sdl-event-w!
     228  sdl-event-h
     229  set-sdl-event-h!
     230  sdl-event-buffer-set!
     231  heap?
     232 
     233
     234  ; constants
     235
     236  SDL_INIT_TIMER
     237  SDL_INIT_AUDIO
     238  SDL_INIT_VIDEO
     239  SDL_INIT_CDROM
     240  SDL_INIT_JOYSTICK
     241  SDL_INIT_EVERYTHING
     242  SDL_INIT_NOPARACHUTE
     243
     244  ;; For sdl-creatergbsurface or sdl-setvideomode
     245  SDL_SWSURFACE
     246  SDL_HWSURFACE
     247  SDL_ASYNCBLIT
     248  ;; For sdl-setvideomode
     249  SDL_ANYFORMAT
     250  SDL_HWPALETTE
     251  SDL_DOUBLEBUF
     252  SDL_FULLSCREEN
     253  SDL_OPENGL
     254  SDL_OPENGLBLIT
     255  SDL_RESIZABLE
     256  SDL_NOFRAME
     257  ;; Read-only - internal
     258  SDL_HWACCEL
     259  SDL_SRCCOLORKEY
     260  SDL_RLEACCELOK
     261  SDL_RLEACCEL
     262  SDL_SRCALPHA
     263  SDL_PREALLOC
     264                                        ; For sdl-wm-grabinput
     265  SDL_GRAB_QUERY
     266  SDL_GRAB_OFF
     267  SDL_GRAB_ON
     268
     269
     270  SDL_NOEVENT                   ; Unused (do not remove)
     271  SDL_ACTIVEEVENT               ; Application loses/gains visibility
     272  SDL_KEYDOWN                   ; Keys pressed
     273  SDL_KEYUP                     ; Keys released
     274  SDL_MOUSEMOTION               ; Mouse moved
     275  SDL_MOUSEBUTTONDOWN           ; Mouse button pressed
     276  SDL_MOUSEBUTTONUP             ; Mouse button released
     277  SDL_JOYAXISMOTION             ; Joystick axis motion
     278  SDL_JOYBALLMOTION             ; Joystick trackball motion
     279  SDL_JOYHATMOTION              ; Joystick hat position change
     280  SDL_JOYBUTTONDOWN             ; Joystick button pressed
     281  SDL_JOYBUTTONUP               ; Joystick button released
     282  SDL_QUIT                      ; User-requested quit
     283  SDL_SYSWMEVENT                ; System specific event
     284  SDL_EVENT_RESERVEDA           ; Reserved for future use..
     285  SDL_EVENT_RESERVEDB           ; Reserved for future use..
     286  SDL_VIDEORESIZE               ; User resized video mode
     287  SDL_VIDEOEXPOSE               ; Screen needs to be redrawn
     288  SDL_EVENT_RESERVED2           ; Reserved for future use..
     289  SDL_EVENT_RESERVED3           ; Reserved for future use..
     290  SDL_EVENT_RESERVED4           ; Reserved for future use..
     291  SDL_EVENT_RESERVED5           ; Reserved for future use..
     292  SDL_EVENT_RESERVED6           ; Reserved for future use..
     293  SDL_EVENT_RESERVED7           ; Reserved for future use..
     294  SDL_USEREVENT                 ; SDL_USEREVENT .. SDL_NUMEVENTS are for client use
     295  SDL_NUMEVENTS
     296
     297  SDL_ACTIVEEVENTMASK
     298  SDL_KEYDOWNMASK
     299  SDL_KEYUPMASK
     300  SDL_MOUSEMOTIONMASK
     301  SDL_MOUSEBUTTONDOWNMASK
     302  SDL_MOUSEBUTTONUPMASK
     303  SDL_MOUSEEVENTMASK
     304  SDL_JOYAXISMOTIONMASK
     305  SDL_JOYBALLMOTIONMASK
     306  SDL_JOYHATMOTIONMASK
     307  SDL_JOYBUTTONDOWNMASK
     308  SDL_JOYBUTTONUPMASK
     309  SDL_JOYEVENTMASK
     310  SDL_VIDEORESIZEMASK
     311  SDL_VIDEOEXPOSEMASK
     312  SDL_QUITMASK
     313  SDL_SYSWMEVENTMASK
     314  SDL_ALLEVENTS
     315                                        ; General button/key states
     316  SDL_PRESSED
     317  SDL_RELEASED
     318                                        ; Mouse button states
     319  SDL_BUTTON_LEFT
     320  SDL_BUTTON_MIDDLE
     321  SDL_BUTTON_RIGHT
     322  SDL_BUTTON_WHEELUP
     323  SDL_BUTTON_WHEELDOWN
     324  SDL_BUTTON_LMASK ; = SDL_BUTTON(SDL_BUTTON_LEFT)
     325  SDL_BUTTON_MMASK ; = SDL_BUTTON(SDL_BUTTON_MIDDLE)
     326  SDL_BUTTON_RMASK ; = SDL_BUTTON(SDL_BUTTON_RIGHT)
     327  SDL_QUERY
     328  SDL_IGNORE
     329  SDL_DISABLE
     330  SDL_ENABLE
     331
     332  SDL_GL_RED_SIZE
     333  SDL_GL_GREEN_SIZE
     334  SDL_GL_BLUE_SIZE
     335  SDL_GL_ALPHA_SIZE
     336  SDL_GL_BUFFER_SIZE
     337  SDL_GL_DOUBLEBUFFER
     338  SDL_GL_DEPTH_SIZE
     339  SDL_GL_STENCIL_SIZE
     340  SDL_GL_ACCUM_RED_SIZE
     341  SDL_GL_ACCUM_GREEN_SIZE
     342  SDL_GL_ACCUM_BLUE_SIZE
     343  SDL_GL_ACCUM_ALPHA_SIZE
     344  SDL_GL_STEREO
     345  SDL_GL_MULTISAMPLEBUFFERS
     346  SDL_GL_MULTISAMPLESAMPLES
     347  SDL_GL_SWAP_CONTROL
     348  SDL_GL_ACCELERATED_VISUAL
     349
     350  TTF_STYLE_NORMAL
     351  TTF_STYLE_BOLD
     352  TTF_STYLE_ITALIC
     353  TTF_STYLE_UNDERLINE
     354
     355)
     356
     357;---------------------------------------------------------------------------
     358
     359(import chicken scheme foreign)
     360(use srfi-1)
     361(use srfi-4)
     362(use srfi-13)
     363(use srfi-18)
     364(use lolevel)
     365
     366(foreign-declare #<<EOF
     367
    28368#ifdef _WIN32
    29369# if _MSC_VER > 1300
    30370#  include <winsock2.h>
    … …  
    47387#include "SDL_net.h"
    48388
    49389EOF
    50 ))
     390)
    51391
    52 (use srfi-1)
    53 (use srfi-13)
    54 (use lolevel)
    55  
    56392(include "heap.scm")
    57393(include "timer.scm")
    58394
    … …  
    66402
    67403;---------------------------------------------------------------------------
    68404
    69 (define-macro (--sdl-flags . strs)
    70   `(begin
     405(define-syntax --sdl-flags
     406  (lambda (e r c)
     407      `(,(r 'begin)
    71408     ,@(append-map (lambda (str)
    72409                     (let* ((sym (string->symbol str))
    73                             (psym (string->symbol (string-append "-" (symbol->string sym)))))
    74                        `((define-foreign-variable ,psym unsigned-integer ,str)
    75                          (define ,sym ,psym))))
    76                    strs)))
     410                            (psym (string->symbol (string-append "-" str))))
     411                       `((,(r 'define-foreign-variable) ,psym unsigned-integer ,str)
     412                         (,(r 'define) ,sym ,psym))))
     413                   (cdr e)))))
    77414
    78415; Subsystem definitions, for sdl-init etc.
    79416(--sdl-flags "SDL_INIT_TIMER"
    … …  
    202539(let ((maker make-sdl-rect))
    203540  (set! make-sdl-rect
    204541        (lambda (x y w h)
    205           (let ((r (maker (make-byte-vector sizeof-sdl-rect))))
     542          (let ((r (maker (make-blob sizeof-sdl-rect))))
    206543            (sdl-rect-x-set! r x)
    207544            (sdl-rect-y-set! r y)
    208545            (sdl-rect-w-set! r w)
    … …  
    365702                    "return(i);")))
    366703
    367704(define (sdl-wm-get-caption)
    368   (values (sdl-wm-getcaption-title)
    369           (sdl-wm-getcaption-icon)))
     705  (values (sdl-wm-get-caption-title)
     706          (sdl-wm-get-caption-icon)))
    370707
    371708(define (sdl-wm-set-icon icon mask)
    372   ((foreign-lambda void "SDL_WM_SetIcon" SDL_Surface byte-vector) icon mask))
     709  ((foreign-lambda void "SDL_WM_SetIcon" SDL_Surface blob) icon mask))
    373710
    374711(define (sdl-wm-iconify-window)
    375712  (not (zero? ((foreign-lambda integer "SDL_WM_IconifyWindow")))))
    … …  
    412749(let ((maker make-sdl-event))
    413750  (set! make-sdl-event
    414751        (lambda ()
    415           (let ((bv (make-byte-vector sizeof-sdl-event)))
    416             (byte-vector-set! bv 0 SDL_NOEVENT)
    417             (maker bv)))))
     752          (let ((bv (blob->u8vector (make-blob sizeof-sdl-event))))
     753            (u8vector-set! bv 0 SDL_NOEVENT)
     754            (maker (u8vector->blob bv))))))
    418755
    419756(define-record-printer (sdl-event s out)
    420757  (for-each (lambda (x) (display x out))
    … …  
    431768(define sdl-event-type (foreign-lambda* unsigned-byte ((SDL_Event e)) "return(e->type);"))
    432769(define sdl-event-type-set! (foreign-lambda* void ((SDL_Event e) (unsigned-byte t)) "e->type = t;"))
    433770
    434 (define-macro (--sdl-event-getter-setter name . rest)
    435   (let* ((strapp (lambda s (apply string-append
     771(define-syntax --sdl-event-getter-setter
     772  (lambda (f r c)
     773    (let ((name (cadr f))
     774          (rest (cddr f)))
     775      (let* ((strapp (lambda s (apply string-append
    436776                                  (map (lambda (x) (cond
    437777                                                    ((symbol? x) (symbol->string x))
    438778                                                    (else x)))
    439779                                       s))))
    440780         (symapp (lambda s (string->symbol (apply strapp s)))))
    441   `(begin
    442      (define (,(symapp "sdl-event-" name) e)
    443        (let ((t (sdl-event-type e)))
    444          (cond
     781  `(,(r 'begin)
     782     (,(r 'define) (,(symapp "sdl-event-" name) e)
     783       (,(r 'let) ((,(r 't) (,(r 'sdl-event-type) e)))
     784         (,(r 'cond)
    445785          ,@(map (lambda (clause)
    446786                   (apply (lambda (etype mem1 kind)
    447                             `((= t ,etype) ((foreign-lambda*
     787                            `((,(r '=) ,(r 't) ,etype) ((,(r 'foreign-lambda*)
    448788                                             ,kind ((SDL_Event e))
    449789                                             ,(strapp "return(e->"mem1"."name");")) e)))
    450790                          clause))
    451791                 rest)
    452           (else (error ,(string-append "sdl-event-" (symbol->string name)
     792          (,(r 'else) (,(r 'error) ,(string-append "sdl-event-" (symbol->string name)
    453793                                       ": cannot extract value from this type of event")
    454                        (sdl-event-type e))))))
    455      (define (,(symapp "set-sdl-event-" name "!") e v)
    456        (let ((t (sdl-event-type e)))
    457          (cond
     794                       (,(r 'sdl-event-type) e))))))
     795     (,(r 'define) (,(symapp "set-sdl-event-" name "!") e v)
     796       (,(r 'let) ((t (,(r 'sdl-event-type) e)))
     797         (,(r 'cond)
    458798          ,@(map (lambda (clause)
    459799                   (apply (lambda (etype mem1 kind)
    460                             `((= t ,etype) ((foreign-lambda*
     800                            `((,(r '=) t ,etype) ((,(r 'foreign-lambda*)
    461801                                             void ((SDL_Event e)
    462802                                                   (,kind v))
    463803                                             ,(strapp "e->"mem1"."name"=v;")) e v)))
    464804                          clause))
    465805                 rest)
    466           (else (error ,(string-append "set-sdl-event-" (symbol->string name) "!"
     806          (,(r 'else) (,(r 'error) ,(string-append "set-sdl-event-" (symbol->string name) "!"
    467807                                       ": cannot update value for this type of event")
    468                        (sdl-event-type e)))))))))
     808                       (,(r 'sdl-event-type) e)))))))))))
    469809
    470810(--sdl-event-getter-setter gain         (SDL_ACTIVEEVENT active bool))
    471811(--sdl-event-getter-setter which        (SDL_KEYDOWN key unsigned-byte)
    … …  
    584924(define sdl-get-video-surface (foreign-lambda SDL_Surface "SDL_GetVideoSurface"))
    585925
    586926(define (sdl-video-driver-name)
    587   (let ((bv (make-byte-vector 128 0)))
    588     (and ((foreign-lambda bool "SDL_VideoDriverName" byte-vector integer)
     927  (let ((bv (make-blob 128 0)))
     928    (and ((foreign-lambda bool "SDL_VideoDriverName" blob integer)
    589929          bv
    590           (byte-vector-length bv))
    591          (string-trim-right (byte-vector->string bv)
     930          (blob-size bv))
     931         (string-trim-right (blob->string bv)
    592932                            (integer->char 0)))))
    593933
    594934(define sdl-set-video-mode (foreign-lambda SDL_Surface "SDL_SetVideoMode"
    … …  
    6741014(let ((maker make-sdl-color))
    6751015  (set! make-sdl-color
    6761016        (lambda (r g b)
    677           (let ((bv (make-byte-vector sizeof-sdl-color)))
     1017          (let ((bv (make-blob sizeof-sdl-color)))
    6781018            (fill-sdl-color! (maker bv) r g b)))))
    6791019
    6801020(define-record-printer (sdl-color s out)
    … …  
    8891229(let ((maker make-sdl-ip-address))
    8901230  (set! make-sdl-ip-address
    8911231        (lambda (a b c d p)
    892           (let* ((bv (make-byte-vector sizeof-sdl-ip-address))
     1232          (let* ((bv (make-blob sizeof-sdl-ip-address))
    8931233                 (addr (maker bv)))
    894             ((foreign-lambda* void ((byte-vector bv)
     1234            ((foreign-lambda* void ((blob bv)
    8951235                                    (unsigned-integer host)
    8961236                                    (unsigned-short port))
    8971237                              "IPaddress *ipa = (IPaddress *) bv;"
    … …  
    9981338        #f)))
    9991339
    10001340(define (sdl-net-tcp-send sock bv)
    1001   ((foreign-lambda int "SDLNet_TCP_Send" TCPsocket byte-vector integer)
    1002    sock bv (byte-vector-length bv)))
     1341  ((foreign-lambda int "SDLNet_TCP_Send" TCPsocket blob integer)
     1342   sock bv (blob-size bv)))
    10031343
    1004 (define sdl-net-tcp-recv (foreign-lambda int "SDLNet_TCP_Recv" TCPsocket byte-vector integer))
     1344(define sdl-net-tcp-recv (foreign-lambda int "SDLNet_TCP_Recv" TCPsocket blob integer))
    10051345
    10061346(define (sdl-net-tcp-close sock)
    10071347  (if (sdl-tcp-socket-pointer sock)
    … …  
    10101350        (sdl-tcp-socket-pointer-set! sock #f))))
    10111351
    10121352(define (sdl-net-tcp-send-string sock str)
    1013   (sdl-net-tcp-send sock (string->byte-vector str)))
     1353  (sdl-net-tcp-send sock (string->blob str)))
    10141354
    10151355(define (sdl-net-tcp-recv-string sock buflen)
    1016   (let* ((bv (make-byte-vector buflen))
     1356  (let* ((bv (make-blob buflen))
    10171357         (result (sdl-net-tcp-recv sock bv buflen)))
    10181358    (if (positive? result)
    1019         (substring (byte-vector->string bv) 0 result)
     1359        (substring (blob->string bv) 0 result)
    10201360        result)))
    10211361
    10221362;---------------------------------------------------------------------------
    … …  
    10581398;---------------------------------------------------------------------------
    10591399
    10601400(define sdl-net-write-16
    1061   (foreign-lambda* void ((byte-vector bv)
     1401  (foreign-lambda* void ((blob bv)
    10621402                         (int offset)
    10631403                         (unsigned-short value))
    10641404                   "SDLNet_Write16(value, &bv[offset]);"))
    10651405
    10661406(define sdl-net-write-32
    1067   (foreign-lambda* void ((byte-vector bv)
     1407  (foreign-lambda* void ((blob bv)
    10681408                         (int offset)
    10691409                         (unsigned-integer value))
    10701410                   "SDLNet_Write32(value, &bv[offset]);"))
    10711411
    10721412(define sdl-net-read-16
    1073   (foreign-lambda* unsigned-short ((byte-vector bv)
     1413  (foreign-lambda* unsigned-short ((blob bv)
    10741414                                   (int offset))
    10751415                   "return(SDLNet_Read16(&bv[offset]));"))
    10761416
    10771417(define sdl-net-read-32
    1078   (foreign-lambda* unsigned-integer ((byte-vector bv)
     1418  (foreign-lambda* unsigned-integer ((blob bv)
    10791419                                     (int offset))
    10801420                   "return(SDLNet_Read32(&bv[offset]));"))
    10811421
    1082 
     1422)

  • test-net.scm

     
    1 (require 'posix)
     1(use posix)
     2(use sdl)
    23
    34(sdl-net-init)
    45

  • sdl.meta

     
    44 (author "Tony Garnock-Jones")
    55 (synopsis "Basic SDL support")
    66 (license "LGPL-2.1")
    7  (needs syntax-case)
    87 (doc-from-wiki)
    98 (egg "sdl.egg")
    109 (files "COPYING"

  • test-heap.scm

     
    1 (require 'srfi-1)
    2 (require 'heap)
     1(use srfi-1)
     2(use srfi-9)
     3(use sdl)
    34
    45(define-values (s-heap-insert
    56                s-heap-merge

  • test-sdl-body.scm

     
     1(require-extension sdl)
    12(define maxx 640)
    23(define maxy 480)
    34
    … …  
    34(if (< (length (argv)) 2)
    45    (begin (display "Usage: test-sdl path-to-ttf-font")
    5            (newline)
     6           (newline)
    67           (exit 1)))
    78(define fontname (cadr (argv)))
    8 
    99(ttf-init)
    1010