/t/core_video.t

http://github.com/PerlGameDev/SDL · Perl · 443 lines · 364 code · 72 blank · 7 comment · 13 complexity · c367681a135e4f76e1ca5ff96c820a2d MD5 · raw file

  1. #!/usr/bin/perl -w
  2. use strict;
  3. use warnings;
  4. use SDL;
  5. use SDL::Color;
  6. use SDL::Surface;
  7. use SDL::Config;
  8. use SDL::Overlay;
  9. use Test::More;
  10. use SDL::Rect;
  11. use SDL::Video;
  12. use SDL::VideoInfo;
  13. use lib 't/lib';
  14. use SDL::TestTool;
  15. my $videodriver = $ENV{SDL_VIDEODRIVER};
  16. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  17. if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
  18. plan( skip_all => 'Failed to init video' );
  19. }
  20. my @done = qw/
  21. get_video_surface
  22. get_video_info
  23. video_driver_name
  24. list_modes
  25. set_video_mode
  26. video_mode_ok
  27. update_rect
  28. update_rects
  29. flip
  30. set_colors
  31. set_palette
  32. set_gamma
  33. set_gamma_ramp
  34. map_RGB
  35. map_RGBA
  36. unlock_surface
  37. lock_surface
  38. convert_surface
  39. display_format
  40. display_format_alpha
  41. set_color_key
  42. set_alpha
  43. get_RGB
  44. get_RGBA
  45. load_BMP
  46. save_BMP
  47. fill_rect
  48. blit_surface
  49. set_clip_rect
  50. get_clip_rect
  51. lock_YUV_overlay
  52. unlock_YUV_overlay
  53. display_YUV_overlay
  54. GL_load_library
  55. GL_get_proc_address
  56. GL_get_attribute
  57. GL_set_attribute
  58. GL_swap_buffers
  59. get_gamma_ramp
  60. wm_set_caption
  61. wm_get_caption
  62. wm_set_icon
  63. wm_toggle_fullscreen
  64. wm_iconify_window
  65. wm_grab_input
  66. /;
  67. can_ok( 'SDL::Video', @done );
  68. is( SDL_SWSURFACE, 0, 'SDL_SWSURFACE should be imported' );
  69. is( SDL_SWSURFACE(), 0, 'SDL_SWSURFACE() should also be available' );
  70. is( SDL_HWSURFACE, 1, 'SDL_HWSURFACE should be imported' );
  71. is( SDL_HWSURFACE(), 1, 'SDL_HWSURFACE() should also be available' );
  72. is( SDL_ASYNCBLIT, 4, 'SDL_ASYNCBLIT should be imported' );
  73. is( SDL_ASYNCBLIT(), 4, 'SDL_ASYNCBLIT() should also be available' );
  74. is( SDL_OPENGL, 2, 'SDL_OPENGL should be imported' );
  75. is( SDL_OPENGL(), 2, 'SDL_OPENGL() should also be available' );
  76. is( SDL_OPENGLBLIT, 10, 'SDL_OPENGLBLIT should be imported' );
  77. is( SDL_OPENGLBLIT(), 10, 'SDL_OPENGLBLIT() should also be available' );
  78. is( SDL_RESIZABLE, 16, 'SDL_RESIZABLE should be imported' );
  79. is( SDL_RESIZABLE(), 16, 'SDL_RESIZABLE() should also be available' );
  80. is( SDL_HWACCEL, 256, 'SDL_HWACCEL should be imported' );
  81. is( SDL_HWACCEL(), 256, 'SDL_HWACCEL() should also be available' );
  82. is( SDL_SRCCOLORKEY, 4096, 'SDL_SRCCOLORKEY should be imported' );
  83. is( SDL_SRCCOLORKEY(), 4096, 'SDL_SRCCOLORKEY() should also be available' );
  84. is( SDL_RLEACCELOK, 8192, 'SDL_RLEACCELOK should be imported' );
  85. is( SDL_RLEACCELOK(), 8192, 'SDL_RLEACCELOK() should also be available' );
  86. is( SDL_RLEACCEL, 16384, 'SDL_RLEACCEL should be imported' );
  87. is( SDL_RLEACCEL(), 16384, 'SDL_RLEACCEL() should also be available' );
  88. is( SDL_SRCALPHA, 65536, 'SDL_SRCALPHA should be imported' );
  89. is( SDL_SRCALPHA(), 65536, 'SDL_SRCALPHA() should also be available' );
  90. is( SDL_ANYFORMAT, 268435456, 'SDL_ANYFORMAT should be imported' );
  91. is( SDL_ANYFORMAT(), 268435456, 'SDL_ANYFORMAT() should also be available' );
  92. is( SDL_DOUBLEBUF, 1073741824, 'SDL_DOUBLEBUF should be imported' );
  93. is( SDL_DOUBLEBUF(), 1073741824, 'SDL_DOUBLEBUF() should also be available' );
  94. is( SDL_FULLSCREEN, 0x80000000, 'SDL_FULLSCREEN should be imported' );
  95. is( SDL_FULLSCREEN(), 0x80000000, 'SDL_FULLSCREEN() should also be available' );
  96. is( SDL_HWPALETTE, 536870912, 'SDL_HWPALETTE should be imported' );
  97. is( SDL_HWPALETTE(), 536870912, 'SDL_HWPALETTE() should also be available' );
  98. is( SDL_PREALLOC, 16777216, 'SDL_PREALLOC should be imported' );
  99. is( SDL_PREALLOC(), 16777216, 'SDL_PREALLOC() should also be available' );
  100. is( SDL_IYUV_OVERLAY, 1448433993, 'SDL_IYUV_OVERLAY should be imported' );
  101. is( SDL_IYUV_OVERLAY(), 1448433993,
  102. 'SDL_IYUV_OVERLAY() should also be available'
  103. );
  104. is( SDL_UYVY_OVERLAY, 1498831189, 'SDL_UYVY_OVERLAY should be imported' );
  105. is( SDL_UYVY_OVERLAY(), 1498831189,
  106. 'SDL_UYVY_OVERLAY() should also be available'
  107. );
  108. is( SDL_YUY2_OVERLAY, 844715353, 'SDL_YUY2_OVERLAY should be imported' );
  109. is( SDL_YUY2_OVERLAY(), 844715353,
  110. 'SDL_YUY2_OVERLAY() should also be available'
  111. );
  112. is( SDL_YV12_OVERLAY, 842094169, 'SDL_YV12_OVERLAY should be imported' );
  113. is( SDL_YV12_OVERLAY(), 842094169,
  114. 'SDL_YV12_OVERLAY() should also be available'
  115. );
  116. is( SDL_YVYU_OVERLAY, 1431918169, 'SDL_YVYU_OVERLAY should be imported' );
  117. is( SDL_YVYU_OVERLAY(), 1431918169,
  118. 'SDL_YVYU_OVERLAY() should also be available'
  119. );
  120. is( SDL_LOGPAL, 0x01, 'SDL_LOGPAL should be imported' );
  121. is( SDL_LOGPAL(), 0x01, 'SDL_LOGPAL() should also be available' );
  122. is( SDL_PHYSPAL, 0x02, 'SDL_PHYSPAL should be imported' );
  123. is( SDL_PHYSPAL(), 0x02, 'SDL_PHYSPAL() should also be available' );
  124. is( SDL_GRAB_OFF, 0, 'SDL_GRAB_OFF should be imported' );
  125. is( SDL_GRAB_OFF(), 0, 'SDL_GRAB_OFF() should also be available' );
  126. is( SDL_GRAB_ON, 1, 'SDL_GRAB_ON should be imported' );
  127. is( SDL_GRAB_ON(), 1, 'SDL_GRAB_ON() should also be available' );
  128. is( SDL_GRAB_QUERY, -1, 'SDL_GRAB_QUERY should be imported' );
  129. is( SDL_GRAB_QUERY(), -1, 'SDL_GRAB_QUERY() should also be available' );
  130. #needs to be done before set_video_mode
  131. my $glVal = SDL::Video::GL_load_library('this/should/fail');
  132. is( $glVal, -1, '[GL_load_library] Failed appropriately' );
  133. TODO: {
  134. local $TODO = 'These should be tested with OS specific DLL or SO';
  135. is( SDL::Video::GL_load_library('t/realGL.so'),
  136. 0, '[GL_load_libary] returns 0 on success'
  137. );
  138. # this gets set by GL_load_library => SDL_GL_LOADLIBARY. How do we get this from XS though?
  139. # below t/realGL.so needs to use SDL_GL_LOADLIBRARY
  140. isnt(
  141. SDL::Video::GL_get_proc_address('t/realGL.so'),
  142. 0, '[GL_get_proc_address] returns not null on success'
  143. );
  144. is( SDL::Video::GL_set_attribute( SDL_GL_DOUBLEBUFFER, 1 ),
  145. 0, '[GL_set_attribute] returns 0 on success'
  146. );
  147. my $tdisplay = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
  148. my $value = -3;
  149. SDL::Video::GL_set_attribute( SDL_GL_DOUBLEBUFFER, $value );
  150. is( $value, 1, '[GL_get_attribute] returns 1 on success as set above' );
  151. SDL::Video::GL_swap_buffers();
  152. pass('[GL_swap_buffers] should work because Double Buffering is turned on');
  153. }
  154. my $video_info = SDL::Video::get_video_info();
  155. isa_ok(
  156. $video_info, 'SDL::VideoInfo',
  157. '[get_video_info] Checking if we get videoinfo ref back'
  158. );
  159. my $list_modes = SDL::Video::list_modes(
  160. $video_info->vfmt,
  161. SDL_NOFRAME | SDL_HWSURFACE | SDL_FULLSCREEN
  162. );
  163. is( ref($list_modes), 'ARRAY', '[list_modes] Returned an ARRAY! ' );
  164. my @modes = @{$list_modes};
  165. if ( $#modes > 0 ) {
  166. foreach my $mode (@modes) {
  167. ok( $mode->w > 0 && $mode->h > 0,
  168. '[list_modes] available mode: ' . $mode->w . ' x ' . $mode->h
  169. );
  170. }
  171. } elsif ( $#modes == 0 ) {
  172. is( $modes[0], 'all', '[list_modes] available mode: all' );
  173. }
  174. my $display = SDL::Video::set_video_mode( 640, 480, 32, SDL_SWSURFACE );
  175. if ( !$display ) {
  176. plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error();
  177. }
  178. #diag('Testing SDL::Video');
  179. isa_ok(
  180. SDL::Video::get_video_surface(),
  181. 'SDL::Surface',
  182. '[get_video_surface] Checking if we get a surface ref back'
  183. );
  184. my $driver_name = SDL::Video::video_driver_name();
  185. pass '[video_driver_name] This is your driver name: ' . $driver_name;
  186. cmp_ok(
  187. SDL::Video::video_mode_ok( 100, 100, 16, SDL_SWSURFACE ),
  188. '>=', 0, "[video_mode_ok] Checking if an integer was return"
  189. );
  190. $display = SDL::Video::set_video_mode( 100, 100, 16, SDL_SWSURFACE );
  191. isa_ok(
  192. $display, 'SDL::Surface',
  193. '[set_video_more] Checking if we get a surface ref back'
  194. );
  195. #TODO: Write to surface and check inf pixel in that area got updated.
  196. SDL::Video::update_rect( $display, 0, 0, 0, 0 );
  197. #TODO: Write to surface and check inf pixel in that area got updated.
  198. SDL::Video::update_rects( $display, SDL::Rect->new( 0, 10, 20, 20 ) );
  199. my $value = SDL::Video::flip($display);
  200. is( ( $value == 0 ) || ( $value == -1 ), 1, '[flip] returns 0 or -1' );
  201. SKIP:
  202. {
  203. skip( "These negative test may cause older versions of SDL to crash", 2 )
  204. unless $ENV{NEW_SDL};
  205. $value = SDL::Video::set_colors( $display, 0, SDL::Color->new( 0, 0, 0 ) );
  206. is( $value, 0, '[set_colors] returns 0 trying to write to 32 bit display' );
  207. $value = SDL::Video::set_palette( $display, SDL_LOGPAL | SDL_PHYSPAL, 0 );
  208. is( $value, 0,
  209. '[set_palette] returns 0 trying to write to 32 bit surface'
  210. );
  211. }
  212. SDL::delay(100);
  213. my @b_w_colors;
  214. for ( my $i = 0; $i < 256; $i++ ) {
  215. $b_w_colors[$i] = SDL::Color->new( $i, $i, $i );
  216. }
  217. my $overlay = SDL::Overlay->new( 200, 220, SDL_IYUV_OVERLAY, $display );
  218. is( SDL::Video::lock_YUV_overlay($overlay),
  219. 0, '[lock_YUV_overlay] returns a 0 on success'
  220. );
  221. SDL::Video::unlock_YUV_overlay($overlay);
  222. pass '[unlock_YUV_overlay] ran';
  223. my $display_at_rect = SDL::Rect->new( 0, 0, 100, 100 );
  224. is( SDL::Video::display_YUV_overlay( $overlay, $display_at_rect ),
  225. 0, '[display_YUV_overlay] returns 0 on success'
  226. );
  227. my $bmp_surface;
  228. my $hwdisplay;
  229. SKIP:
  230. {
  231. skip( "No hardware surface available", 26 )
  232. unless $video_info->hw_available();
  233. $hwdisplay = SDL::Video::set_video_mode( 640, 480, 8, SDL_HWSURFACE );
  234. if ( !$hwdisplay ) {
  235. plan skip_all => 'Couldn\'t set video mode: ' . SDL::get_error();
  236. }
  237. $value = SDL::Video::set_colors( $hwdisplay, 0 );
  238. is( $value, 0,
  239. '[set_colors] returns 0 trying to send empty colors to 8 bit surface'
  240. );
  241. $value = SDL::Video::set_palette( $hwdisplay, SDL_LOGPAL | SDL_PHYSPAL, 0 );
  242. is( $value, 0,
  243. '[set_palette] returns 0 trying to send empty colors to 8 bit surface'
  244. );
  245. $value = SDL::Video::set_colors( $hwdisplay, 0, @b_w_colors );
  246. is( $value, 1, '[set_colors] returns ' . $value );
  247. $value = SDL::Video::set_palette(
  248. $hwdisplay, SDL_LOGPAL | SDL_PHYSPAL,
  249. 0, @b_w_colors
  250. );
  251. is( $value, 1, '[set_palette] returns 1' );
  252. $value = SDL::Video::lock_surface($hwdisplay);
  253. pass '[lock_surface] ran returned: ' . $value;
  254. SDL::Video::unlock_surface($hwdisplay);
  255. pass '[unlock_surface] ran';
  256. is( SDL::Video::map_RGB( $hwdisplay->format, 10, 10, 10 ) >= 0,
  257. 1, '[map_RGB] maps correctly to 8-bit surface'
  258. );
  259. is( SDL::Video::map_RGBA( $hwdisplay->format, 10, 10, 10, 10 ) >= 0,
  260. 1, '[map_RGBA] maps correctly to 8-bit surface'
  261. );
  262. TODO:
  263. {
  264. local $TODO = "These test case test a very specific test scenario which might need to be re tought out ...";
  265. isa_ok(
  266. SDL::Video::convert_surface( $hwdisplay, $hwdisplay->format, SDL_SRCALPHA ),
  267. 'SDL::Surface',
  268. '[convert_surface] Checking if we get a surface ref back'
  269. );
  270. isa_ok(
  271. SDL::Video::display_format($hwdisplay),
  272. 'SDL::Surface', '[display_format] Returns a SDL::Surface'
  273. );
  274. isa_ok(
  275. SDL::Video::display_format_alpha($hwdisplay),
  276. 'SDL::Surface', '[display_format_alpha] Returns a SDL::Surface'
  277. );
  278. }
  279. is( SDL::Video::set_color_key( $hwdisplay, SDL_SRCCOLORKEY, SDL::Color->new( 0, 10, 0 ) ),
  280. 0,
  281. '[set_color_key] Returns 0 on success'
  282. );
  283. is( SDL::Video::set_alpha( $hwdisplay, SDL_SRCALPHA, 100 ),
  284. 0, '[set_alpha] Returns 0 on success'
  285. );
  286. is_deeply(
  287. SDL::Video::get_RGB( $hwdisplay->format, 0 ),
  288. [ 0, 0, 0 ],
  289. '[get_RGB] returns r,g,b'
  290. );
  291. is_deeply(
  292. SDL::Video::get_RGBA( $hwdisplay->format, 0 ),
  293. [ 0, 0, 0, 255 ],
  294. '[get_RGBA] returns r,g,b,a'
  295. );
  296. my $bmp = 't/core_video.bmp';
  297. unlink($bmp) if -f $bmp;
  298. SDL::Video::save_BMP( $hwdisplay, $bmp );
  299. ok( -f $bmp, '[save_BMP] creates a file' );
  300. $bmp_surface = SDL::Video::load_BMP($bmp);
  301. isa_ok(
  302. $bmp_surface, 'SDL::Surface',
  303. '[load_BMP] returns an SDL::Surface'
  304. );
  305. unlink($bmp) if -f $bmp;
  306. my $pixel = SDL::Video::map_RGB( $hwdisplay->format, 255, 127, 0 );
  307. SDL::Video::fill_rect( $hwdisplay, SDL::Rect->new( 0, 0, 32, 32 ), $pixel );
  308. ok( 1, '[fill_rect] filled rect' );
  309. my $clip_rect = SDL::Rect->new( 0, 0, 10, 20 );
  310. SDL::Video::get_clip_rect( $hwdisplay, $clip_rect );
  311. is( $clip_rect->x, 0, '[get_clip_rect] returns a rect with x 0' );
  312. is( $clip_rect->y, 0, '[get_clip_rect] returns a rect with y 0' );
  313. is( $clip_rect->w, 640, '[get_clip_rect] returns a rect with w 640' );
  314. is( $clip_rect->h, 480, '[get_clip_rect] returns a rect with h 480' );
  315. SDL::Video::set_clip_rect( $hwdisplay, SDL::Rect->new( 10, 20, 100, 200 ) );
  316. SDL::Video::get_clip_rect( $hwdisplay, $clip_rect );
  317. is( $clip_rect->x, 10, '[get_clip_rect] returns a rect with x 10' );
  318. is( $clip_rect->y, 20, '[get_clip_rect] returns a rect with y 20' );
  319. is( $clip_rect->w, 100, '[get_clip_rect] returns a rect with w 100' );
  320. is( $clip_rect->h, 200, '[get_clip_rect] returns a rect with h 200' );
  321. }
  322. SKIP:
  323. {
  324. skip( "No window manager available", 11 )
  325. unless $video_info->wm_available();
  326. my ( $title, $icon ) = @{ SDL::Video::wm_get_caption() };
  327. is( $title, undef, '[wm_get_caption] title is undef' );
  328. is( $icon, undef, '[wm_get_caption] icon is undef' );
  329. SDL::Video::wm_set_caption( 'Title text', 'Icon text' );
  330. ( $title, $icon ) = @{ SDL::Video::wm_get_caption() };
  331. is( $title, 'Title text', '[wm_set_caption set title]' );
  332. is( $icon, 'Icon text', '[wm_set_caption set icon]' );
  333. SKIP:
  334. {
  335. skip( "No hardware surface available", 1 )
  336. unless $video_info->hw_available();
  337. SDL::Video::wm_set_icon($bmp_surface);
  338. pass '[wm_set_icon] ran';
  339. }
  340. SKIP:
  341. {
  342. skip 'Turn on SDL_GUI_TEST', 6 unless $ENV{SDL_GUI_TEST};
  343. SDL::Video::wm_grab_input(SDL_GRAB_ON);
  344. pass '[wm_grab_input] ran with SDL_GRAB_ON';
  345. is( SDL::Video::wm_grab_input(SDL_GRAB_QUERY),
  346. SDL_GRAB_ON, '[wm_grab_input] Got Correct grab mode back'
  347. );
  348. SDL::Video::wm_grab_input(SDL_GRAB_OFF);
  349. pass '[wm_grab_input] ran with SDL_GRAB_OFF';
  350. is( SDL::Video::wm_grab_input(SDL_GRAB_QUERY),
  351. SDL_GRAB_OFF, '[wm_grab_input] Got Correct grab mode back'
  352. );
  353. my $ic = SDL::Video::wm_iconify_window();
  354. is( $ic, 1, '[wm_iconify_window] ran' );
  355. SKIP:
  356. {
  357. skip( "No hardware surface available", 1 )
  358. unless $video_info->hw_available();
  359. SDL::Video::wm_toggle_fullscreen($hwdisplay);
  360. pass '[wm_toggle_fullscreen] ran';
  361. }
  362. }
  363. }
  364. if ($videodriver) {
  365. $ENV{SDL_VIDEODRIVER} = $videodriver;
  366. } else {
  367. delete $ENV{SDL_VIDEODRIVER};
  368. }
  369. pass 'Are we still alive? Checking for segfaults';
  370. sleep(1);
  371. done_testing();