PageRenderTime 58ms CodeModel.GetById 18ms app.highlight 36ms RepoModel.GetById 2ms app.codeStats 0ms

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