view release on metacpan or  search on metacpan

t/core_video.t  view on Meta::CPAN

#!/usr/bin/perl -w
use strict;
use warnings;
use SDL;
use SDL::Color;
use SDL::Surface;
use SDL::Config;
use SDL::Overlay;
use Test::More;
use SDL::Rect;
use SDL::Video;
use SDL::VideoInfo;

use lib 't/lib';
use SDL::TestTool;

my $videodriver = $ENV{SDL_VIDEODRIVER};
$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};

if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
	plan( skip_all => 'Failed to init video' );
}

my @done = qw/
	get_video_surface
	get_video_info
	video_driver_name
	list_modes
	set_video_mode
	video_mode_ok
	update_rect
	update_rects
	flip
	set_colors
	set_palette
	set_gamma
	set_gamma_ramp
	map_RGB
	map_RGBA
	unlock_surface
	lock_surface
	convert_surface
	display_format
	display_format_alpha
	set_color_key
	set_alpha
	get_RGB
	get_RGBA
	load_BMP
	save_BMP
	fill_rect
	blit_surface
	set_clip_rect
	get_clip_rect
	lock_YUV_overlay
	unlock_YUV_overlay
	display_YUV_overlay
	GL_load_library
	GL_get_proc_address
	GL_get_attribute
	GL_set_attribute
	GL_swap_buffers
	get_gamma_ramp
	wm_set_caption
	wm_get_caption
	wm_set_icon
	wm_toggle_fullscreen
	wm_iconify_window
	wm_grab_input
	/;

can_ok( 'SDL::Video', @done );

is( SDL_SWSURFACE,     0,          'SDL_SWSURFACE should be imported' );
is( SDL_SWSURFACE(),   0,          'SDL_SWSURFACE() should also be available' );
is( SDL_HWSURFACE,     1,          'SDL_HWSURFACE should be imported' );
is( SDL_HWSURFACE(),   1,          'SDL_HWSURFACE() should also be available' );
is( SDL_ASYNCBLIT,     4,          'SDL_ASYNCBLIT should be imported' );
is( SDL_ASYNCBLIT(),   4,          'SDL_ASYNCBLIT() should also be available' );
is( SDL_OPENGL,        2,          'SDL_OPENGL should be imported' );
is( SDL_OPENGL(),      2,          'SDL_OPENGL() should also be available' );
is( SDL_OPENGLBLIT,    10,         'SDL_OPENGLBLIT should be imported' );
is( SDL_OPENGLBLIT(),  10,         'SDL_OPENGLBLIT() should also be available' );
is( SDL_RESIZABLE,     16,         'SDL_RESIZABLE should be imported' );
is( SDL_RESIZABLE(),   16,         'SDL_RESIZABLE() should also be available' );
is( SDL_HWACCEL,       256,        'SDL_HWACCEL should be imported' );
is( SDL_HWACCEL(),     256,        'SDL_HWACCEL() should also be available' );
is( SDL_SRCCOLORKEY,   4096,       'SDL_SRCCOLORKEY should be imported' );
is( SDL_SRCCOLORKEY(), 4096,       'SDL_SRCCOLORKEY() should also be available' );
is( SDL_RLEACCELOK,    8192,       'SDL_RLEACCELOK should be imported' );
is( SDL_RLEACCELOK(),  8192,       'SDL_RLEACCELOK() should also be available' );
is( SDL_RLEACCEL,      16384,      'SDL_RLEACCEL should be imported' );
is( SDL_RLEACCEL(),    16384,      'SDL_RLEACCEL() should also be available' );
is( SDL_SRCALPHA,      65536,      'SDL_SRCALPHA should be imported' );
is( SDL_SRCALPHA(),    65536,      'SDL_SRCALPHA() should also be available' );
is( SDL_ANYFORMAT,     268435456,  'SDL_ANYFORMAT should be imported' );
is( SDL_ANYFORMAT(),   268435456,  'SDL_ANYFORMAT() should also be available' );
is( SDL_DOUBLEBUF,     1073741824, 'SDL_DOUBLEBUF should be imported' );
is( SDL_DOUBLEBUF(),   1073741824, 'SDL_DOUBLEBUF() should also be available' );
is( SDL_FULLSCREEN,    0x80000000, 'SDL_FULLSCREEN should be imported' );
is( SDL_FULLSCREEN(),  0x80000000, 'SDL_FULLSCREEN() should also be available' );
is( SDL_HWPALETTE,     536870912,  'SDL_HWPALETTE should be imported' );
is( SDL_HWPALETTE(),   536870912,  'SDL_HWPALETTE() should also be available' );
is( SDL_PREALLOC,      16777216,   'SDL_PREALLOC should be imported' );
is( SDL_PREALLOC(),    16777216,   'SDL_PREALLOC() should also be available' );

is( SDL_IYUV_OVERLAY, 1448433993, 'SDL_IYUV_OVERLAY should be imported' );
is( SDL_IYUV_OVERLAY(), 1448433993,
	'SDL_IYUV_OVERLAY() should also be available'
);
is( SDL_UYVY_OVERLAY, 1498831189, 'SDL_UYVY_OVERLAY should be imported' );
is( SDL_UYVY_OVERLAY(), 1498831189,
	'SDL_UYVY_OVERLAY() should also be available'
);
is( SDL_YUY2_OVERLAY, 844715353, 'SDL_YUY2_OVERLAY should be imported' );
is( SDL_YUY2_OVERLAY(), 844715353,
	'SDL_YUY2_OVERLAY() should also be available'

t/core_video.t  view on Meta::CPAN

my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );

if ( !$display ) {
	plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error();
}

#diag('Testing SDL::Video');

isa_ok(
	SDL::Video::get_video_surface(),
	'SDL::Surface',
	'[get_video_surface] Checking if we get a surface ref back'
);

my $driver_name = SDL::Video::video_driver_name();
pass '[video_driver_name] This is your driver name: ' . $driver_name;

cmp_ok(
	SDL::Video::video_mode_ok( 100, 100, 16, SDL_SWSURFACE ),
	'>=', 0, "[video_mode_ok] Checking if an integer was return"
);

$display = SDL::Video::set_video_mode( 100, 100, 16, SDL_SWSURFACE );

isa_ok(
	$display, 'SDL::Surface',
	'[set_video_more] Checking if we get a surface ref back'
);

#TODO: Write to surface and check inf pixel in that area got updated.

SDL::Video::update_rect( $display, 0, 0, 0, 0 );

#TODO: Write to surface and check inf pixel in that area got updated.
SDL::Video::update_rects( $display, SDL::Rect->new( 0, 10, 20, 20 ) );

my $value = SDL::Video::flip($display);
is( ( $value == 0 ) || ( $value == -1 ), 1, '[flip] returns 0 or -1' );

SKIP:
{
	skip( "These negative test may cause older versions of SDL to crash", 2 )
		unless $ENV{NEW_SDL};
	$value = SDL::Video::set_colors( $display, 0, SDL::Color->new( 0, 0, 0 ) );
	is( $value, 0, '[set_colors] returns 0 trying to write to 32 bit display' );

	$value = SDL::Video::set_palette( $display, SDL_LOGPAL | SDL_PHYSPAL, 0 );

	is( $value, 0,
		'[set_palette] returns 0 trying to write to 32 bit surface'
	);
}
SDL::delay(100);

my @b_w_colors;

for ( my $i = 0; $i < 256; $i++ ) {
	$b_w_colors[$i] = SDL::Color->new( $i, $i, $i );
}
my $overlay = SDL::Overlay->new( 200, 220, SDL_IYUV_OVERLAY, $display );

is( SDL::Video::lock_YUV_overlay($overlay),
	0, '[lock_YUV_overlay] returns a 0 on success'
);
SDL::Video::unlock_YUV_overlay($overlay);
pass '[unlock_YUV_overlay] ran';
my $display_at_rect = SDL::Rect->new( 0, 0, 100, 100 );
is( SDL::Video::display_YUV_overlay( $overlay, $display_at_rect ),
	0, '[display_YUV_overlay] returns 0 on success'
);

my $bmp_surface;
my $hwdisplay;

SKIP:
{
	skip( "No hardware surface available", 26 )
		unless $video_info->hw_available();

	$hwdisplay = SDL::Video::set_video_mode( 640, 480, 8, SDL_HWSURFACE );

	if ( !$hwdisplay ) {
		plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error();
	}

	$value = SDL::Video::set_colors( $hwdisplay, 0 );
	is( $value, 0,
		'[set_colors] returns 0 trying to send empty colors to 8 bit surface'
	);

	$value = SDL::Video::set_palette( $hwdisplay, SDL_LOGPAL | SDL_PHYSPAL, 0 );

	is( $value, 0,
		'[set_palette] returns 0 trying to send empty colors to 8 bit surface'
	);

	$value = SDL::Video::set_colors( $hwdisplay, 0, @b_w_colors );
	is( $value, 1, '[set_colors] returns ' . $value );

	$value = SDL::Video::set_palette(
		$hwdisplay, SDL_LOGPAL | SDL_PHYSPAL,
		0,          @b_w_colors
	);

	is( $value, 1, '[set_palette] returns 1' );

	$value = SDL::Video::lock_surface($hwdisplay);
	pass '[lock_surface] ran returned: ' . $value;

	SDL::Video::unlock_surface($hwdisplay);
	pass '[unlock_surface] ran';

	is( SDL::Video::map_RGB( $hwdisplay->format, 10, 10, 10 ) >= 0,
		1, '[map_RGB] maps correctly to 8-bit surface'
	);
	is( SDL::Video::map_RGBA( $hwdisplay->format, 10, 10, 10, 10 ) >= 0,
		1, '[map_RGBA] maps correctly to 8-bit surface'
	);

	TODO:
	{
		local $TODO = "These test case test a very specific test scenario which might need to be re tought out ...";

		isa_ok(
			SDL::Video::convert_surface( $hwdisplay, $hwdisplay->format, SDL_SRCALPHA ),
			'SDL::Surface',
			'[convert_surface] Checking if we get a surface ref back'
		);
		isa_ok(