sdlwrapper.c

#include <SDL.h>        
#include <stdlib.h>

struct Game {
    SDL_Surface *screen;
    int key_states[SDLK_LAST];
    int running;
};

int timer_cb(int interval)
{
    SDL_Event event;
    event.type = SDL_USEREVENT;
    SDL_PushEvent(&event);
    return interval;
}

extern struct Game *
game_init(int width, int height)
{
    SDL_Init(SDL_INIT_VIDEO | SDL_INIT_TIMER);

    struct Game *game = malloc(sizeof(struct Game));
    game->screen = SDL_SetVideoMode(width, height, 0, SDL_HWSURFACE | SDL_DOUBLEBUF);
    memset(game->key_states, 0, sizeof(int) * SDLK_LAST);
    game->running = 1;

    SDL_WM_SetCaption("Perl 6 SDL Game", 0);
    SDL_EnableKeyRepeat(1, SDL_DEFAULT_REPEAT_INTERVAL);
    SDL_AddTimer(16, (SDL_NewTimerCallback)timer_cb, NULL);

    return game;
}

extern SDL_Surface *
game_get_surface(struct Game *game)
{
    return game->screen;
}


extern int
game_is_pressed(struct Game *game, int idx)
{
    return game->key_states[idx];
}

extern int
game_is_running(struct Game *game)
{
    return game->running;
}

//waits until a timer tick appears
extern void
game_wait(struct Game *game)
{
    SDL_Event event;
    for (;;) {
        SDL_WaitEvent(&event);
        switch (event.type) {
        case SDL_USEREVENT: // timer
            return;
        case SDL_KEYDOWN:
            game->key_states[event.key.keysym.sym] = 1;
            break;
        case SDL_KEYUP:
            game->key_states[event.key.keysym.sym] = 0;
            break;
        case SDL_QUIT:
            game->running = 0;
            break;
        }
    }
}

extern void
game_free(struct Game *game)
{
    free(game);
}

test.pl

use v6;
use NativeCall;

my $name = 'sdlwrapper';
my $o  = $*VM<config><o>;
my $so = $*VM<config><load_ext>;
my $c_line = "$*VM<config><cc> -c -D_GNU_SOURCE=1 -D_REENTRANT -I/usr/include/SDL $*VM<config><cc_shared> $*VM<config><cc_o_out>$name$o $*VM<config><ccflags> $name.c";
my $l_line = "$*VM<config><ld> $*VM<config><ld_load_flags> $*VM<config><ldflags> " ~
    "$*VM<config><libs> -lSDL -lm $*VM<config><ld_out>$name$so $name$o";
say $c_line;
say $l_line;
shell($c_line);
shell($l_line);


constant PATH = './sdlwrapper';

sub game_init(int, int)                 returns OpaquePointer is native(PATH) { * }
sub game_get_surface(OpaquePointer)     returns OpaquePointer is native(PATH) { * }
sub game_is_pressed(OpaquePointer, int) returns Bool          is native(PATH) { * }
sub game_is_running(OpaquePointer)      returns Bool          is native(PATH) { * }
sub game_wait(OpaquePointer)                                  is native(PATH) { * }
sub game_free(OpaquePointer)                                  is native(PATH) { * }

my $game = game_init(1600, 900);
while game_is_running($game) {
    game_wait($game);
    say "wow, such game";
}
game_free($game);