PageRenderTime 13ms CodeModel.GetById 1ms app.highlight 9ms RepoModel.GetById 1ms app.codeStats 0ms

/t/sdlx_app.t

http://github.com/PerlGameDev/SDL
Perl | 79 lines | 62 code | 15 blank | 2 comment | 2 complexity | 1a4d9d07d6da1952b9eb2d95f8fe1bd7 MD5 | raw file
 1#!/usr/bin/perl -w
 2
 3# basic testing of SDLx::App
 4use strict;
 5use warnings;
 6use SDL;
 7use SDL::Config;
 8use SDL::Rect;
 9use SDLx::Rect;
10use SDL::Color;
11use SDL::Video;
12use Test::More;
13use lib 't/lib';
14use SDL::TestTool;
15
16plan( tests => 2 );
17
18use SDLx::App;
19
20can_ok(
21	'SDLx::App', qw/
22		new
23		resize
24		title
25		delay
26		ticks
27		error
28		warp
29		fullscreen
30		iconify
31		grab_input
32		sync
33		attribute
34		/
35);
36
37my $videodriver = $ENV{SDL_VIDEODRIVER};
38$ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
39
40SKIP:
41{
42	skip 'No Video', 1 unless SDL::TestTool->init(SDL_INIT_VIDEO);
43
44	my $app = SDLx::App->new(
45		title  => "Test",
46		width  => 640,
47		height => 480,
48		init   => SDL_INIT_VIDEO
49	);
50
51	my $rect = SDL::Rect->new( 0, 0, $app->w, $app->h );
52
53	my $pixel_format = $app->format;
54	my $blue_pixel   = SDL::Video::map_RGB( $pixel_format, 0x00, 0x00, 0xff );
55	my $col_pixel    = SDL::Video::map_RGB( $pixel_format, 0xf0, 0x00, 0x33 );
56
57	my $grect = SDLx::Rect->new( 10, 10, 30, 35 );
58	foreach ( 0 .. 80 ) {
59
60		$grect->x($_);
61		$grect->centery( $_ * 3 );
62		$grect->size( ( $_ / 40 ) * $_, ( $_ / 38 ) * $_ );
63		SDL::Video::fill_rect( $app, $rect,  $blue_pixel );
64		SDL::Video::fill_rect( $app, $grect, $col_pixel );
65
66		SDL::Video::update_rect( $app, 0, 0, 640, 480 );
67		SDL::delay(10);
68	}
69
70	SDL::delay(100);
71	pass 'Ran';
72}
73
74if ($videodriver) {
75	$ENV{SDL_VIDEODRIVER} = $videodriver;
76} else {
77	delete $ENV{SDL_VIDEODRIVER};
78}
79