PageRenderTime 50ms CodeModel.GetById 14ms app.highlight 31ms RepoModel.GetById 1ms app.codeStats 0ms

/t/sdlx_controller.t

http://github.com/PerlGameDev/SDL
Unknown | 154 lines | 123 code | 31 blank | 0 comment | 0 complexity | c2b95800bccca0ef862f34b474144271 MD5 | raw file
  1use strict;
  2use warnings;
  3use Test::More;
  4use SDL;
  5use SDL::Config;
  6use SDL::Video;
  7use SDL::Color;
  8use SDLx::Controller;
  9use Scalar::Util 'refaddr';
 10use lib 't/lib';
 11use SDL::TestTool;
 12
 13can_ok(
 14	'SDLx::Controller',
 15	qw(
 16		new run stop pause dt min_t current_time
 17		add_move_handler add_event_handler add_show_handler
 18		remove_move_handler remove_event_handler remove_show_handler
 19		remove_all_move_handlers remove_all_event_handlers remove_all_show_handlers
 20		move_handlers event_handlers show_handlers eoq exit_on_quit
 21	)
 22);
 23
 24TODO: {
 25	local $TODO = 'methods not implemented yet';
 26	can_ok( 'SDLx::Controller', qw( ) );
 27}
 28
 29my $app = SDLx::Controller->new;
 30isa_ok( $app, 'SDLx::Controller', 'default controller can be spawned' );
 31is($app->dt, 0.1, 'default dt set to 0.1');
 32is($app->min_t, 1 / 60, 'default min_t set to 1/60' );
 33is($app->eoq, 0, 'no eoq by default');
 34is($app->exit_on_quit, 0, 'no exit_on_quit by default');
 35is( scalar @{ $app->move_handlers }, 0, 'no motion handlers by default' );
 36is( scalar @{ $app->show_handlers }, 0, 'no show handlers by default' );
 37is( scalar @{ $app->event_handlers }, 0, 'no event handlers by default' );
 38
 39is( $app->exit_on_quit, 0, 'exit_on_quit is not set by default' );
 40is( $app->eoq, 0, 'eoq() is a method alias to exit_on_quit()' );
 41$app->exit_on_quit(1);
 42is( scalar @{ $app->event_handlers }, 0, 'exit_on_quit does not trigger event handlers' );
 43is( $app->exit_on_quit, 1, 'exit_on_quit can be set dynamically' );
 44is( $app->eoq, 1, 'eoq() follows exit_on_quit()' );
 45$app->remove_all_event_handlers;
 46is( $app->exit_on_quit, 1, 'exit_on_quit is not an event handler' );
 47is( $app->eoq, 1, 'eoq() still follows exit_on_quit()' );
 48$app->eoq(0);
 49is( $app->eoq, 0, 'eoq can be set dynamically' );
 50is( $app->exit_on_quit, 0, 'exit_on_quit() follows eoq()' );
 51
 52$app = SDLx::Controller->new(
 53	dt     => 0.1,
 54	min_t => 0.5,
 55);
 56
 57isa_ok( $app, 'SDLx::Controller' );
 58is($app->dt, 0.1, 'new dt set to 0.1');
 59is($app->min_t, 0.5, 'new min_t set to 0.5' );
 60
 61
 62sub dummy_sub  {1}
 63sub dummy_sub2 {1}
 64
 65my @kinds = qw(move show);
 66
 67# SDL events need a video surface to work
 68my $videodriver = $ENV{SDL_VIDEODRIVER};
 69$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
 70push @kinds, 'event'
 71    if SDL::TestTool->init(SDL_INIT_VIDEO)
 72       and SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
 73
 74foreach my $kind (@kinds) {
 75    my $method = "add_${kind}_handler";
 76    my $index_1 = $app->$method( \&dummy_sub );
 77    my $index_2 = $app->$method( \&dummy_sub2 );
 78
 79    is($index_1 , 0, "got index 0 from added $kind handler" );
 80    is($index_2 , 1, "got index 0 from added $kind handler" );
 81
 82    $method = "${kind}_handlers";
 83    is( scalar @{ $app->$method }, 2, "$kind handlers added" );
 84
 85    is( $app->$method->[0], \&dummy_sub, "$kind handler 0 added correctly" );
 86    is( $app->$method->[1], \&dummy_sub2, "$kind handler 1 added correctly" );
 87
 88    $method = "remove_${kind}_handler";
 89    $app->$method( \&dummy_sub );
 90    $app->$method( $index_2 );
 91
 92    $method = "${kind}_handlers";
 93    is( scalar @{ $app->$method }, 0, "$kind handlers removed correctly" );
 94}
 95
 96my $move_inc  = 0;
 97my $move_inc2 = 0;
 98my $show_inc  = 0;
 99my $show_inc2 = 0;
100
101sub test_event {
102    my ($event, $application) = @_;
103}
104
105sub test_move_first {
106    cmp_ok($move_inc, '==', $move_inc2, 'test_move_first called first');
107    $move_inc++;
108}
109
110sub test_move {
111	my ($part, $application, $t) = @_;
112    ok(defined $part, 'got step value');
113    ok(defined $application, 'got our app (motion handler)');
114    ok(defined $t, 'got out time');
115
116	ok( do {$part > 0 and $part <= 1}, "move handle \$_[0] of $part was > 0 and <= 1" );
117    is(refaddr $application, refaddr $app, 'app and application are the same (motion handler)');
118    cmp_ok($move_inc, '>', $move_inc2, 'test_move called second');
119    $move_inc2++;
120}
121
122sub test_show_first {
123    cmp_ok($show_inc, '==', $show_inc2, 'test_show_first called first');
124    $show_inc++;
125}
126
127sub test_show {
128	my ($ticks, $application) = @_;
129    ok(defined $ticks, 'got our ticks');
130    ok(defined $application, 'got our app (show handler)');
131
132	ok( $ticks >= 0.5, "show handle \$_[0] of $ticks was >= 0.5" );
133    is(refaddr $application, refaddr $app, 'app and application are the same (show handler)');
134
135    cmp_ok($show_inc, '>', $show_inc2, 'test_show called second');
136    $show_inc2++;
137
138    if ($show_inc2 >= 30) {
139        $application->stop();
140    }
141}
142
143$app->add_move_handler(\&test_move_first);
144$app->add_move_handler(\&test_move);
145
146$app->add_show_handler(\&test_show_first);
147$app->add_show_handler(\&test_show);
148
149$app->run();
150
151cmp_ok($move_inc, '>=', 30, 'called our motion handlers at least 30 times');
152is($show_inc, 30, 'called our show handlers exactly 30 times');
153
154done_testing;