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