/t/sdlx_sprite.t

http://github.com/PerlGameDev/SDL · Raku · 75 lines · 54 code · 18 blank · 3 comment · 5 complexity · 1e8967d5b5d8cf127216ca6aa9dd16f5 MD5 · raw file

  1. use strict;
  2. use warnings;
  3. use Test::More;
  4. use SDL;
  5. use SDL::Config;
  6. use SDL::Video;
  7. use SDL::Color;
  8. use SDLx::Sprite;
  9. use lib 't/lib';
  10. use SDL::TestTool;
  11. my $videodriver = $ENV{SDL_VIDEODRIVER};
  12. $ENV{SDL_VIDEODRIVER} = 'dummy' unless $ENV{SDL_RELEASE_TESTING};
  13. if ( !SDL::TestTool->init(SDL_INIT_VIDEO) ) {
  14. plan( skip_all => 'Failed to init video' );
  15. } elsif ( !SDL::Config->has('SDL_image') ) {
  16. plan( skip_all => 'SDL_image support not compiled' );
  17. }
  18. can_ok(
  19. 'SDLx::Sprite', qw( new rect clip load surface x y
  20. w h draw alpha_key)
  21. );
  22. TODO: {
  23. local $TODO = 'methods not implemented yet';
  24. can_ok( 'SDLx::Sprite', qw( add remove zoom ) );
  25. }
  26. my $disp = SDL::Video::set_video_mode( 300, 300, 32, SDL_ANYFORMAT );
  27. my $sprite = SDLx::Sprite->new( width => 1, height => 1 );
  28. # test initial values
  29. #ok($sprite, 'object defined');
  30. isa_ok( $sprite, 'SDLx::Sprite' );
  31. my $rect = $sprite->rect;
  32. ok( $rect, 'rect defined upon raw initialization' );
  33. isa_ok( $rect, 'SDL::Rect', 'spawned rect isa SDL::Rect' );
  34. is( $rect->x, 0, 'rect->x init' );
  35. is( $rect->y, 0, 'rect->y init' );
  36. is( $rect->w, 1, 'rect->w init' );
  37. is( $rect->h, 1, 'rect->h init' );
  38. my ( $x, $y ) = ( $sprite->x, $sprite->y );
  39. is( $x, 0, 'no x defined upon raw initialization' );
  40. is( $y, 0, 'no y defined upon raw initialization' );
  41. my ( $w, $h ) = ( $sprite->w, $sprite->h );
  42. is( $w, 1, 'w defined upon raw initialization' );
  43. is( $h, 1, 'h defined upon raw initialization' );
  44. isa_ok( $sprite->load('test/data/hero.bmp'), 'SDLx::Sprite', '[load] works' );
  45. isa_ok(
  46. $sprite->alpha_key( SDL::Color->new( 0xfc, 0x00, 0xff ) ),
  47. 'SDLx::Sprite', '[alpha] works'
  48. );
  49. isa_ok( $sprite->alpha(0xcc), 'SDLx::Sprite', '[alpha] integer works ' );
  50. isa_ok( $sprite->alpha(0.3), 'SDLx::Sprite', '[alpha] percentage works' );
  51. done_testing;
  52. #reset the old video driver
  53. if ($videodriver) {
  54. $ENV{SDL_VIDEODRIVER} = $videodriver;
  55. } else {
  56. delete $ENV{SDL_VIDEODRIVER};
  57. }