PageRenderTime 53ms CodeModel.GetById 1ms app.highlight 49ms RepoModel.GetById 1ms app.codeStats 0ms

/t/sdlx_surface.t

http://github.com/PerlGameDev/SDL
Unknown | 252 lines | 203 code | 49 blank | 0 comment | 0 complexity | 352494f2f3bf3cce1c4048fcad5c389e MD5 | raw file
  1use strict;
  2use warnings;
  3use Test::More;
  4use SDL;
  5use SDL::Surface;
  6use SDL::Rect;
  7use SDLx::Surface;
  8use SDL::PixelFormat;
  9use SDL::Video;
 10use Data::Dumper;
 11use lib 't/lib';
 12use SDL::TestTool;
 13
 14my $videodriver = $ENV{SDL_VIDEODRIVER};
 15$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
 16
 17if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
 18	plan( skip_all => 'Failed to init video' );
 19}
 20
 21my $app = SDL::Video::set_video_mode( 400, 200, 32, SDL_SWSURFACE );
 22
 23my $app_x = SDLx::Surface::display();
 24
 25is_deeply(
 26	$app_x->surface->get_pixels_ptr,
 27	$app->get_pixels_ptr, '[display] works'
 28);
 29
 30my $surface = SDL::Surface->new( SDL_SWSURFACE, 400, 200, 32 );
 31my @surfs = (
 32	SDLx::Surface->new( surface => $surface ),
 33	SDLx::Surface->new( width   => 400, height => 200 ),
 34	SDLx::Surface->new(
 35		width  => 400,
 36		height => 200,
 37		flags  => SDL_SWSURFACE,
 38		depth  => 32
 39	),
 40	SDLx::Surface->new(
 41		width     => 400,
 42		height    => 200,
 43		flags     => SDL_SWSURFACE,
 44		depth     => 32,
 45		greenmask => 0xFF000000
 46	),
 47);
 48
 49foreach my $a (@surfs) {
 50	isa_ok( $a, 'SDLx::Surface' );
 51
 52	isa_ok( $a->surface(), 'SDL::Surface' );
 53
 54	my $color = $a->[0][0];
 55	is( $color, 0, 'Right color returned' );
 56
 57	$a->[0][0] = 0x00FF00FF;
 58	is( $a->[0][0], 0x00FF00FF, 'Right color returned' );
 59
 60	is( @{$a}, 200, 'Correct Y value' );
 61
 62	is( @{ $a->[0] }, 400, 'Correct X value' );
 63
 64}
 65
 66#my $source = SDLx::Surface->new( width=> 400, height=>200, flags=> SDL_SWSURFACE, depth=>32 ),
 67
 68is( $surfs[0]->[1][2], 0, 'Checking source pixel is 0' );
 69is( $surfs[1]->[1][2], 0, 'Checking dest pixel is 0' );
 70
 71$surfs[0]->[4][4] = [255,255,0,255];
 72
 73is( $surfs[0]->[4][4] , 0xFFFF00FF, "Surface can set pixel with other color values");
 74
 75$surfs[0]->[1][2] = 0x00FF00FF;
 76
 77is( $surfs[0]->[1][2], 0x00FF00FF, 'Checking that source pixel got written' );
 78
 79$surfs[0]->blit( $surfs[1] );
 80
 81#SDL::Video::blit_surface( $surfs[0]->surface, SDL::Rect->new(0,0,400,200), $surfs[1]->surface, SDL::Rect->new(0,0,400,200));
 82
 83isnt( $surfs[1]->[1][2], 0, 'Pixel blitted from one surface to another' );
 84
 85$surfs[1]->blit_by( $surfs[0], undef, [ 1, 0, 0, 0 ] );
 86
 87isnt( $surfs[1]->[2][2], 0, 'Pixel by_blitted to another surface with offset' );
 88
 89push @surfs,
 90	SDLx::Surface->new(
 91	w     => 1,
 92	h     => 1,
 93	color => 0x204080FF,
 94	);
 95
 96my $fill = SDL::Video::get_RGBA( $surfs[-1]->surface()->format(), $surfs[-1]->[0][0] );
 97
 98is( $fill->[0], 0x20, 'Fill color red worked' );
 99is( $fill->[1], 0x40, 'Fill color green worked' );
100is( $fill->[2], 0x80, 'Fill color blue worked' );
101is( $fill->[3], 0xFF, 'Fill color alpha worked' );
102
103$surfs[1]->flip();
104
105pass 'Fliped the surface';
106
107$surfs[0]->update();
108pass 'update all surface';
109$surfs[0]->update( [ 0, 10, 30, 40 ] );
110pass 'Single rect update';
111$surfs[0]->update( [ SDL::Rect->new( 0, 1, 2, 3 ), SDL::Rect->new( 2, 4, 5, 6 ) ] );
112pass 'SDL::Rect array update';
113
114my @colors = (
115    # opaque
116	[ 0xFF, 0xFF, 0xFF, 0xFF ],
117	[ 0xFF, 0xFF, 0x00, 0xFF ],
118	[ 0xFF, 0x00, 0xFF, 0xFF ],
119	[ 0x00, 0xFF, 0xFF, 0xFF ],
120	[ 0xFF, 0x00, 0x00, 0xFF ],
121	[ 0x00, 0xFF, 0x00, 0xFF ],
122	[ 0x00, 0x00, 0xFF, 0xFF ],
123	[ 0x00, 0x00, 0x00, 0xFF ],
124	[ 0x20, 0x40, 0x80, 0xFF ],
125	[ 0x80, 0x20, 0x40, 0xFF ],
126	[ 0x40, 0x80, 0x20, 0xFF ],
127
128    # translucent
129	[ 0xFF, 0xFF, 0xFF, 0xCC ],
130	[ 0xFF, 0xFF, 0x00, 0xCC ],
131	[ 0xFF, 0x00, 0xFF, 0xCC ],
132	[ 0x00, 0xFF, 0xFF, 0xCC ],
133	[ 0xFF, 0x00, 0x00, 0xCC ],
134	[ 0x00, 0xFF, 0x00, 0xCC ],
135	[ 0x00, 0x00, 0xFF, 0xCC ],
136	[ 0x00, 0x00, 0x00, 0xCC ],
137	[ 0x20, 0x40, 0x80, 0xCC ],
138	[ 0x80, 0x20, 0x40, 0xCC ],
139	[ 0x40, 0x80, 0x20, 0xCC ],
140
141    # transparent
142	[ 0xFF, 0xFF, 0xFF, 0x00 ],
143	[ 0xFF, 0xFF, 0x00, 0x00 ],
144	[ 0xFF, 0x00, 0xFF, 0x00 ],
145	[ 0x00, 0xFF, 0xFF, 0x00 ],
146	[ 0xFF, 0x00, 0x00, 0x00 ],
147	[ 0x00, 0xFF, 0x00, 0x00 ],
148	[ 0x00, 0x00, 0xFF, 0x00 ],
149	[ 0x00, 0x00, 0x00, 0x00 ],
150	[ 0x20, 0x40, 0x80, 0x00 ],
151	[ 0x80, 0x20, 0x40, 0x00 ],
152	[ 0x40, 0x80, 0x20, 0x00 ],
153);
154
155foreach my $c (@colors) {
156	my $color = ( $c->[0] << 24 ) + ( $c->[1] << 16 ) + ( $c->[2] << 8 ) + $c->[3];
157	$surfs[0]->draw_rect( [ 0, 0, 10, 20 ], $c );
158
159	my $num = sprintf( '0x%08x', $color );
160
161	my $rgba = SDL::Video::get_RGBA( $surfs[0]->surface()->format(), $surfs[0]->[0][0] );
162
163	is( $rgba->[0], $c->[0], "draw_rect uses correct red for $num" );
164	is( $rgba->[1], $c->[1], "draw_rect uses correct green for $num" );
165	is( $rgba->[2], $c->[2], "draw_rect uses correct blue for $num" );
166	is( $rgba->[3], $c->[3], "draw_rect uses correct alpha for $num" );
167}
168$surfs[0]->draw_rect( [ 0, 0, 10, 20 ], 0xFF00FFFF );
169pass 'draw_rect works';
170SKIP:
171{
172	skip( 'SDL_gfx_primitives needed', 2 ) unless SDL::Config->has('SDL_gfx_primitives');
173
174	is( $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff ), $surfs[1], 'draw_line returns self' );
175
176	$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ff );
177	$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff );
178	$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff, 1 );
179	$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], [ 255, 255, 0, 255 ] );
180	$surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], [ 255, 255, 0, 255 ], 1 );
181	pass 'draw_line works';
182
183	$surfs[1]->draw_gfx_text( [ 0, 0 ], 0xffffffff, "fooo" );
184	$surfs[1]->draw_gfx_text( [ 10, 10 ], [ 20, 20, 20, 20 ], "fooo" );
185	my $f = '';
186	open( my $FH, '<', 'test/data/5x7.fnt' );
187	binmode($FH);
188	read( $FH, $f, 4096 );
189	close($FH);
190	my $font = { data => $f, cw => 5, ch => 7 };
191	$surfs[1]->draw_gfx_text( [ 0, 0 ], 0xffffffff, "fooo", $font );
192	pass 'draw_gfx_text works';
193	my @colors_t = ( [ 255, 0, 0, 255 ], 0xFF0000FF, 0xFF00FF, [ 255, 0, 255 ] );
194
195	is( $surfs[0]->draw_circle( [ 100, 10 ], 20, [ 0, 0, 0, 0] ), $surfs[0], 'draw_circle returns self' );
196	foreach my $cir_color (@colors_t) {
197		my $cir_color = [ 255, 0, 0, 255 ];
198		$surfs[0]->draw_circle( [ 100, 10 ], 20, $cir_color ); #no fill
199		$surfs[0]->draw_circle( [ 102, 12 ], 22, $cir_color , 1 );
200		$surfs[0]->draw_circle_filled( [ 100, 10 ], 20, $cir_color ); #fill
201		isnt( $surfs[0]->[100][10], 0 );
202		pass 'draw_circle works';
203		pass 'draw_circle_filled works';
204	}
205
206	is( $surfs[0]->draw_trigon( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_trigon returns self' );
207	is( $surfs[0]->draw_trigon_filled( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_trigon_filled returns self' );
208	foreach my $color (@colors_t) {
209		my $color = [ 255, 0, 0, 255 ];
210		my $verts = [ [100, 10], [110, 10], [110, 20] ];
211		$surfs[0]->draw_trigon( $verts, $color ); #no fill
212		$surfs[0]->draw_trigon( $verts, $color, 1 );
213		$surfs[0]->draw_trigon_filled( $verts, $color ); #fill
214		isnt( $surfs[0]->[100][10], 0 );
215		pass 'draw_trigon works';
216		pass 'draw_trigon_filled works';
217	}
218
219	is( $surfs[0]->draw_polygon( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_polygon returns self' );
220	is( $surfs[0]->draw_polygon_filled( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_polygon_filled returns self' );
221	foreach my $color (@colors_t) {
222		my $color = [ 255, 0, 0, 255 ];
223		my $verts = [ [100, 10], [110, 10], [110, 20], [100, 20] ];
224		$surfs[0]->draw_polygon( $verts, $color ); #no fill
225		$surfs[0]->draw_polygon( $verts, $color, 1 );
226		$surfs[0]->draw_polygon_filled( $verts, $color ); #fill
227		isnt( $surfs[0]->[100][10], 0 );
228		pass 'draw_polygon works';
229		pass 'draw_polygon_filled works';
230	}
231}
232
233
234my $surf_dup = SDLx::Surface::duplicate( $surfs[1] );
235
236is( $surf_dup->w,     $surfs[1]->w,     'Duplicate surf has same width' );
237is( $surf_dup->h,     $surfs[1]->h,     'Duplicate surf has same flags' );
238is( $surf_dup->flags, $surfs[1]->flags, 'Duplicate surf has same flags' );
239is( $surf_dup->format->BitsPerPixel,
240	$surfs[1]->format->BitsPerPixel,
241	'Duplicate surf has same bpp'
242);
243
244if ($videodriver) {
245	$ENV{SDL_VIDEODRIVER} = $videodriver;
246} else {
247	delete $ENV{SDL_VIDEODRIVER};
248}
249
250pass 'Final SegFault test';
251
252done_testing;