Artifact
9164e688a1f46e88936ae4ffb632f94100a19ca2:
- File
sdl2/init.ss
— part of check-in
[af432e7ef4]
at
2016-11-08 16:17:36
on branch trunk
— fixed bug in sdl-library-init
(user:
aldo
size: 2119)
(define (sdl-library-init . l)
#;(import (only (sdl2 video) sdl-window-t sdl-destroy-window)
(only (sdl2 surface) sdl-surface-t sdl-free-surface)
(only (sdl2 render) sdl-texture-t sdl-destroy-texture sdl-renderer-t sdl-destroy-renderer)
(only (sdl2 mutex) sdl-mutex-t sdl-destroy-mutex sdl-cond-t sdl-destroy-cond)
(only (sdl2 mouse) sdl-cursor-t sdl-free-cursor)
(only (sdl2 pixels) sdl-pixel-format-t sdl-free-format sdl-palette-t sdl-free-palette)
(only (sdl2 rwops) sdl-rw-ops-t sdl-free-rw)
(only (sdl2 guardian) sdl-guardian sdl-free-garbage))
(load-shared-object (if (null? l) "libSDL2.so" (car l)))
(sdl-free-garbage-set-func
(lambda ()
(let loop ([p (sdl-guardian)])
(when p
(when (ftype-pointer? p)
;(printf "sdl-free-garbage: freeing memory at ~x\n" p)
;;[(ftype-pointer? usb-device*-array p)
(cond
[(ftype-pointer? sdl-window-t p) (sdl-destroy-window p)]
[(ftype-pointer? sdl-surface-t p) (sdl-free-surface p)]
[(ftype-pointer? sdl-texture-t p) (sdl-destroy-texture p)]
[(ftype-pointer? sdl-renderer-t p) (sdl-destroy-renderer p)]
[(ftype-pointer? sdl-mutex-t p) (sdl-destroy-mutex p)]
[(ftype-pointer? sdl-sem-t p) (sdl-destroy-semaphore p)]
[(ftype-pointer? sdl-cond-t p) (sdl-destroy-cond p)]
[(ftype-pointer? sdl-cursor-t p) (sdl-free-cursor p)]
[(ftype-pointer? sdl-pixel-format-t p) (sdl-free-format p)]
[(ftype-pointer? sdl-palette-t p) (sdl-free-palette p)]
[(ftype-pointer? sdl-rw-ops-t p) (sdl-free-rw p)]
[else
(foreign-free (ftype-pointer-address p))]
))
(loop (sdl-guardian)))))))
(define-flags sdl-initialization
(timer #x00000001)
(audio #x00000010)
(video #x00000020)
(joystick #x00000200)
(haptic #x00001000)
(game-controller #x00002000)
(events #x00004000)
(no-parachute #x00100000))
;; calculates 'everything flag
(define sdl-initialization-everything
(fold (lambda (x acc) (logor (cdr x) acc) ) 0 (flags-alist sdl-initialization-flags)))