PageRenderTime 48ms CodeModel.GetById 22ms app.highlight 21ms RepoModel.GetById 2ms app.codeStats 0ms

/examples/GFX/script_roto.pl

http://github.com/PerlGameDev/SDL
Perl | 63 lines | 46 code | 15 blank | 2 comment | 6 complexity | 9a32986d21aad826b86ca51eef91ca41 MD5 | raw file
 1#!perl
 2use strict;
 3use warnings;
 4use Carp;
 5use SDL;
 6use SDL::Rect;
 7use SDL::Config;
 8use SDL::Video;
 9use SDL::Surface;
10use SDL::GFX::Rotozoom;
11
12my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
13my $pixel = SDL::Video::map_RGB( $display->format, 0, 0, 0 );
14SDL::Video::fill_rect(
15	$display,
16	SDL::Rect->new( 0, 0, $display->w, $display->h ), $pixel
17);
18
19Carp::confess SDL::get_error if !$display;
20
21my $src = SDL::Video::load_BMP('test/data/picture.bmp');
22my $temp_surf;
23
24sub draw {
25	SDL::Video::fill_rect(
26		$display,
27		SDL::Rect->new( 0, 0, $display->w, $display->h ), $pixel
28	);
29
30	my $surface = $_[0];
31	SDL::Video::blit_surface(
32		$surface, SDL::Rect->new( 0, 0, $surface->w, $surface->h ),
33		$display, SDL::Rect->new( 0, 0, $display->w, $display->w )
34	);
35
36	SDL::Video::update_rect( $display, 0, 0, 640, 480 );
37
38	SDL::delay( $_[1] ) if $_[1];
39
40}
41
42# Note: new surface should be less than 16384 in width and height
43foreach ( 1 .. 360 ) {
44
45	$temp_surf = SDL::GFX::Rotozoom::surface( $src, $_, $_ / 180, 1 );
46	Carp::confess SDL::get_error if !$temp_surf;
47	draw( $temp_surf, 2 );
48}
49
50$temp_surf = SDL::GFX::Rotozoom::surface_xy( $src, 1, 1, 1, 1 );
51Carp::confess SDL::get_error if !$temp_surf;
52draw( $temp_surf, 1000 );
53
54$temp_surf = SDL::GFX::Rotozoom::zoom_surface( $src, 1, 1, 1 );
55Carp::confess SDL::get_error if !$temp_surf;
56draw( $temp_surf, 1000 );
57
58$temp_surf = SDL::GFX::Rotozoom::shrink_surface( $src, 1, 1 );
59Carp::confess SDL::get_error if !$temp_surf;
60draw( $temp_surf, 1000 );
61
62SDL::delay(1000);
63