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