/t/core_video.t
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();