PageRenderTime 66ms CodeModel.GetById 2ms app.highlight 58ms RepoModel.GetById 1ms app.codeStats 1ms

/t/core_video.t

http://github.com/PerlGameDev/SDL
Perl | 443 lines | 364 code | 72 blank | 7 comment | 14 complexity | c367681a135e4f76e1ca5ff96c820a2d MD5 | raw file
  1#!/usr/bin/perl -w
  2use strict;
  3use warnings;
  4use SDL;
  5use SDL::Color;
  6use SDL::Surface;
  7use SDL::Config;
  8use SDL::Overlay;
  9use Test::More;
 10use SDL::Rect;
 11use SDL::Video;
 12use SDL::VideoInfo;
 13
 14use lib 't/lib';
 15use SDL::TestTool;
 16
 17my $videodriver = $ENV{SDL_VIDEODRIVER};
 18$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
 19
 20if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
 21	plan( skip_all => 'Failed to init video' );
 22}
 23
 24my @done = qw/
 25	get_video_surface
 26	get_video_info
 27	video_driver_name
 28	list_modes
 29	set_video_mode
 30	video_mode_ok
 31	update_rect
 32	update_rects
 33	flip
 34	set_colors
 35	set_palette
 36	set_gamma
 37	set_gamma_ramp
 38	map_RGB
 39	map_RGBA
 40	unlock_surface
 41	lock_surface
 42	convert_surface
 43	display_format
 44	display_format_alpha
 45	set_color_key
 46	set_alpha
 47	get_RGB
 48	get_RGBA
 49	load_BMP
 50	save_BMP
 51	fill_rect
 52	blit_surface
 53	set_clip_rect
 54	get_clip_rect
 55	lock_YUV_overlay
 56	unlock_YUV_overlay
 57	display_YUV_overlay
 58	GL_load_library
 59	GL_get_proc_address
 60	GL_get_attribute
 61	GL_set_attribute
 62	GL_swap_buffers
 63	get_gamma_ramp
 64	wm_set_caption
 65	wm_get_caption
 66	wm_set_icon
 67	wm_toggle_fullscreen
 68	wm_iconify_window
 69	wm_grab_input
 70	/;
 71
 72can_ok( 'SDL::Video', @done );
 73
 74is( SDL_SWSURFACE,     0,          'SDL_SWSURFACE should be imported' );
 75is( SDL_SWSURFACE(),   0,          'SDL_SWSURFACE() should also be available' );
 76is( SDL_HWSURFACE,     1,          'SDL_HWSURFACE should be imported' );
 77is( SDL_HWSURFACE(),   1,          'SDL_HWSURFACE() should also be available' );
 78is( SDL_ASYNCBLIT,     4,          'SDL_ASYNCBLIT should be imported' );
 79is( SDL_ASYNCBLIT(),   4,          'SDL_ASYNCBLIT() should also be available' );
 80is( SDL_OPENGL,        2,          'SDL_OPENGL should be imported' );
 81is( SDL_OPENGL(),      2,          'SDL_OPENGL() should also be available' );
 82is( SDL_OPENGLBLIT,    10,         'SDL_OPENGLBLIT should be imported' );
 83is( SDL_OPENGLBLIT(),  10,         'SDL_OPENGLBLIT() should also be available' );
 84is( SDL_RESIZABLE,     16,         'SDL_RESIZABLE should be imported' );
 85is( SDL_RESIZABLE(),   16,         'SDL_RESIZABLE() should also be available' );
 86is( SDL_HWACCEL,       256,        'SDL_HWACCEL should be imported' );
 87is( SDL_HWACCEL(),     256,        'SDL_HWACCEL() should also be available' );
 88is( SDL_SRCCOLORKEY,   4096,       'SDL_SRCCOLORKEY should be imported' );
 89is( SDL_SRCCOLORKEY(), 4096,       'SDL_SRCCOLORKEY() should also be available' );
 90is( SDL_RLEACCELOK,    8192,       'SDL_RLEACCELOK should be imported' );
 91is( SDL_RLEACCELOK(),  8192,       'SDL_RLEACCELOK() should also be available' );
 92is( SDL_RLEACCEL,      16384,      'SDL_RLEACCEL should be imported' );
 93is( SDL_RLEACCEL(),    16384,      'SDL_RLEACCEL() should also be available' );
 94is( SDL_SRCALPHA,      65536,      'SDL_SRCALPHA should be imported' );
 95is( SDL_SRCALPHA(),    65536,      'SDL_SRCALPHA() should also be available' );
 96is( SDL_ANYFORMAT,     268435456,  'SDL_ANYFORMAT should be imported' );
 97is( SDL_ANYFORMAT(),   268435456,  'SDL_ANYFORMAT() should also be available' );
 98is( SDL_DOUBLEBUF,     1073741824, 'SDL_DOUBLEBUF should be imported' );
 99is( SDL_DOUBLEBUF(),   1073741824, 'SDL_DOUBLEBUF() should also be available' );
100is( SDL_FULLSCREEN,    0x80000000, 'SDL_FULLSCREEN should be imported' );
101is( SDL_FULLSCREEN(),  0x80000000, 'SDL_FULLSCREEN() should also be available' );
102is( SDL_HWPALETTE,     536870912,  'SDL_HWPALETTE should be imported' );
103is( SDL_HWPALETTE(),   536870912,  'SDL_HWPALETTE() should also be available' );
104is( SDL_PREALLOC,      16777216,   'SDL_PREALLOC should be imported' );
105is( SDL_PREALLOC(),    16777216,   'SDL_PREALLOC() should also be available' );
106
107is( SDL_IYUV_OVERLAY, 1448433993, 'SDL_IYUV_OVERLAY should be imported' );
108is( SDL_IYUV_OVERLAY(), 1448433993,
109	'SDL_IYUV_OVERLAY() should also be available'
110);
111is( SDL_UYVY_OVERLAY, 1498831189, 'SDL_UYVY_OVERLAY should be imported' );
112is( SDL_UYVY_OVERLAY(), 1498831189,
113	'SDL_UYVY_OVERLAY() should also be available'
114);
115is( SDL_YUY2_OVERLAY, 844715353, 'SDL_YUY2_OVERLAY should be imported' );
116is( SDL_YUY2_OVERLAY(), 844715353,
117	'SDL_YUY2_OVERLAY() should also be available'
118);
119is( SDL_YV12_OVERLAY, 842094169, 'SDL_YV12_OVERLAY should be imported' );
120is( SDL_YV12_OVERLAY(), 842094169,
121	'SDL_YV12_OVERLAY() should also be available'
122);
123is( SDL_YVYU_OVERLAY, 1431918169, 'SDL_YVYU_OVERLAY should be imported' );
124is( SDL_YVYU_OVERLAY(), 1431918169,
125	'SDL_YVYU_OVERLAY() should also be available'
126);
127
128is( SDL_LOGPAL,    0x01, 'SDL_LOGPAL should be imported' );
129is( SDL_LOGPAL(),  0x01, 'SDL_LOGPAL() should also be available' );
130is( SDL_PHYSPAL,   0x02, 'SDL_PHYSPAL should be imported' );
131is( SDL_PHYSPAL(), 0x02, 'SDL_PHYSPAL() should also be available' );
132
133is( SDL_GRAB_OFF,     0,  'SDL_GRAB_OFF should be imported' );
134is( SDL_GRAB_OFF(),   0,  'SDL_GRAB_OFF() should also be available' );
135is( SDL_GRAB_ON,      1,  'SDL_GRAB_ON should be imported' );
136is( SDL_GRAB_ON(),    1,  'SDL_GRAB_ON() should also be available' );
137is( SDL_GRAB_QUERY,   -1, 'SDL_GRAB_QUERY should be imported' );
138is( SDL_GRAB_QUERY(), -1, 'SDL_GRAB_QUERY() should also be available' );
139
140#needs to be done before set_video_mode
141my $glVal = SDL::Video::GL_load_library('this/should/fail');
142
143is( $glVal, -1, '[GL_load_library] Failed appropriately' );
144
145TODO: {
146	local $TODO = 'These should be tested with OS specific DLL or SO';
147	is( SDL::Video::GL_load_library('t/realGL.so'),
148		0, '[GL_load_libary] returns 0 on success'
149	);
150
151	# this gets set by GL_load_library => SDL_GL_LOADLIBARY. How do we get this from XS though?
152	# below t/realGL.so needs to use SDL_GL_LOADLIBRARY
153	isnt(
154		SDL::Video::GL_get_proc_address('t/realGL.so'),
155		0, '[GL_get_proc_address] returns not null on success'
156	);
157	is( SDL::Video::GL_set_attribute( SDL_GL_DOUBLEBUFFER, 1 ),
158		0, '[GL_set_attribute] returns 0 on success'
159	);
160	my $tdisplay = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
161	my $value = -3;
162	SDL::Video::GL_set_attribute( SDL_GL_DOUBLEBUFFER, $value );
163	is( $value, 1, '[GL_get_attribute] returns 1 on success as set above' );
164
165	SDL::Video::GL_swap_buffers();
166	pass('[GL_swap_buffers] should work because Double Buffering is turned on');
167
168}
169
170my $video_info = SDL::Video::get_video_info();
171isa_ok(
172	$video_info, 'SDL::VideoInfo',
173	'[get_video_info] Checking if we get videoinfo ref back'
174);
175
176my $list_modes = SDL::Video::list_modes(
177	$video_info->vfmt,
178	SDL_NOFRAME | SDL_HWSURFACE | SDL_FULLSCREEN
179);
180is( ref($list_modes), 'ARRAY', '[list_modes] Returned an ARRAY! ' );
181
182my @modes = @{$list_modes};
183
184if ( $#modes > 0 ) {
185	foreach my $mode (@modes) {
186		ok( $mode->w > 0 && $mode->h > 0,
187			'[list_modes] available mode: ' . $mode->w . ' x ' . $mode->h
188		);
189	}
190} elsif ( $#modes == 0 ) {
191	is( $modes[0], 'all', '[list_modes] available mode: all' );
192}
193
194my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
195
196if ( !$display ) {
197	plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error();
198}
199
200#diag('Testing SDL::Video');
201
202isa_ok(
203	SDL::Video::get_video_surface(),
204	'SDL::Surface',
205	'[get_video_surface] Checking if we get a surface ref back'
206);
207
208my $driver_name = SDL::Video::video_driver_name();
209pass '[video_driver_name] This is your driver name: ' . $driver_name;
210
211cmp_ok(
212	SDL::Video::video_mode_ok( 100, 100, 16, SDL_SWSURFACE ),
213	'>=', 0, "[video_mode_ok] Checking if an integer was return"
214);
215
216$display = SDL::Video::set_video_mode( 100, 100, 16, SDL_SWSURFACE );
217
218isa_ok(
219	$display, 'SDL::Surface',
220	'[set_video_more] Checking if we get a surface ref back'
221);
222
223#TODO: Write to surface and check inf pixel in that area got updated.
224
225SDL::Video::update_rect( $display, 0, 0, 0, 0 );
226
227#TODO: Write to surface and check inf pixel in that area got updated.
228SDL::Video::update_rects( $display, SDL::Rect->new( 0, 10, 20, 20 ) );
229
230my $value = SDL::Video::flip($display);
231is( ( $value == 0 ) || ( $value == -1 ), 1, '[flip] returns 0 or -1' );
232
233SKIP:
234{
235	skip( "These negative test may cause older versions of SDL to crash", 2 )
236		unless $ENV{NEW_SDL};
237	$value = SDL::Video::set_colors( $display, 0, SDL::Color->new( 0, 0, 0 ) );
238	is( $value, 0, '[set_colors] returns 0 trying to write to 32 bit display' );
239
240	$value = SDL::Video::set_palette( $display, SDL_LOGPAL | SDL_PHYSPAL, 0 );
241
242	is( $value, 0,
243		'[set_palette] returns 0 trying to write to 32 bit surface'
244	);
245}
246SDL::delay(100);
247
248my @b_w_colors;
249
250for ( my $i = 0; $i < 256; $i++ ) {
251	$b_w_colors[$i] = SDL::Color->new( $i, $i, $i );
252}
253my $overlay = SDL::Overlay->new( 200, 220, SDL_IYUV_OVERLAY, $display );
254
255is( SDL::Video::lock_YUV_overlay($overlay),
256	0, '[lock_YUV_overlay] returns a 0 on success'
257);
258SDL::Video::unlock_YUV_overlay($overlay);
259pass '[unlock_YUV_overlay] ran';
260my $display_at_rect = SDL::Rect->new( 0, 0, 100, 100 );
261is( SDL::Video::display_YUV_overlay( $overlay, $display_at_rect ),
262	0, '[display_YUV_overlay] returns 0 on success'
263);
264
265my $bmp_surface;
266my $hwdisplay;
267
268SKIP:
269{
270	skip( "No hardware surface available", 26 )
271		unless $video_info->hw_available();
272
273	$hwdisplay = SDL::Video::set_video_mode( 640, 480, 8, SDL_HWSURFACE );
274
275	if ( !$hwdisplay ) {
276		plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error();
277	}
278
279	$value = SDL::Video::set_colors( $hwdisplay, 0 );
280	is( $value, 0,
281		'[set_colors] returns 0 trying to send empty colors to 8 bit surface'
282	);
283
284	$value = SDL::Video::set_palette( $hwdisplay, SDL_LOGPAL | SDL_PHYSPAL, 0 );
285
286	is( $value, 0,
287		'[set_palette] returns 0 trying to send empty colors to 8 bit surface'
288	);
289
290	$value = SDL::Video::set_colors( $hwdisplay, 0, @b_w_colors );
291	is( $value, 1, '[set_colors] returns ' . $value );
292
293	$value = SDL::Video::set_palette(
294		$hwdisplay, SDL_LOGPAL | SDL_PHYSPAL,
295		0,          @b_w_colors
296	);
297
298	is( $value, 1, '[set_palette] returns 1' );
299
300	$value = SDL::Video::lock_surface($hwdisplay);
301	pass '[lock_surface] ran returned: ' . $value;
302
303	SDL::Video::unlock_surface($hwdisplay);
304	pass '[unlock_surface] ran';
305
306	is( SDL::Video::map_RGB( $hwdisplay->format, 10, 10, 10 ) >= 0,
307		1, '[map_RGB] maps correctly to 8-bit surface'
308	);
309	is( SDL::Video::map_RGBA( $hwdisplay->format, 10, 10, 10, 10 ) >= 0,
310		1, '[map_RGBA] maps correctly to 8-bit surface'
311	);
312
313	TODO:
314	{
315		local $TODO = "These test case test a very specific test scenario which might need to be re tought out ...";
316
317		isa_ok(
318			SDL::Video::convert_surface( $hwdisplay, $hwdisplay->format, SDL_SRCALPHA ),
319			'SDL::Surface',
320			'[convert_surface] Checking if we get a surface ref back'
321		);
322		isa_ok(
323			SDL::Video::display_format($hwdisplay),
324			'SDL::Surface', '[display_format] Returns a SDL::Surface'
325		);
326		isa_ok(
327			SDL::Video::display_format_alpha($hwdisplay),
328			'SDL::Surface', '[display_format_alpha] Returns a SDL::Surface'
329		);
330	}
331
332	is( SDL::Video::set_color_key( $hwdisplay, SDL_SRCCOLORKEY, SDL::Color->new( 0, 10, 0 ) ),
333		0,
334		'[set_color_key] Returns 0 on success'
335	);
336
337	is( SDL::Video::set_alpha( $hwdisplay, SDL_SRCALPHA, 100 ),
338		0, '[set_alpha] Returns 0 on success'
339	);
340
341	is_deeply(
342		SDL::Video::get_RGB( $hwdisplay->format, 0 ),
343		[ 0, 0, 0 ],
344		'[get_RGB] returns r,g,b'
345	);
346
347	is_deeply(
348		SDL::Video::get_RGBA( $hwdisplay->format, 0 ),
349		[ 0, 0, 0, 255 ],
350		'[get_RGBA] returns r,g,b,a'
351	);
352
353	my $bmp = 't/core_video.bmp';
354	unlink($bmp) if -f $bmp;
355	SDL::Video::save_BMP( $hwdisplay, $bmp );
356	ok( -f $bmp, '[save_BMP] creates a file' );
357	$bmp_surface = SDL::Video::load_BMP($bmp);
358	isa_ok(
359		$bmp_surface, 'SDL::Surface',
360		'[load_BMP] returns an SDL::Surface'
361	);
362	unlink($bmp) if -f $bmp;
363
364	my $pixel = SDL::Video::map_RGB( $hwdisplay->format, 255, 127, 0 );
365	SDL::Video::fill_rect( $hwdisplay, SDL::Rect->new( 0, 0, 32, 32 ), $pixel );
366	ok( 1, '[fill_rect] filled rect' );
367
368	my $clip_rect = SDL::Rect->new( 0, 0, 10, 20 );
369	SDL::Video::get_clip_rect( $hwdisplay, $clip_rect );
370	is( $clip_rect->x, 0,   '[get_clip_rect] returns a rect with x 0' );
371	is( $clip_rect->y, 0,   '[get_clip_rect] returns a rect with y 0' );
372	is( $clip_rect->w, 640, '[get_clip_rect] returns a rect with w 640' );
373	is( $clip_rect->h, 480, '[get_clip_rect] returns a rect with h 480' );
374	SDL::Video::set_clip_rect( $hwdisplay, SDL::Rect->new( 10, 20, 100, 200 ) );
375	SDL::Video::get_clip_rect( $hwdisplay, $clip_rect );
376	is( $clip_rect->x, 10,  '[get_clip_rect] returns a rect with x 10' );
377	is( $clip_rect->y, 20,  '[get_clip_rect] returns a rect with y 20' );
378	is( $clip_rect->w, 100, '[get_clip_rect] returns a rect with w 100' );
379	is( $clip_rect->h, 200, '[get_clip_rect] returns a rect with h 200' );
380}
381
382SKIP:
383{
384	skip( "No window manager available", 11 )
385		unless $video_info->wm_available();
386
387	my ( $title, $icon ) = @{ SDL::Video::wm_get_caption() };
388	is( $title, undef, '[wm_get_caption] title is undef' );
389	is( $icon,  undef, '[wm_get_caption] icon is undef' );
390	SDL::Video::wm_set_caption( 'Title text', 'Icon text' );
391	( $title, $icon ) = @{ SDL::Video::wm_get_caption() };
392	is( $title, 'Title text', '[wm_set_caption set title]' );
393	is( $icon,  'Icon text',  '[wm_set_caption set icon]' );
394
395	SKIP:
396	{
397		skip( "No hardware surface available", 1 )
398			unless $video_info->hw_available();
399		SDL::Video::wm_set_icon($bmp_surface);
400		pass '[wm_set_icon] ran';
401	}
402
403	SKIP:
404	{
405		skip 'Turn on SDL_GUI_TEST', 6 unless $ENV{SDL_GUI_TEST};
406		SDL::Video::wm_grab_input(SDL_GRAB_ON);
407		pass '[wm_grab_input] ran with SDL_GRAB_ON';
408
409		is( SDL::Video::wm_grab_input(SDL_GRAB_QUERY),
410			SDL_GRAB_ON, '[wm_grab_input] Got Correct grab mode back'
411		);
412
413		SDL::Video::wm_grab_input(SDL_GRAB_OFF);
414		pass '[wm_grab_input] ran with SDL_GRAB_OFF';
415
416		is( SDL::Video::wm_grab_input(SDL_GRAB_QUERY),
417			SDL_GRAB_OFF, '[wm_grab_input] Got Correct grab mode back'
418		);
419
420		my $ic = SDL::Video::wm_iconify_window();
421		is( $ic, 1, '[wm_iconify_window] ran' );
422
423		SKIP:
424		{
425			skip( "No hardware surface available", 1 )
426				unless $video_info->hw_available();
427			SDL::Video::wm_toggle_fullscreen($hwdisplay);
428			pass '[wm_toggle_fullscreen] ran';
429		}
430	}
431}
432
433if ($videodriver) {
434	$ENV{SDL_VIDEODRIVER} = $videodriver;
435} else {
436	delete $ENV{SDL_VIDEODRIVER};
437}
438
439pass 'Are we still alive? Checking for segfaults';
440
441sleep(1);
442
443done_testing();