PageRenderTime 47ms CodeModel.GetById 19ms RepoModel.GetById 1ms app.codeStats 0ms

/t/sdlx_surface.t

http://github.com/PerlGameDev/SDL
Unknown | 252 lines | 203 code | 49 blank | 0 comment | 0 complexity | 352494f2f3bf3cce1c4048fcad5c389e MD5 | raw file
Possible License(s): AGPL-1.0, GPL-2.0
  1. use strict;
  2. use warnings;
  3. use Test::More;
  4. use SDL;
  5. use SDL::Surface;
  6. use SDL::Rect;
  7. use SDLx::Surface;
  8. use SDL::PixelFormat;
  9. use SDL::Video;
  10. use Data::Dumper;
  11. use lib 't/lib';
  12. use SDL::TestTool;
  13. my $videodriver = $ENV{SDL_VIDEODRIVER};
  14. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  15. if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
  16. plan( skip_all => 'Failed to init video' );
  17. }
  18. my $app = SDL::Video::set_video_mode( 400, 200, 32, SDL_SWSURFACE );
  19. my $app_x = SDLx::Surface::display();
  20. is_deeply(
  21. $app_x->surface->get_pixels_ptr,
  22. $app->get_pixels_ptr, '[display] works'
  23. );
  24. my $surface = SDL::Surface->new( SDL_SWSURFACE, 400, 200, 32 );
  25. my @surfs = (
  26. SDLx::Surface->new( surface => $surface ),
  27. SDLx::Surface->new( width => 400, height => 200 ),
  28. SDLx::Surface->new(
  29. width => 400,
  30. height => 200,
  31. flags => SDL_SWSURFACE,
  32. depth => 32
  33. ),
  34. SDLx::Surface->new(
  35. width => 400,
  36. height => 200,
  37. flags => SDL_SWSURFACE,
  38. depth => 32,
  39. greenmask => 0xFF000000
  40. ),
  41. );
  42. foreach my $a (@surfs) {
  43. isa_ok( $a, 'SDLx::Surface' );
  44. isa_ok( $a->surface(), 'SDL::Surface' );
  45. my $color = $a->[0][0];
  46. is( $color, 0, 'Right color returned' );
  47. $a->[0][0] = 0x00FF00FF;
  48. is( $a->[0][0], 0x00FF00FF, 'Right color returned' );
  49. is( @{$a}, 200, 'Correct Y value' );
  50. is( @{ $a->[0] }, 400, 'Correct X value' );
  51. }
  52. #my $source = SDLx::Surface->new( width=> 400, height=>200, flags=> SDL_SWSURFACE, depth=>32 ),
  53. is( $surfs[0]->[1][2], 0, 'Checking source pixel is 0' );
  54. is( $surfs[1]->[1][2], 0, 'Checking dest pixel is 0' );
  55. $surfs[0]->[4][4] = [255,255,0,255];
  56. is( $surfs[0]->[4][4] , 0xFFFF00FF, "Surface can set pixel with other color values");
  57. $surfs[0]->[1][2] = 0x00FF00FF;
  58. is( $surfs[0]->[1][2], 0x00FF00FF, 'Checking that source pixel got written' );
  59. $surfs[0]->blit( $surfs[1] );
  60. #SDL::Video::blit_surface( $surfs[0]->surface, SDL::Rect->new(0,0,400,200), $surfs[1]->surface, SDL::Rect->new(0,0,400,200));
  61. isnt( $surfs[1]->[1][2], 0, 'Pixel blitted from one surface to another' );
  62. $surfs[1]->blit_by( $surfs[0], undef, [ 1, 0, 0, 0 ] );
  63. isnt( $surfs[1]->[2][2], 0, 'Pixel by_blitted to another surface with offset' );
  64. push @surfs,
  65. SDLx::Surface->new(
  66. w => 1,
  67. h => 1,
  68. color => 0x204080FF,
  69. );
  70. my $fill = SDL::Video::get_RGBA( $surfs[-1]->surface()->format(), $surfs[-1]->[0][0] );
  71. is( $fill->[0], 0x20, 'Fill color red worked' );
  72. is( $fill->[1], 0x40, 'Fill color green worked' );
  73. is( $fill->[2], 0x80, 'Fill color blue worked' );
  74. is( $fill->[3], 0xFF, 'Fill color alpha worked' );
  75. $surfs[1]->flip();
  76. pass 'Fliped the surface';
  77. $surfs[0]->update();
  78. pass 'update all surface';
  79. $surfs[0]->update( [ 0, 10, 30, 40 ] );
  80. pass 'Single rect update';
  81. $surfs[0]->update( [ SDL::Rect->new( 0, 1, 2, 3 ), SDL::Rect->new( 2, 4, 5, 6 ) ] );
  82. pass 'SDL::Rect array update';
  83. my @colors = (
  84. # opaque
  85. [ 0xFF, 0xFF, 0xFF, 0xFF ],
  86. [ 0xFF, 0xFF, 0x00, 0xFF ],
  87. [ 0xFF, 0x00, 0xFF, 0xFF ],
  88. [ 0x00, 0xFF, 0xFF, 0xFF ],
  89. [ 0xFF, 0x00, 0x00, 0xFF ],
  90. [ 0x00, 0xFF, 0x00, 0xFF ],
  91. [ 0x00, 0x00, 0xFF, 0xFF ],
  92. [ 0x00, 0x00, 0x00, 0xFF ],
  93. [ 0x20, 0x40, 0x80, 0xFF ],
  94. [ 0x80, 0x20, 0x40, 0xFF ],
  95. [ 0x40, 0x80, 0x20, 0xFF ],
  96. # translucent
  97. [ 0xFF, 0xFF, 0xFF, 0xCC ],
  98. [ 0xFF, 0xFF, 0x00, 0xCC ],
  99. [ 0xFF, 0x00, 0xFF, 0xCC ],
  100. [ 0x00, 0xFF, 0xFF, 0xCC ],
  101. [ 0xFF, 0x00, 0x00, 0xCC ],
  102. [ 0x00, 0xFF, 0x00, 0xCC ],
  103. [ 0x00, 0x00, 0xFF, 0xCC ],
  104. [ 0x00, 0x00, 0x00, 0xCC ],
  105. [ 0x20, 0x40, 0x80, 0xCC ],
  106. [ 0x80, 0x20, 0x40, 0xCC ],
  107. [ 0x40, 0x80, 0x20, 0xCC ],
  108. # transparent
  109. [ 0xFF, 0xFF, 0xFF, 0x00 ],
  110. [ 0xFF, 0xFF, 0x00, 0x00 ],
  111. [ 0xFF, 0x00, 0xFF, 0x00 ],
  112. [ 0x00, 0xFF, 0xFF, 0x00 ],
  113. [ 0xFF, 0x00, 0x00, 0x00 ],
  114. [ 0x00, 0xFF, 0x00, 0x00 ],
  115. [ 0x00, 0x00, 0xFF, 0x00 ],
  116. [ 0x00, 0x00, 0x00, 0x00 ],
  117. [ 0x20, 0x40, 0x80, 0x00 ],
  118. [ 0x80, 0x20, 0x40, 0x00 ],
  119. [ 0x40, 0x80, 0x20, 0x00 ],
  120. );
  121. foreach my $c (@colors) {
  122. my $color = ( $c->[0] << 24 ) + ( $c->[1] << 16 ) + ( $c->[2] << 8 ) + $c->[3];
  123. $surfs[0]->draw_rect( [ 0, 0, 10, 20 ], $c );
  124. my $num = sprintf( '0x%08x', $color );
  125. my $rgba = SDL::Video::get_RGBA( $surfs[0]->surface()->format(), $surfs[0]->[0][0] );
  126. is( $rgba->[0], $c->[0], "draw_rect uses correct red for $num" );
  127. is( $rgba->[1], $c->[1], "draw_rect uses correct green for $num" );
  128. is( $rgba->[2], $c->[2], "draw_rect uses correct blue for $num" );
  129. is( $rgba->[3], $c->[3], "draw_rect uses correct alpha for $num" );
  130. }
  131. $surfs[0]->draw_rect( [ 0, 0, 10, 20 ], 0xFF00FFFF );
  132. pass 'draw_rect works';
  133. SKIP:
  134. {
  135. skip( 'SDL_gfx_primitives needed', 2 ) unless SDL::Config->has('SDL_gfx_primitives');
  136. is( $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff ), $surfs[1], 'draw_line returns self' );
  137. $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ff );
  138. $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff );
  139. $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], 0xff00ffff, 1 );
  140. $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], [ 255, 255, 0, 255 ] );
  141. $surfs[1]->draw_line( [ 0, 10 ], [ 20, 10 ], [ 255, 255, 0, 255 ], 1 );
  142. pass 'draw_line works';
  143. $surfs[1]->draw_gfx_text( [ 0, 0 ], 0xffffffff, "fooo" );
  144. $surfs[1]->draw_gfx_text( [ 10, 10 ], [ 20, 20, 20, 20 ], "fooo" );
  145. my $f = '';
  146. open( my $FH, '<', 'test/data/5x7.fnt' );
  147. binmode($FH);
  148. read( $FH, $f, 4096 );
  149. close($FH);
  150. my $font = { data => $f, cw => 5, ch => 7 };
  151. $surfs[1]->draw_gfx_text( [ 0, 0 ], 0xffffffff, "fooo", $font );
  152. pass 'draw_gfx_text works';
  153. my @colors_t = ( [ 255, 0, 0, 255 ], 0xFF0000FF, 0xFF00FF, [ 255, 0, 255 ] );
  154. is( $surfs[0]->draw_circle( [ 100, 10 ], 20, [ 0, 0, 0, 0] ), $surfs[0], 'draw_circle returns self' );
  155. foreach my $cir_color (@colors_t) {
  156. my $cir_color = [ 255, 0, 0, 255 ];
  157. $surfs[0]->draw_circle( [ 100, 10 ], 20, $cir_color ); #no fill
  158. $surfs[0]->draw_circle( [ 102, 12 ], 22, $cir_color , 1 );
  159. $surfs[0]->draw_circle_filled( [ 100, 10 ], 20, $cir_color ); #fill
  160. isnt( $surfs[0]->[100][10], 0 );
  161. pass 'draw_circle works';
  162. pass 'draw_circle_filled works';
  163. }
  164. is( $surfs[0]->draw_trigon( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_trigon returns self' );
  165. is( $surfs[0]->draw_trigon_filled( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_trigon_filled returns self' );
  166. foreach my $color (@colors_t) {
  167. my $color = [ 255, 0, 0, 255 ];
  168. my $verts = [ [100, 10], [110, 10], [110, 20] ];
  169. $surfs[0]->draw_trigon( $verts, $color ); #no fill
  170. $surfs[0]->draw_trigon( $verts, $color, 1 );
  171. $surfs[0]->draw_trigon_filled( $verts, $color ); #fill
  172. isnt( $surfs[0]->[100][10], 0 );
  173. pass 'draw_trigon works';
  174. pass 'draw_trigon_filled works';
  175. }
  176. is( $surfs[0]->draw_polygon( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_polygon returns self' );
  177. is( $surfs[0]->draw_polygon_filled( [ [100, 10], [110, 10], [110, 20] ], [ 255, 0, 0, 255 ] ), $surfs[0], 'draw_polygon_filled returns self' );
  178. foreach my $color (@colors_t) {
  179. my $color = [ 255, 0, 0, 255 ];
  180. my $verts = [ [100, 10], [110, 10], [110, 20], [100, 20] ];
  181. $surfs[0]->draw_polygon( $verts, $color ); #no fill
  182. $surfs[0]->draw_polygon( $verts, $color, 1 );
  183. $surfs[0]->draw_polygon_filled( $verts, $color ); #fill
  184. isnt( $surfs[0]->[100][10], 0 );
  185. pass 'draw_polygon works';
  186. pass 'draw_polygon_filled works';
  187. }
  188. }
  189. my $surf_dup = SDLx::Surface::duplicate( $surfs[1] );
  190. is( $surf_dup->w, $surfs[1]->w, 'Duplicate surf has same width' );
  191. is( $surf_dup->h, $surfs[1]->h, 'Duplicate surf has same flags' );
  192. is( $surf_dup->flags, $surfs[1]->flags, 'Duplicate surf has same flags' );
  193. is( $surf_dup->format->BitsPerPixel,
  194. $surfs[1]->format->BitsPerPixel,
  195. 'Duplicate surf has same bpp'
  196. );
  197. if ($videodriver) {
  198. $ENV{SDL_VIDEODRIVER} = $videodriver;
  199. } else {
  200. delete $ENV{SDL_VIDEODRIVER};
  201. }
  202. pass 'Final SegFault test';
  203. done_testing;