/t/sdlx_sprite_animated.t

http://github.com/PerlGameDev/SDL · Raku · 452 lines · 360 code · 91 blank · 1 comment · 6 complexity · 864c40dc3ec7ce0fc511b3f1299d3b51 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::Animated;
  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::Animated',
  20. qw( new rect clip load surface x y w h draw alpha_key
  21. step_x step_y type max_loops ticks_per_frame current_frame current_loop
  22. set_sequences sequence next previous reset start stop draw)
  23. );
  24. TODO: {
  25. local $TODO = 'methods not implemented yet';
  26. can_ok( 'SDLx::Sprite', qw( add remove zoom ) );
  27. }
  28. my $disp = SDL::Video::set_video_mode( 300, 300, 32, SDL_ANYFORMAT );
  29. my $sprite = SDLx::Sprite::Animated->new(
  30. width => 48,
  31. height => 48
  32. );
  33. isa_ok( $sprite, 'SDLx::Sprite' );
  34. isa_ok( $sprite, 'SDLx::Sprite::Animated' );
  35. my $clip = $sprite->clip;
  36. ok( $clip, 'clip defined upon raw initialization' );
  37. isa_ok( $clip, 'SDL::Rect', 'spawned clip isa SDL::Rect' );
  38. is( $clip->x, 0, 'clip->x init' );
  39. is( $clip->y, 0, 'clip->y init' );
  40. is( $clip->w, 48, 'clip->w init' );
  41. is( $clip->h, 48, 'clip->h init' );
  42. my $rect = $sprite->rect;
  43. ok( $rect, 'rect defined upon raw initialization' );
  44. isa_ok( $rect, 'SDL::Rect', 'spawned rect isa SDL::Rect' );
  45. is( $rect->x, 0, 'rect->x init' );
  46. is( $rect->y, 0, 'rect->y init' );
  47. is( $rect->w, 48, 'rect->w init' );
  48. is( $rect->h, 48, 'rect->h init' );
  49. my ( $x, $y ) = ( $sprite->x, $sprite->y );
  50. is( $x, 0, 'no x defined upon raw initialization' );
  51. is( $y, 0, 'no y defined upon raw initialization' );
  52. my ( $w, $h ) = ( $sprite->w, $sprite->h );
  53. is( $w, 48, 'w defined upon raw initialization' );
  54. is( $h, 48, 'h defined upon raw initialization' );
  55. isa_ok(
  56. $sprite->load('test/data/hero.bmp'),
  57. 'SDLx::Sprite::Animated', '[load] works'
  58. );
  59. isa_ok(
  60. $sprite->alpha_key( SDL::Color->new( 0xfc, 0x00, 0xff ) ),
  61. 'SDLx::Sprite::Animated', '[alpha_key] works'
  62. );
  63. isa_ok(
  64. $sprite->alpha(0xcc), 'SDLx::Sprite::Animated',
  65. '[alpha] integer works '
  66. );
  67. isa_ok(
  68. $sprite->alpha(0.3), 'SDLx::Sprite::Animated',
  69. '[alpha] percentage works'
  70. );
  71. is( $clip->x, 0, 'clip->x after load' );
  72. is( $clip->y, 0, 'clip->y after load' );
  73. is( $clip->w, 48, 'clip->w after load' );
  74. is( $clip->h, 48, 'clip->h after load' );
  75. is( $rect->x, 0, 'rect->x after load' );
  76. is( $rect->y, 0, 'rect->y after load' );
  77. is( $rect->w, 48, 'rect->w after load' );
  78. is( $rect->h, 48, 'rect->h after load' );
  79. $sprite->set_sequences( left => [ [ 1, 0 ], [ 1, 1 ], [ 1, 2 ] ], );
  80. my ( $clip_w, $clip_h ) = ( $sprite->clip->w, $sprite->clip->h );
  81. $sprite->alpha_key( SDL::Color->new( 0xfc, 0x00, 0xff ) );
  82. is( $sprite->clip->w, $clip_w, 'alpha_key() does not change clip width' );
  83. is( $sprite->clip->h, $clip_h, 'alpha_key() does not change clip height' );
  84. $sprite->sequence('left');
  85. is( $sprite->current_frame, 1, 'sprite->current_frame after sequence' );
  86. is( $sprite->current_loop, 1, 'sprite->current_loop after sequence' );
  87. is( $clip->x, 48, 'clip->x after sequence' );
  88. is( $clip->y, 0, 'clip->y after sequence' );
  89. is( $clip->w, 48, 'clip->w after sequence' );
  90. is( $clip->h, 48, 'clip->h after sequence' );
  91. is( $rect->x, 0, 'rect->x after sequence' );
  92. is( $rect->y, 0, 'rect->y after sequence' );
  93. is( $rect->w, 48, 'rect->w after sequence' );
  94. is( $rect->h, 48, 'rect->h after sequence' );
  95. $sprite->next;
  96. is( $sprite->current_frame, 2, 'sprite->current_frame after next' );
  97. is( $sprite->current_loop, 1, 'sprite->current_loop after next' );
  98. is( $clip->x, 48, 'clip->x after next' );
  99. is( $clip->y, 48, 'clip->y after next' );
  100. is( $clip->w, 48, 'clip->w after next' );
  101. is( $clip->h, 48, 'clip->h after next' );
  102. is( $rect->x, 0, 'rect->x after next' );
  103. is( $rect->y, 0, 'rect->y after next' );
  104. is( $rect->w, 48, 'rect->w after next' );
  105. is( $rect->h, 48, 'rect->h after next' );
  106. $sprite->next;
  107. is( $sprite->current_frame, 3, 'sprite->current_frame after second next' );
  108. is( $sprite->current_loop, 1, 'sprite->current_loop after second next' );
  109. is( $clip->x, 48, 'clip->x after second next' );
  110. is( $clip->y, 96, 'clip->y after second next' );
  111. is( $clip->w, 48, 'clip->w after second next' );
  112. is( $clip->h, 48, 'clip->h after second next' );
  113. is( $rect->x, 0, 'rect->x after second next' );
  114. is( $rect->y, 0, 'rect->y after second next' );
  115. is( $rect->w, 48, 'rect->w after second next' );
  116. is( $rect->h, 48, 'rect->h after second next' );
  117. $sprite->next;
  118. is( $sprite->current_frame, 1, 'sprite->current_frame after third next' );
  119. is( $sprite->current_loop, 2, 'sprite->current_loop after second next' );
  120. is( $clip->x, 48, 'clip->x after third next' );
  121. is( $clip->y, 0, 'clip->y after third next' );
  122. is( $clip->w, 48, 'clip->w after third next' );
  123. is( $clip->h, 48, 'clip->h after third next' );
  124. is( $rect->x, 0, 'rect->x after third next' );
  125. is( $rect->y, 0, 'rect->y after third next' );
  126. is( $rect->w, 48, 'rect->w after third next' );
  127. is( $rect->h, 48, 'rect->h after third next' );
  128. is( $sprite->next, $sprite, 'next() returns the object' );
  129. is( $sprite->current_frame, 2, 'sprite->current_frame after next' );
  130. is( $sprite->previous, $sprite, 'previous() returns the object' );
  131. is( $sprite->current_frame, 1, 'sprite->current_frame after previous' );
  132. $sprite->next;
  133. is( $sprite->current_frame, 2, 'sprite->current_frame before reset' );
  134. is( $clip->x, 48, 'clip->x before reset' );
  135. is( $clip->y, 48, 'clip->y before reset' );
  136. is( $clip->w, 48, 'clip->w before reset' );
  137. is( $clip->h, 48, 'clip->h before reset' );
  138. is( $sprite->reset, $sprite, 'reset() returns the object' );
  139. is( $sprite->current_frame, 1, 'sprite->current_frame after reset' );
  140. is( $clip->x, 48, 'clip->x after reset' );
  141. is( $clip->y, 0, 'clip->y after reset' );
  142. is( $clip->w, 48, 'clip->w after reset' );
  143. is( $clip->h, 48, 'clip->h after reset' );
  144. $sprite = SDLx::Sprite::Animated->new(
  145. image => 'test/data/hero.bmp',
  146. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  147. );
  148. $clip = $sprite->clip;
  149. is( $clip->x, 0, 'clip->x after new with image and rect' );
  150. is( $clip->y, 0, 'clip->y after new with image and rect' );
  151. is( $clip->w, 48, 'clip->w after new with image and rect' );
  152. is( $clip->h, 48, 'clip->h after new with image and rect' );
  153. $rect = $sprite->rect;
  154. is( $rect->x, 40, 'rect->x after new with image and rect' );
  155. is( $rect->y, 50, 'rect->y after new with image and rect' );
  156. is( $rect->w, 48, 'rect->w after new with image and rect' );
  157. is( $rect->h, 48, 'rect->h after new with image and rect' );
  158. $sprite = SDLx::Sprite::Animated->new(
  159. image => 'test/data/hero.bmp',
  160. clip => SDL::Rect->new( 0, 0, 48, 48 ),
  161. );
  162. $clip = $sprite->clip;
  163. is( $clip->x, 0, 'clip->x after new with image and clip' );
  164. is( $clip->y, 0, 'clip->y after new with image and clip' );
  165. is( $clip->w, 48, 'clip->w after new with image and clip' );
  166. is( $clip->h, 48, 'clip->h after new with image and clip' );
  167. $rect = $sprite->rect;
  168. is( $rect->x, 0, 'rect->x after new with image and clip' );
  169. is( $rect->y, 0, 'rect->y after new with image and clip' );
  170. is( $rect->w, 48, 'rect->w after new with image and clip' );
  171. is( $rect->h, 48, 'rect->h after new with image and clip' );
  172. $sprite = SDLx::Sprite::Animated->new(
  173. image => 'test/data/hero.bmp',
  174. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  175. step_x => 50,
  176. step_y => 50,
  177. );
  178. $sprite->set_sequences(
  179. left => [ [ 1, 0 ], [ 1, 1 ], ],
  180. right => [ [ 3, 0 ], [ 3, 1 ], ],
  181. );
  182. $sprite->sequence('left');
  183. $clip = $sprite->clip;
  184. is( $clip->x, 50, 'clip->x after new with step_x, step_y' );
  185. is( $clip->y, 0, 'clip->y after new with step_x, step_y' );
  186. is( $clip->w, 48, 'clip->w after new with step_x, step_y' );
  187. is( $clip->h, 48, 'clip->h after new with step_x, step_y' );
  188. $sprite->next;
  189. $clip = $sprite->clip;
  190. is( $clip->x, 50, 'clip->x after first next' );
  191. is( $clip->y, 50, 'clip->y after first next' );
  192. is( $clip->w, 48, 'clip->w after first next' );
  193. is( $clip->h, 48, 'clip->h after first next' );
  194. $sprite->next;
  195. $clip = $sprite->clip;
  196. is( $clip->x, 50, 'clip->x after second next' );
  197. is( $clip->y, 0, 'clip->y after second next' );
  198. is( $clip->w, 48, 'clip->w after second next' );
  199. is( $clip->h, 48, 'clip->h after second next' );
  200. $sprite->sequence('right');
  201. $clip = $sprite->clip;
  202. is( $clip->x, 150, 'clip->x after sequence change' );
  203. is( $clip->y, 0, 'clip->y after sequence change' );
  204. is( $clip->w, 48, 'clip->w after sequece change' );
  205. is( $clip->h, 48, 'clip->h after sequence change' );
  206. $sprite->next;
  207. $clip = $sprite->clip;
  208. is( $clip->x, 150, 'clip->x after first next' );
  209. is( $clip->y, 50, 'clip->y after first next' );
  210. is( $clip->w, 48, 'clip->w after first next' );
  211. is( $clip->h, 48, 'clip->h after first next' );
  212. $sprite->next;
  213. $clip = $sprite->clip;
  214. is( $clip->x, 150, 'clip->x after second next' );
  215. is( $clip->y, 0, 'clip->y after second next' );
  216. is( $clip->w, 48, 'clip->w after second next' );
  217. is( $clip->h, 48, 'clip->h after second next' );
  218. $sprite = SDLx::Sprite::Animated->new(
  219. image => 'test/data/hero.bmp',
  220. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  221. max_loops => 2,
  222. );
  223. $sprite->set_sequences( up => [ [ 0, 0 ], [ 0, 1 ], ], );
  224. $sprite->sequence('up');
  225. $clip = $sprite->clip;
  226. is( $clip->y, 0, 'clip->y after new with max_loops' );
  227. $sprite->next;
  228. is( $clip->y, 48, 'clip->y after first next' );
  229. $sprite->next;
  230. is( $clip->y, 0, 'clip->y after second next' );
  231. $sprite->next;
  232. is( $clip->y, 48, 'clip->y after third next' );
  233. $sprite->next;
  234. is( $clip->y, 0, 'clip->y after fourth next' );
  235. $sprite->next;
  236. is( $clip->y, 0, 'clip->y after fifth next' );
  237. $sprite = SDLx::Sprite::Animated->new(
  238. image => 'test/data/hero.bmp',
  239. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  240. type => 'reverse'
  241. );
  242. $sprite->set_sequences( up => [ [ 0, 0 ], [ 0, 1 ], [ 0, 2 ], ], );
  243. $sprite->sequence('up');
  244. $clip = $sprite->clip;
  245. is( $clip->y, 0, 'clip->y after new with type = reverse' );
  246. is( $sprite->current_loop, 1,
  247. 'sprite->current_loop after new with type = reverse'
  248. );
  249. $sprite->next;
  250. is( $clip->y, 48, 'clip->y after first next' );
  251. is( $sprite->current_frame, 2, 'sprite->current_frame after first next' );
  252. is( $sprite->current_loop, 1, 'sprite->current_loop after first next' );
  253. $sprite->next;
  254. is( $clip->y, 96, 'clip->y after second next' );
  255. is( $sprite->current_frame, 3, 'sprite->current_frame after second next' );
  256. is( $sprite->current_loop, 1, 'sprite->current_loop after second next' );
  257. $sprite->next;
  258. is( $clip->y, 48, 'clip->y after third next' );
  259. is( $sprite->current_frame, 2, 'sprite->current_frame after third next' );
  260. is( $sprite->current_loop, 1, 'sprite->current_loop after third next' );
  261. $sprite->next;
  262. is( $clip->y, 0, 'clip->y after fourth next' );
  263. is( $sprite->current_frame, 1, 'sprite->current_frame after fourth next' );
  264. is( $sprite->current_loop, 2, 'sprite->current_loop after fourth next' );
  265. $sprite->next;
  266. is( $clip->y, 48, 'clip->y after fifth next' );
  267. is( $sprite->current_frame, 2, 'sprite->current_frame after fifth next' );
  268. is( $sprite->current_loop, 2, 'sprite->current_loop after fifth next' );
  269. $sprite->next;
  270. is( $clip->y, 96, 'clip->y after sixth next' );
  271. is( $sprite->current_frame, 3, 'sprite->current_frame after sixth next' );
  272. is( $sprite->current_loop, 2, 'sprite->current_loop after sixth next' );
  273. $sprite->next;
  274. is( $clip->y, 48, 'clip->y after seventh next' );
  275. is( $sprite->current_frame, 2, 'sprite->current_frame after seventh next' );
  276. is( $sprite->current_loop, 2, 'sprite->current_loop after seventh next' );
  277. $sprite = SDLx::Sprite::Animated->new(
  278. image => 'test/data/hero.bmp',
  279. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  280. );
  281. $sprite->set_sequences( up => [ [ 0, 0 ], [ 0, 1 ], ], );
  282. $sprite->sequence('up');
  283. $clip = $sprite->clip;
  284. is( $clip->y, 0, 'clip->y after new' );
  285. $sprite->previous;
  286. is( $clip->y, 48, 'clip->y after first previous' );
  287. $sprite->previous;
  288. is( $clip->y, 0, 'clip->y after second previous' );
  289. $sprite->previous;
  290. is( $clip->y, 48, 'clip->y after third previous' );
  291. $sprite = SDLx::Sprite::Animated->new(
  292. image => 'test/data/hero.bmp',
  293. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  294. type => 'reverse'
  295. );
  296. $sprite->set_sequences( up => [ [ 0, 0 ], [ 0, 1 ], [ 0, 2 ], ], );
  297. $sprite->sequence('up');
  298. $clip = $sprite->clip;
  299. is( $clip->y, 0, 'clip->y after new with type = reverse' );
  300. $sprite->previous;
  301. is( $clip->y, 96, 'clip->y after first previous' );
  302. is( $sprite->current_frame, 3, 'sprite->current_frame after first previous' );
  303. $sprite->previous;
  304. is( $clip->y, 48, 'clip->y after second previous' );
  305. is( $sprite->current_frame, 2, 'sprite->current_frame after second previous' );
  306. $sprite->previous;
  307. is( $clip->y, 0, 'clip->y after third previous' );
  308. is( $sprite->current_frame, 1, 'sprite->current_frame after third previous' );
  309. $sprite->previous;
  310. is( $clip->y, 48, 'clip->y after fourth previous' );
  311. is( $sprite->current_frame, 2, 'sprite->current_frame after fourth previous' );
  312. $sprite->previous;
  313. is( $clip->y, 96, 'clip->y after fifth previous' );
  314. is( $sprite->current_frame, 3, 'sprite->current_frame after fifth previous' );
  315. $sprite->previous;
  316. is( $clip->y, 48, 'clip->y after sixth previous' );
  317. is( $sprite->current_frame, 2, 'sprite->current_frame after sixth previous' );
  318. $sprite->previous;
  319. is( $clip->y, 0, 'clip->y after seventh previous' );
  320. is( $sprite->current_frame, 1, 'sprite->current_frame after seventh previous' );
  321. $sprite = SDLx::Sprite::Animated->new(
  322. image => 'test/data/hero.bmp',
  323. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  324. clip => SDL::Rect->new( 48, 48, 48, 48 ),
  325. sequences => { up => [ [ 0, 0 ], [ 0, 1 ] ] },
  326. sequence => 'up',
  327. );
  328. $clip = $sprite->clip;
  329. is( $clip->x, 48, 'clip->x after new with clip' );
  330. is( $clip->y, 48, 'clip->y after new with clip' );
  331. $sprite->next();
  332. is( $clip->x, 48, 'clip->x after first next' );
  333. is( $clip->y, 96, 'clip->y after first next' );
  334. $sprite->next();
  335. is( $clip->x, 48, 'clip->x after second next' );
  336. is( $clip->y, 48, 'clip->y after second next' );
  337. $sprite = SDLx::Sprite::Animated->new(
  338. image => 'test/data/hero.bmp',
  339. rect => SDL::Rect->new( 40, 50, 48, 48 ),
  340. );
  341. $clip = $sprite->clip;
  342. is( $clip->x, 0, 'clip->x after new with no sequences' );
  343. is( $clip->y, 0, 'clip->y after new with no sequences' );
  344. my $sequences = [
  345. [ 0, 0 ], [ 48, 0 ], [ 96, 0 ], [ 144, 0 ], [ 192, 0 ],
  346. [ 0, 48 ], [ 48, 48 ], [ 96, 48 ], [ 144, 48 ], [ 192, 48 ],
  347. [ 0, 96 ], [ 48, 96 ], [ 96, 96 ], [ 144, 96 ], [ 192, 96 ],
  348. ];
  349. foreach my $count ( 1 .. 20 ) {
  350. $sprite->next;
  351. my $s = $sequences->[ $count % @$sequences ];
  352. is( $clip->x, $s->[0], 'clip->x after ' . $count . '-th next' );
  353. is( $clip->y, $s->[1], 'clip->y after ' . $count . '-th next' );
  354. }
  355. done_testing;
  356. #reset the old video driver
  357. if ($videodriver) {
  358. $ENV{SDL_VIDEODRIVER} = $videodriver;
  359. } else {
  360. delete $ENV{SDL_VIDEODRIVER};
  361. }