/t/sdlx_controller_interface.t

  1use strict;
  2use warnings;
  3use Test::More;
  4use SDL;
  5use SDLx::App;
  6use SDLx::Controller;
  7use SDLx::Controller::State;
  8use SDLx::Controller::Interface;
  9use lib 't/lib';
 10use SDL::TestTool;
 11use Data::Dumper;
 12
 13my $videodriver = $ENV{SDL_VIDEODRIVER};
 14$ENV{SDL_VIDEODRIVER} = 'dummy';
 15
 16can_ok(
 17		'SDLx::Controller::Interface',
 18		qw( new ) #meh, put the rest in later
 19      );
 20
 21TODO: {
 22	      local $TODO = 'methods not implemented yet';
 23	      can_ok( 'SDLx::Controller::Interface', qw( foo ) );
 24      }
 25
 26
 27my $obj = SDLx::Controller::Interface->new( x => 1, y => 2, v_x => 3, v_y => 4, rot => 5, ang_v => 6 );
 28
 29isa_ok( $obj, 'SDLx::Controller::Interface' );
 30my $s = sub { pass 'ran accel'; return ( 0.0, 10, 19 ) };
 31
 32$obj->set_acceleration($s);
 33
 34my $av = $obj->acceleration(1);
 35
 36
 37isa_ok( $av, 'ARRAY' );
 38## This is reversed, maybe we fix this ... or not because acceleration will
 39#be called internal
 40is( $av->[0], 19 );
 41is( $av->[1], 10 );
 42is( $av->[2], 0.0 );
 43
 44my $hv = $obj->interpolate(0.5);
 45
 46isa_ok( $hv, 'SDLx::Controller::State', '[interpolate] provides state back out' );
 47
 48is( $hv->x,        1 );
 49is( $hv->y,        2 );
 50is( $hv->rotation, 5 );
 51
 52
 53$obj->update( 2, 0.5 );
 54
 55$hv = $obj->interpolate(0.5);
 56
 57isa_ok( $hv, 'SDLx::Controller::State', '[interpolate] provides state back out' );
 58
 59is( $hv->x,        1.75 );
 60is( $hv->y,        3.625 );
 61is( $hv->rotation, 7.6875 );
 62
 63$obj = SDLx::Controller::Interface->new( x => 1, y => 2, v_x => 3, v_y => 4, rot => 5, ang_v => 6 );
 64
 65
 66$obj->set_acceleration( sub { $_[1]->x(2); pass '[state] is mutable'; return ( 0.0, 10, 19 ) } );
 67
 68$obj->acceleration(1);
 69my $a   = $obj->current;
 70my $a_x = $a->x();
 71is( $a_x, 2, '[obj/state] acceleration callback copies state back to current' );
 72
 73
 74my $dummy        = SDLx::App->new( init => SDL_INIT_VIDEO );
 75my $controller   = SDLx::Controller->new( dt => 1, delay => 200 );
 76my $interface    = SDLx::Controller::Interface->new();
 77my $event_called = 0;
 78
 79require SDL::Event;
 80require SDL::Events;
 81my $eve = SDL::Event->new();
 82
 83SDL::Events::push_event($eve);
 84my $counts = [ 0, 0, 0 ];
 85$controller->add_event_handler(
 86	sub {
 87		$counts->[0]++;
 88		return 0;
 89	}
 90);
 91
 92$interface->set_acceleration(
 93	sub {
 94		$controller->stop() if $counts->[0] && $counts->[1] && $counts->[2];
 95		$counts->[1]++;
 96		isa_ok( $_[1], 'SDLx::Controller::State', '[Controller] called acceleration and gave us a state' ),
 97		return ( 10, 10, 10 );
 98	}
 99);
100
101$interface->attach(
102	$controller,
103	sub {
104		$counts->[2]++;
105		isa_ok( $_[0], 'SDLx::Controller::State', '[Controller] called render and gave us a state' );
106	}
107);
108
109
110$controller->run();
111
112cmp_ok( $counts->[0], '>', 0, '$counts->[0] is >0' );
113cmp_ok( $counts->[1], '>', 0, '$counts->[1] is >0' );
114cmp_ok( $counts->[2], '>', 0, '$counts->[2] is >0' );
115
116$interface->detach();
117
118pass('Interface was able to deattach ');
119
120
121
122
123if ($videodriver) {
124	$ENV{SDL_VIDEODRIVER} = $videodriver;
125} else {
126	delete $ENV{SDL_VIDEODRIVER};
127}
128
129
130done_testing;
131