PageRenderTime 57ms CodeModel.GetById 46ms app.highlight 8ms RepoModel.GetById 1ms app.codeStats 0ms

/t/smpeg.t

http://github.com/PerlGameDev/SDL
Perl | 122 lines | 84 code | 19 blank | 19 comment | 6 complexity | f15b40511bf89a0d91241ba3117be6b6 MD5 | raw file
  1#!perl 
  2# basic testing of SDL::SMPEG
  3
  4BEGIN {
  5	unshift @INC, 'blib/lib', 'blib/arch';
  6}
  7
  8use strict;
  9use warnings;
 10use SDL;
 11use SDL::Config;
 12
 13use Test::More;
 14
 15my $videodriver = $ENV{SDL_VIDEODRIVER};
 16$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
 17
 18
 19if ( SDL::Config->has('smpeg') ) {
 20	if( $ENV{SDL_RELEASE_TESTING} )
 21	{
 22		plan( tests => 17 );
 23	}
 24	else
 25	{
 26		plan( skip_all => "Skiping test for now. EXPERIMENTAL" );
 27	}
 28} else {
 29	plan( skip_all => ( SDL::Config->has('smpeg') ? '' : ' smpeg support not compiled' ) );
 30}
 31
 32use_ok('SDL::SMPEG');
 33use SDL::Video;
 34
 35can_ok(
 36	'SDL::SMPEG', qw/
 37		new
 38		error
 39		audio
 40		video
 41		volume
 42		display
 43		scale
 44		play
 45		pause
 46		stop
 47		rewind
 48		seek
 49		skip
 50		loop
 51		region
 52		frame
 53		info
 54		status
 55		/
 56);
 57
 58# Create a video as it is done in the SYNOPSIS for SDL::SMPEG
 59SCOPE: {
 60	my $smpeg = SDL::SMPEG->new(
 61		-name => 'test/data/test-mpeg.mpg',
 62	);
 63	isa_ok( $smpeg, 'SDL::SMPEG' );
 64}
 65
 66# Get some information about a video
 67SCOPE: {
 68	# TODO: On the following line we don't use the same code as
 69	# above, intentionally so we can evade the failing test and
 70	# continue testing. Once the above test case passes, merge
 71	# this with the test case above.
 72	my ($smpeg) = SDL::SMPEG->new(
 73		-name => 'test/data/test-mpeg.mpg',
 74	);
 75	isa_ok( $smpeg, 'SDL::SMPEG' );
 76
 77	# Get the video metadata
 78	my $mpeg = $smpeg->info;
 79	isa_ok( $mpeg, 'SDL::SMPEG::Info' );
 80
 81	# Check it matches what we expect
 82	is( $mpeg->has_audio, 1,         '->has_audio ok' );
 83	is( $mpeg->has_video, 1,         '->has_video ok' );
 84	is( $mpeg->width,     160,       '->width ok'     );
 85	is( $mpeg->height,    120,       '->height ok'    );
 86	is( $mpeg->size,      706564,    '->size ok'      );
 87	is( $mpeg->offset,    2717,      '->offset ok'    );
 88	is( $mpeg->frame,     0,         '->frame ok'     );
 89	is( $mpeg->time,      0,         '->time ok'      );
 90	like( $mpeg->length,  qr/^21.3/, '->length ok'    );
 91
 92	# TODO: I'm not entirely sure this is meant to be zero
 93	is( $mpeg->fps,       0, '->fps ok'       );
 94
 95	# Create a display to attach the movie to
 96	my $surface = SDL::Video::set_video_mode(
 97		$mpeg->height,
 98		$mpeg->width,
 99		32,         # Colour bits
100		SDL::Video::SDL_SWSURFACE, # flags
101	);
102	isa_ok( $surface, 'SDL::Surface' );
103
104	# Attach the movie to a surface
105	is( $smpeg->display($surface), undef, '->display(surface) ok' );
106
107	# Now that we are bound we should be able to do things
108	# to the movie and have them actually work.
109	# Confirm we can change where we are in the video.
110#	is( $smpeg->frame(5), undef, '->frame(5) ok' );
111	$smpeg->play();	
112	# TODO: Figure out how this info object really works
113	#is( $mpeg->current_frame, 5, '->frame updated in info object' );
114}
115
116
117if ($videodriver) {
118	$ENV{SDL_VIDEODRIVER} = $videodriver;
119} else {
120	delete $ENV{SDL_VIDEODRIVER};
121}
122