Skip to content
Newer
Older
100644 216 lines (191 sloc) 5.21 KB
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
1 use strict;
2 use warnings;
3
4 use Data::Dumper;
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
5 use List::Util qw(shuffle);
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
6
7 use SDL;
8 use SDL::Event;
9 use SDL::Events;
10 use SDLx::App;
11 use SDLx::Text;
12 use SDLx::Rect;
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
13 use SDLx::Surface;
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
14
15 sub TO_SERVER { SDL_USEREVENT };
16 sub TO_CLIENT { SDL_USEREVENT + 1 };
17 # create our main screen
18 my $app = SDLx::App->new(
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
19 w => 400,
20 h => 512,
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
21 exit_on_quit => 1,
22 dt => 0.2,
23 title => 'SDLx Tetris'
24 );
25
26 # create our game objects
27 my $score = SDLx::Text->new( font => 'font.ttf', h_align => 'center' );
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
28 my $back = SDLx::Surface->load( 'data/tetris_back.png' );
29 my @piece = (undef);
30 push(@piece, SDLx::Surface->load( "data/tetris_$_.png" )) for(1..7);
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
31
32 my $client = {
33 grid => [],
34 };
35 my $server = {
36 grid => [],
37 grid2 => [],
38 };
39
40 my $tile;
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
41 my %pieces = (
42 I => [0,5,0,0,
43 0,5,0,0,
44 0,5,0,0,
45 0,5,0,0],
46 J => [0,0,0,0,
47 0,0,6,0,
48 0,0,6,0,
49 0,6,6,0,
50 0,0,0,0],
51 L => [0,0,0,0,
52 0,2,0,0,
53 0,2,0,0,
54 0,2,2,0,
55 0,0,0,0],
56 O => [0,0,0,0,
57 0,3,3,0,
58 0,3,3,0,
59 0,0,0,0],
60 S => [0,0,0,0,
61 0,4,4,0,
62 4,4,0,0,
63 0,0,0,0],
64 T => [0,0,0,0,
65 0,7,0,0,
66 7,7,7,0,
67 0,0,0,0],
68 Z => [0,0,0,0,
69 1,1,0,0,
70 0,1,1,0,
71 0,0,0,0],
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
72 );
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
73
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
74 sub check_collision {
75 my ($A, $B) = @_;
76
77 return if $A->bottom < $B->top;
78 return if $A->top > $B->bottom;
79 return if $A->right < $B->left;
80 return if $A->left > $B->right;
81
82 # if we got here, we have a collision!
83 return 1;
84 }
85
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
86 sub rotate {
87 my $_piece = shift;
88 my $_rotated = [];
89 my $_i = 0;
90 for(@{$_piece}) {
91 $_rotated->[$_i + (($_i%4+1)*3) - (5*int($_i/4))] = $_;
92 $_i++;
93 }
94 return $_rotated;
95 }
96
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
97 sub client_event_handler {
98 my ( $event, $app ) = @_;
99
100 if ( $event->type == SDL_KEYDOWN ) {
101 if ( $event->key_sym & (SDLK_LEFT|SDLK_RIGHT|SDLK_UP|SDLK_DOWN) ) {
102 my $new_event = SDL::Event->new();
103 $new_event->type(TO_SERVER);
104 $new_event->user_data1($event->key_sym);
105 SDL::Events::push_event($new_event);
106 }
107 elsif ( $event->key_sym == SDLK_SPACE ) {
108 my $x;
109 my $y;
110 for($y=0;$y<18;$y++) {
111 for($x=0;$x<10;$x++) {
112 print ($server->{grid}->[$x+$y*10] || '0');
113 }
114 print "\n";
115 }
116 print "\n";
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
117 ($tile->[0]) = shuffle(keys %pieces) if defined $tile;
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
118 }
119 }
120 elsif ( $event->type == SDL_KEYUP ) {
121 if ( $event->key_sym == SDLK_UP
122 or $event->key_sym == SDLK_DOWN )
123 {
124 #warn 'up/down released';
125 }
126 }
127 elsif ( $event->type == TO_CLIENT ) {
128 if($event->user_data1('grid')) {
129 $client->{grid} = $event->user_data2;
130 }
131 }
132 }
133
134 sub server_event_handler {
135 my ( $event, $app ) = @_;
136
137 if ( $event->type == TO_SERVER ) {
138 if(defined $tile) {
139 if($event->user_data1 == SDLK_LEFT && $tile->[1] > 0) {
140 $tile->[1]--;
141 }
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
142 elsif($event->user_data1 == SDLK_RIGHT && $tile->[1] + $pieces{$tile->[0]}->[0] < 10) {
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
143 $tile->[1]++;
144 }
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
145 elsif($event->user_data1 == SDLK_DOWN && $tile->[2] + $pieces{$tile->[0]}->[1] - 1 < 24) {
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
146 $tile->[2]++;
147 }
148 elsif($event->user_data1 == SDLK_UP) {
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
149 $pieces{$tile->[0]} = rotate($pieces{$tile->[0]});
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
150 }
151 }
152 my $new_event = SDL::Event->new();
153 $new_event->type(TO_CLIENT);
154 $new_event->user_data1('grid');
155 $new_event->user_data2($server->{grid});
156 SDL::Events::push_event($new_event);
157 }
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
158 $event = undef; # should we do this?
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
159 }
160
161 $app->add_event_handler( \&client_event_handler );
162 $app->add_event_handler( \&server_event_handler );
163
164 $app->add_move_handler( sub {
165 my ( $step, $app ) = @_;
166
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
167 unless(defined $tile) {
168 $tile = ['J', 4, 0];
169 ($tile->[0]) = shuffle(keys %pieces);
170 }
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
171
172 my $x = $tile->[1];
173 my $y = int($tile->[2]);
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
174 my $w = 4;
175 my $h = 4;
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
176
177 @{$server->{grid}} = @{$server->{grid2}};
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
178 for my $y (0..3) {
179 for my $x (0..3) {
180 if($pieces{$tile->[0]}->[$x + 4 * $y]) {
181 $server->{grid}->[ $x + $tile->[1] + 10 * ($y + int($tile->[2])) ] = $pieces{$tile->[0]}->[$x + 4 * $y];
182 }
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
183 }
184 }
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
185
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
186 $tile->[2] += $step * 0.5;
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
187 if($tile->[2] >= 24) {
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
188 @{$server->{grid2}} = @{$server->{grid}};
189 $tile = undef;
190 }
191 });
192
193 # renders game objects on the screen
194 $app->add_show_handler(
195 sub {
196 # first, we clear the screen
197 $app->draw_rect( [ 0, 0, $app->w, $app->h ], 0x000000 );
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
198 $back->blit( $app );
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
199
200 my $x = 0;
201 my $y = 0;
202 foreach(@{$client->{grid}}) {
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored Nov 10, 2010
203 #$app->draw_rect( [ 28 + $x%10 * 20, 28 + $y * 20, 19, 19 ], 0xFF0000 ) if $_;
204 $piece[$_]->blit( $app, undef, [ 28 + $x%10 * 20, 28 + $y * 20 ] ) if $_;
9c2b29d started on tetris
Tobias Leich authored Nov 9, 2010
205 $x++;
206 $y++ unless $x%10;
207 }
208 # finally, we update the screen
209 $app->update;
210 }
211 );
212
213 # all is set, run the app!
214 $app->run();
215
Something went wrong with that request. Please try again.