35 lines
1.0 KiB
Plaintext
35 lines
1.0 KiB
Plaintext
(defvarl SDL_INIT_VIDEO #x00000020)
|
|
(defvarl SDL_SWSURFACE #x00000000)
|
|
(defvarl SDL_HWPALETTE #x20000000)
|
|
|
|
(typedef SDL_Surface (cptr SDL_Surface))
|
|
|
|
(typedef SDL_EventType (enumed uint8 SDL_EventType
|
|
(SDL_KEYUP 3)
|
|
(SDL_QUIT 12)))
|
|
|
|
(typedef SDL_Event (union SD_Event
|
|
(type SDL_EventType)
|
|
(pad (array 8 uint32))))
|
|
|
|
|
|
(with-dyn-lib "libSDL.so"
|
|
(deffi SDL_Init "SDL_Init" int (uint32))
|
|
(deffi SDL_SetVideoMode "SDL_SetVideoMode"
|
|
SDL_Surface (int int int uint32))
|
|
(deffi SDL_GetError "SDL_GetError" str ())
|
|
(deffi SDL_WaitEvent "SDL_WaitEvent" int ((ptr-out SDL_Event)))
|
|
(deffi SDL_Quit "SDL_Quit" void ()))
|
|
|
|
(when (neql 0 (SDL_Init SDL_INIT_VIDEO))
|
|
(put-string `unable to initialize SDL: @(SDL_GetError)`)
|
|
(exit nil))
|
|
|
|
(unwind-protect
|
|
(progn
|
|
(SDL_SetVideoMode 800 600 16 (logior SDL_SWSURFACE SDL_HWPALETTE))
|
|
(let ((e (make-union (ffi SDL_Event))))
|
|
(until* (memql (union-get e 'type) '(SDL_KEYUP SDL_QUIT))
|
|
(SDL_WaitEvent e))))
|
|
(SDL_Quit))
|