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; 156