Commit | Line | Data |
df4106bf |
1 | #!/usr/bin/perl -w |
df4106bf |
2 | use strict; |
3 | use SDL; |
2739f940 |
4 | use SDL::Color; |
4510df28 |
5 | use SDL::Surface; |
df4106bf |
6 | use SDL::Config; |
7fa192d4 |
7 | use Devel::Peek; |
4510df28 |
8 | use Data::Dumper; |
df4106bf |
9 | use Test::More; |
eaf32d63 |
10 | use SDL::Rect; |
df4106bf |
11 | |
1e72b6a4 |
12 | plan ( tests => 22 ); |
df4106bf |
13 | |
14 | use_ok( 'SDL::Video' ); |
494f077a |
15 | |
16 | my @done = |
17 | qw/ |
df4106bf |
18 | get_video_surface |
19 | get_video_info |
8a2411d0 |
20 | video_driver_name |
7dda1934 |
21 | list_modes |
bbe5d2f5 |
22 | set_video_mode |
218b5471 |
23 | video_mode_ok |
eaf32d63 |
24 | update_rect |
25 | update_rects |
19f3ee7b |
26 | flip |
2739f940 |
27 | set_colors |
69341787 |
28 | set_palette |
5e9f2784 |
29 | set_gamma |
7b7e8017 |
30 | set_gamma_ramp |
2d2bb756 |
31 | map_RGB |
32 | map_RGBA |
1e72b6a4 |
33 | unlock_surface |
34 | lock_surface |
494f077a |
35 | /; |
69341787 |
36 | |
494f077a |
37 | can_ok ('SDL::Video', @done); |
95f5be30 |
38 | |
39 | #testing get_video_surface |
d5a2f5ac |
40 | SDL::init(SDL_INIT_VIDEO); |
95f5be30 |
41 | |
0a01cb9e |
42 | my $display = SDL::Video::set_video_mode(640,480,32, SDL_SWSURFACE ); |
43 | |
44 | if(!$display){ |
c5bf64e5 |
45 | plan skip_all => 'Couldn\'t set video mode: '. SDL::get_error(); |
0a01cb9e |
46 | } |
95f5be30 |
47 | |
218b5471 |
48 | #diag('Testing SDL::Video'); |
95f5be30 |
49 | |
e4259ddb |
50 | isa_ok(SDL::Video::get_video_surface(), 'SDL::Surface', '[get_video_surface] Checking if we get a surface ref back'); |
51 | |
52 | isa_ok(SDL::Video::get_video_info(), 'SDL::VideoInfo', '[get_video_info] Checking if we get videoinfo ref back'); |
20f544ea |
53 | |
7fa192d4 |
54 | my $driver_name = SDL::Video::video_driver_name(); |
55 | |
e4259ddb |
56 | pass '[video_driver_name] This is your driver name: '.$driver_name; |
7fa192d4 |
57 | |
218b5471 |
58 | |
59 | |
60 | is( ref( SDL::Video::list_modes( $display->format , SDL_SWSURFACE )), 'ARRAY', '[list_modes] Returned an ARRAY! '); |
61 | |
62 | cmp_ok(SDL::Video::video_mode_ok( 100, 100, 16, SDL_SWSURFACE), '>=', 0, "[video_mode_ok] Checking if an integer was return"); |
7fa192d4 |
63 | |
bbe5d2f5 |
64 | isa_ok(SDL::Video::set_video_mode( 100, 100 ,16, SDL_SWSURFACE), 'SDL::Surface', '[set_video_more] Checking if we get a surface ref back'); |
65 | |
66 | |
bbe5d2f5 |
67 | #TODO: Write to surface and check inf pixel in that area got updated. |
68 | |
eaf32d63 |
69 | SDL::Video::update_rect($display, 0, 0, 0, 0); |
70 | |
bbe5d2f5 |
71 | #TODO: Write to surface and check inf pixel in that area got updated. |
eaf32d63 |
72 | SDL::Video::update_rects($display, SDL::Rect->new(0, 10, 20, 20)); |
73 | |
b9125226 |
74 | my $value = SDL::Video::flip($display); |
75 | is( ($value == 0) || ($value == -1), 1, '[flip] returns 0 or -1' ); |
19f3ee7b |
76 | |
f00538b9 |
77 | $value = SDL::Video::set_colors($display, 0, SDL::Color->new(0,0,0)); |
78 | is( $value , 0, '[set_colors] returns 0 trying to write to 32 bit display' ); |
2739f940 |
79 | |
5e9f2784 |
80 | $value = SDL::Video::set_palette($display, SDL_LOGPAL|SDL_PHYSPAL, 0); |
69341787 |
81 | |
82 | is( $value , 0, '[set_palette] returns 0 trying to write to 32 bit surface' ); |
83 | |
7b7e8017 |
84 | my $zero = [0,0,0,0]; |
85 | SDL::Video::set_gamma_ramp($zero, $zero, $zero); pass '[set_gamma_ramp] ran'; |
69341787 |
86 | |
5e9f2784 |
87 | SDL::Video::set_gamma( 1.0, 1.0, 1.0 ); pass '[set_gamma] ran '; |
69341787 |
88 | |
0a01cb9e |
89 | my @b_w_colors; |
90 | |
91 | for(my $i=0;$i<256;$i++){ |
92 | $b_w_colors[$i] = SDL::Color->new($i,$i,$i); |
93 | } |
f00538b9 |
94 | my $hwdisplay = SDL::Video::set_video_mode(640,480,8, SDL_HWSURFACE ); |
95 | |
96 | if(!$hwdisplay){ |
c5bf64e5 |
97 | plan skip_all => 'Couldn\'t set video mode: '. SDL::get_error(); |
f00538b9 |
98 | } |
99 | |
100 | $value = SDL::Video::set_colors($hwdisplay, 0); |
101 | is( $value , 0, '[set_colors] returns 0 trying to send empty colors to 8 bit surface' ); |
102 | |
5e9f2784 |
103 | $value = SDL::Video::set_palette($hwdisplay, SDL_LOGPAL|SDL_PHYSPAL, 0); |
69341787 |
104 | |
105 | is( $value , 0, '[set_palette] returns 0 trying to send empty colors to 8 bit surface' ); |
bc1947c7 |
106 | |
494f077a |
107 | |
f00538b9 |
108 | $value = SDL::Video::set_colors($hwdisplay, 0, @b_w_colors); |
109 | is( $value , 1, '[set_colors] returns '.$value ); |
0a01cb9e |
110 | |
5e9f2784 |
111 | $value = SDL::Video::set_palette($hwdisplay, SDL_LOGPAL|SDL_PHYSPAL, 0, @b_w_colors ); |
69341787 |
112 | |
113 | is( $value , 1, '[set_palette] returns 1' ); |
114 | |
1e72b6a4 |
115 | $value = SDL::Video::lock_surface($hwdisplay); pass '[lock_surface] ran returned: '.$value; |
116 | |
117 | SDL::Video::unlock_surface($hwdisplay); pass '[unlock_surface] ran'; |
69341787 |
118 | |
2d2bb756 |
119 | is( SDL::Video::map_RGB($hwdisplay->format, 10, 10 ,10) > 0, 1, '[map_RGB] maps correctly to 8-bit surface'); |
120 | is( SDL::Video::map_RGBA($hwdisplay->format, 10, 10 ,10, 10) > 0, 1, '[map_RGBA] maps correctly to 8-bit surface'); |
494f077a |
121 | |
122 | my @left = qw/ |
df4106bf |
123 | get_gamma_ramp |
df4106bf |
124 | get_RGB |
125 | get_RGBA |
df4106bf |
126 | convert_surface |
127 | display_format |
128 | display_format_alpha |
129 | load_BMP |
130 | save_BMP |
131 | set_color_key |
132 | set_alpha |
133 | set_clip_rect |
134 | get_clip_rect |
135 | blit_surface |
136 | fill_rect |
137 | GL_load_library |
138 | GL_get_proc_address |
139 | GL_get_attribute |
140 | GL_set_attribute |
141 | GL_swap_buffers |
142 | GL_attr |
df4106bf |
143 | lock_YUV_overlay |
144 | unlock_YUV_overlay |
145 | display_YUV_overlay |
494f077a |
146 | /; |
147 | |
148 | my $why = '[Percentage Completion] '.int( 100 * $#done / ($#done + $#left) ) ."\% implementation. $#done / ".($#done+$#left); |
149 | |
150 | TODO: |
151 | { |
2739f940 |
152 | local $TODO = $why; |
153 | pass "\nThe following functions:\n".join ",", @left; |
494f077a |
154 | } |
2739f940 |
155 | diag $why; |
156 | |
df4106bf |
157 | |
8be6ce42 |
158 | pass 'Are we still alive? Checking for segfaults'; |