PageRenderTime 22ms CodeModel.GetById 1ms app.highlight 18ms RepoModel.GetById 1ms app.codeStats 0ms

/t/gfx_rotozoom.t

http://github.com/PerlGameDev/SDL
Perl | 155 lines | 131 code | 21 blank | 3 comment | 9 complexity | 96343149ed883401fbddffd1b304d59a MD5 | raw file
  1#!perl
  2use strict;
  3use warnings;
  4use SDL;
  5use SDL::Rect;
  6use SDL::Config;
  7use SDL::Video;
  8use SDL::Version;
  9use SDL::Surface;
 10use SDL::PixelFormat;
 11use SDL::GFX;
 12use SDL::GFX::Rotozoom;
 13use Test::More;
 14
 15use lib 't/lib';
 16use SDL::TestTool;
 17
 18my $videodriver = $ENV{SDL_VIDEODRIVER};
 19$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
 20
 21if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
 22	plan( skip_all => 'Failed to init video' );
 23} elsif ( !SDL::Config->has('SDL_gfx_rotozoom') ) {
 24	plan( skip_all => 'SDL_gfx_rotozoom support not compiled' );
 25} else {
 26	plan( tests => 23 );
 27}
 28
 29my $v = SDL::GFX::linked_version();
 30isa_ok( $v, 'SDL::Version', '[linked_version]' );
 31printf( "got version: %d.%d.%d\n", $v->major, $v->minor, $v->patch );
 32
 33is( SMOOTHING_OFF,   0, 'SMOOTHING_OFF should be imported' );
 34is( SMOOTHING_OFF(), 0, 'SMOOTHING_OFF() should also be available' );
 35is( SMOOTHING_ON,    1, 'SMOOTHING_ON should be imported' );
 36is( SMOOTHING_ON(),  1, 'SMOOTHING_ON() should also be available' );
 37
 38my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_ANYFORMAT );
 39my $pixel = SDL::Video::map_RGB( $display->format, 0, 0, 0 );
 40SDL::Video::fill_rect(
 41	$display,
 42	SDL::Rect->new( 0, 0, $display->w, $display->h ), $pixel
 43);
 44
 45if ( !$display ) {
 46	plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error();
 47}
 48
 49my $src = SDL::Video::load_BMP('test/data/picture.bmp');
 50
 51draw();
 52
 53# Note: new surface should be less than 16384 in width and height
 54isa_ok(
 55	SDL::GFX::Rotozoom::surface( $src, 0, 1, 0 ),
 56	'SDL::Surface', 'surface'
 57);
 58draw();
 59my ( $dest_w, $dest_h ) = @{ SDL::GFX::Rotozoom::surface_size( 100, 200, 45, 1 ) };
 60is( $dest_w > 100, 1, 'surface_size, resulting width raises at angle is 45' );
 61is( $dest_h > 200, 1, 'surface_size, resulting height raises at angle is 45' );
 62( $dest_w, $dest_h ) = @{ SDL::GFX::Rotozoom::surface_size( 100, 200, 45, 0.3 ) };
 63is( $dest_w < 100, 1, 'surface_size, resulting width decreases at zoom 0.3' );
 64is( $dest_h < 200, 1, 'surface_size, resulting height decreases at zoom 0.3' );
 65
 66SKIP:
 67{
 68	skip( 'Version 2.0.13 needed', 1 ) if $v < 2.0.13;
 69	isa_ok(
 70		SDL::GFX::Rotozoom::surface_xy( $src, 1, 1, 1, 1 ),
 71		'SDL::Surface', 'surface_xy'
 72	);
 73	draw();
 74}
 75( $dest_w, $dest_h ) = @{ SDL::GFX::Rotozoom::surface_size_xy( 100, 200, 45, 1.3, 1.7 ) };
 76is( $dest_w > 100,
 77	1, 'surface_size_xy, resulting width raises at zoom 1.3 and angle 45'
 78);
 79is( $dest_h > 200,
 80	1, 'surface_size_xy, resulting height raises at zoom 1.7 ans angle 45'
 81);
 82( $dest_w, $dest_h ) = @{ SDL::GFX::Rotozoom::surface_size_xy( 100, 200, 45, 0.3, 0.2 ) };
 83is( $dest_w < 100,
 84	1, 'surface_size_xy, resulting width decreases at zoom 0.3 and angle 45'
 85);
 86is( $dest_h < 200,
 87	1, 'surface_size_xy, resulting height decreases at zoom 0.2 ans angle 45'
 88);
 89
 90isa_ok(
 91	SDL::GFX::Rotozoom::zoom_surface( $src, 1, 1, 1 ),
 92	'SDL::Surface', 'zoom_surface'
 93);
 94draw();
 95( $dest_w, $dest_h ) = @{ SDL::GFX::Rotozoom::zoom_surface_size( 100, 200, 0.5, 0.7 ) };
 96is( $dest_w < 100,
 97	1, 'zoom_surface_size, resulting width decreases at zoom 0.5'
 98);
 99is( $dest_h < 200,
100	1, 'zoom_surface_size, resulting height decreases at zoom 0.7'
101);
102( $dest_w, $dest_h ) = @{ SDL::GFX::Rotozoom::zoom_surface_size( 100, 200, 1.2, 7.7 ) };
103is( $dest_w > 100, 1, 'zoom_surface_size, resulting width raises at zoom 1.2' );
104is( $dest_h > 200, 1,
105	'zoom_surface_size, resulting height raises at zoom 7.7'
106);
107
108SKIP:
109{
110	skip( 'Version 2.0.14 needed', 1 ) if $v < 2.0.14;
111	isa_ok(
112		SDL::GFX::Rotozoom::shrink_surface( $src, 1, 1 ),
113		'SDL::Surface', 'shrink_surface'
114	);
115	draw();
116}
117$src = SDL::Surface->new( SDL_SWSURFACE, 100, 200, 32, 0, 0, 0, 0 );
118SKIP:
119{
120	skip( 'Version 2.0.17 needed', 1 ) if $v < 2.0.17;
121	isa_ok(
122		SDL::GFX::Rotozoom::rotate_surface_90_degrees( $src, 1 ),
123		'SDL::Surface', 'rotate_surface_90_degrees'
124	);
125}
126
127# Note: everything but 32bit surface will crash
128
129for ( 1 .. 5 ) {
130	draw();
131}
132
133sub draw {
134	my $surface = $src;
135	SDL::Video::blit_surface(
136		$surface,
137		SDL::Rect->new( 0, 0, $surface->w, $surface->h ),
138		$display,
139		SDL::Rect->new( 50 * 20, 100, $surface->w + 50 + 20, $surface->h + 100 )
140	);
141	SDL::Video::update_rect( $display, 0, 0, 640, 480 );
142
143}
144
145SDL::delay(1000);
146
147if ($videodriver) {
148	$ENV{SDL_VIDEODRIVER} = $videodriver;
149} else {
150	delete $ENV{SDL_VIDEODRIVER};
151}
152
153pass 'Are we still alive? Checking for segfaults';
154
155done_testing;