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