/test/testmenu.pl

http://github.com/PerlGameDev/SDL · Perl · 82 lines · 59 code · 21 blank · 2 comment · 14 complexity · 3b3f9fb23c916a3beeebed56351c3d31 MD5 · raw file

  1. #!/usr/bin/env perl
  2. use strict;
  3. use warnings;
  4. use SDL ':init';
  5. use SDL::Video ':all';
  6. use SDL::Events ':all';
  7. use SDL::Rect;
  8. use SDL::Image;
  9. use SDL::Event;
  10. use SDL::Surface;
  11. SDL::init(SDL_INIT_VIDEO);
  12. my $menu = SDL::Image::load('data/menu.png');
  13. die " Image loading errors: " . SDL::get_error() if !$menu;
  14. my $screen = SDL::Video::set_video_mode( $menu->w, $menu->h, 32, SDL_SWSURFACE );
  15. my $hilight = SDL::Image::load('data/highlight.png');
  16. my %menu = (
  17. 'start' => [ 115, 30, 160, 40 ],
  18. 'help' => [ 120, 100, 120, 40 ],
  19. 'giveup' => [ 120, 230, 120, 40 ],
  20. 'spawnserver' => [ 115, 170, 165, 40 ],
  21. 'credits' => [ 115, 285, 160, 40 ],
  22. );
  23. my %item = (
  24. help => 'This should print a help message',
  25. credits => 'mantovani and kthakore',
  26. spawnserver => 'Spawinging new server...',
  27. start => 'This should start the game',
  28. giveup => 'Giving up',
  29. );
  30. die(SDL::get_error) unless $menu;
  31. my $quit = 0;
  32. my $event = SDL::Event->new();
  33. $event->type(SDL_ACTIVEEVENT);
  34. $event->active_gain(1);
  35. my $sel = 0;
  36. my @select = ( 'start', 'help', 'spawnserver', 'giveup', 'credits' );
  37. while ( !$quit ) {
  38. while ( SDL::Events::poll_event($event) ) {
  39. $quit = 1 if $event->type == SDL_QUIT;
  40. if ( $event->type == SDL_KEYDOWN ) {
  41. ### PROCESS EVENT HERE
  42. if ( $event->key_sym == SDLK_DOWN ) {
  43. $sel++ if $sel < $#select;
  44. } elsif ( $event->key_sym == SDLK_UP ) {
  45. $sel-- if $sel > 0;
  46. } elsif ( $event->key_sym == SDLK_RETURN ) {
  47. print $item{ $select[$sel] }, "\n";
  48. exit(0) if $select[$sel] eq 'giveup';
  49. }
  50. }
  51. }
  52. SDL::Video::blit_surface(
  53. $menu, SDL::Rect->new( 0, 0, $menu->w, $menu->h ),
  54. $screen, SDL::Rect->new( 0, 0, $screen->w, $screen->h )
  55. );
  56. SDL::Video::blit_surface(
  57. $hilight, SDL::Rect->new( @{ $menu{ $select[$sel] } } ),
  58. $screen, SDL::Rect->new( @{ $menu{ $select[$sel] } } )
  59. );
  60. SDL::Video::update_rect( $screen, 0, 0, $menu->w, $menu->h );
  61. }