Skip to content

HTTPS clone URL

Subversion checkout URL

You can clone with
or
.
Download ZIP
Newer
Older
100644 243 lines (212 sloc) 6.704 kB
9c2b29d started on tetris
Tobias Leich authored
1 use strict;
2 use warnings;
3
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
4 use List::Util qw(shuffle min max);
9c2b29d started on tetris
Tobias Leich authored
5
6 use SDL;
7 use SDL::Event;
8 use SDL::Events;
9 use SDLx::App;
10 use SDLx::Text;
11 use SDLx::Rect;
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
12 use SDLx::Surface;
e5c81e3 code cleanup and a few comments
Tobias Leich authored
13
9c2b29d started on tetris
Tobias Leich authored
14 # create our main screen
15 my $app = SDLx::App->new(
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
16 w => 400,
17 h => 512,
9c2b29d started on tetris
Tobias Leich authored
18 exit_on_quit => 1,
19 dt => 0.2,
20 title => 'SDLx Tetris'
21 );
22
23 # create our game objects
8744f56 @kthakore Added get_next_piece sub and fixed font orientation for tetris code
kthakore authored
24 my $score_text = SDLx::Text->new( font => 'font.ttf', h_align => 'left', color => [255,255,255,255] );
e5c81e3 code cleanup and a few comments
Tobias Leich authored
25 my $score = 0;
26 my $back = SDLx::Surface->load( 'data/tetris_back.png' );
27 my @piece = (undef);
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
28 push(@piece, SDLx::Surface->load( "data/tetris_$_.png" )) for(1..7);
9c2b29d started on tetris
Tobias Leich authored
29
e5c81e3 code cleanup and a few comments
Tobias Leich authored
30 # to check for collisions we compare the position of the moving piece with the non-movin pieces
31 my $grid = []; # moving piece
32 my $store = []; # non-moving pieces
9c2b29d started on tetris
Tobias Leich authored
33
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
34 my %pieces = (
35 I => [0,5,0,0,
36 0,5,0,0,
37 0,5,0,0,
38 0,5,0,0],
39 J => [0,0,0,0,
40 0,0,6,0,
41 0,0,6,0,
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
42 0,6,6,0],
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
43 L => [0,0,0,0,
44 0,2,0,0,
45 0,2,0,0,
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
46 0,2,2,0],
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
47 O => [0,0,0,0,
48 0,3,3,0,
49 0,3,3,0,
50 0,0,0,0],
51 S => [0,0,0,0,
52 0,4,4,0,
53 4,4,0,0,
54 0,0,0,0],
55 T => [0,0,0,0,
56 0,7,0,0,
57 7,7,7,0,
58 0,0,0,0],
59 Z => [0,0,0,0,
60 1,1,0,0,
61 0,1,1,0,
62 0,0,0,0],
9c2b29d started on tetris
Tobias Leich authored
63 );
e5c81e3 code cleanup and a few comments
Tobias Leich authored
64
8744f56 @kthakore Added get_next_piece sub and fixed font orientation for tetris code
kthakore authored
65 my $next_tile = get_next_tile();
e5c81e3 code cleanup and a few comments
Tobias Leich authored
66 my $curr_tile = [undef, 4, 0];
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
67 @{$curr_tile->[0]} = @{$pieces{$next_tile}};
8744f56 @kthakore Added get_next_piece sub and fixed font orientation for tetris code
kthakore authored
68 $next_tile = get_next_tile();
69
70 sub get_next_tile { shuffle(keys %pieces) }
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
71
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
72 sub rotate_piece {
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
73 my $_piece = shift;
74 my $_rotated = [];
75 my $_i = 0;
76 for(@{$_piece}) {
77 $_rotated->[$_i + (($_i%4+1)*3) - (5*int($_i/4))] = $_;
78 $_i++;
79 }
80 return $_rotated;
81 }
82
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
83 sub can_move_piece {
84 my $direction = shift;
85 my $amount = shift || 1;
86
87 for my $y (0..3) {
88 for my $x (0..3) {
89 if($curr_tile->[0]->[$x + 4 * $y]) {
90 return if $direction eq 'left' && $x - $amount + $curr_tile->[1] < 0;
91 return if $direction eq 'right' && $x + $amount + $curr_tile->[1] > 9;
92 return if $direction eq 'down' && int($y + $amount + $curr_tile->[2]) > 22;
93
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
94 return if $direction eq 'right' && $store->[ $x + $amount + $curr_tile->[1] + 10 * int($y + $curr_tile->[2]) ];
95 return if $direction eq 'left' && $store->[ $x - $amount + $curr_tile->[1] + 10 * int($y + $curr_tile->[2]) ];
96 return if $direction eq 'down' && $store->[ $x + $curr_tile->[1] + 10 * int($y + $amount + $curr_tile->[2]) ];
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
97 }
98 }
99 }
100
101 return 1;
102 }
103
104 sub move_piece {
105 my $direction = shift;
106 my $amount = shift || 1;
107
108 if($direction eq 'right') {
109 $curr_tile->[1] += $amount;
110 }
111 elsif($direction eq 'left') {
112 $curr_tile->[1] -= $amount;
113 }
114 elsif($direction eq 'down') {
115 $curr_tile->[2] += $amount;
116 }
117
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
118 @{$grid} = ();
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
119 for my $y (0..3) {
120 for my $x (0..3) {
121 if($curr_tile->[0]->[$x + 4 * $y]) {
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
122 $grid->[ $x + $curr_tile->[1] + 10 * ($y + int($curr_tile->[2])) ] = $curr_tile->[0]->[$x + 4 * $y];
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
123 }
124 }
125 }
126 }
127
128 sub store_piece {
129 for my $y (0..3) {
130 for my $x (0..3) {
131 if($curr_tile->[0]->[$x + 4 * $y]) {
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
132 $store->[ $x + $curr_tile->[1] + 10 * ($y + int($curr_tile->[2])) ] = $curr_tile->[0]->[$x + 4 * $y];
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
133 }
134 }
135 }
136 }
137
d661a68 @kthakore Cleaned up Tetris from using user_event more
kthakore authored
138 sub trigger_move_event_handler {
9c2b29d started on tetris
Tobias Leich authored
139 my ( $event, $app ) = @_;
140
e5c81e3 code cleanup and a few comments
Tobias Leich authored
141 if( $event->type == SDL_KEYDOWN ) {
142 my $key = $event->key_sym;
143 if( $event->key_sym & (SDLK_LEFT|SDLK_RIGHT|SDLK_UP|SDLK_DOWN) ) {
d661a68 @kthakore Cleaned up Tetris from using user_event more
kthakore authored
144 if($key == SDLK_LEFT && can_move_piece('left')) {
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
145 move_piece('left');
9c2b29d started on tetris
Tobias Leich authored
146 }
d661a68 @kthakore Cleaned up Tetris from using user_event more
kthakore authored
147 elsif($key == SDLK_RIGHT && can_move_piece('right')) {
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
148 move_piece('right');
9c2b29d started on tetris
Tobias Leich authored
149 }
d661a68 @kthakore Cleaned up Tetris from using user_event more
kthakore authored
150 elsif($key == SDLK_DOWN && can_move_piece('down')) {
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
151 move_piece('down')
9c2b29d started on tetris
Tobias Leich authored
152 }
d661a68 @kthakore Cleaned up Tetris from using user_event more
kthakore authored
153 elsif($key == SDLK_UP) {
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
154 $curr_tile->[0] = rotate_piece($curr_tile->[0]);
9c2b29d started on tetris
Tobias Leich authored
155 }
156 }
157 }
158 }
159
d661a68 @kthakore Cleaned up Tetris from using user_event more
kthakore authored
160 $app->add_event_handler( \&trigger_move_event_handler );
9c2b29d started on tetris
Tobias Leich authored
161
162 $app->add_move_handler( sub {
163 my ( $step, $app ) = @_;
164
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
165 if(can_move_piece('down', $step / 2)) {
166 move_piece('down', $step / 2);
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
167 }
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
168 else {
169 store_piece($curr_tile); # placing the tile
170
171 # checking for lines to delete
172 my $y;
173 my @to_delete = ();
174 for($y = 22; $y >= 0; $y--) {
175 # there is no space if min of this row is true (greater than zero)
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
176 if(min(@{$store}[($y*10)..((($y+1)*10)-1)])) {
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
177 push(@to_delete, $y);
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
178 }
9c2b29d started on tetris
Tobias Leich authored
179 }
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
180
181 # deleting lines
182 foreach(@to_delete) {
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
183 splice(@{$store}, $_*10, 10);
e5c81e3 code cleanup and a few comments
Tobias Leich authored
184 $score++;
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
185 }
186
187 # adding blank rows to the top
188 foreach(@to_delete) {
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
189 splice(@{$store}, 0, 0, (0,0,0,0,0,0,0,0,0,0));
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
190 }
191
192 # launching new tile
193 @{$curr_tile->[0]} = @{$pieces{$next_tile}};
194 $curr_tile->[1] = 4;
195 $curr_tile->[2] = 0;
196 $next_tile = shuffle(keys %pieces);
9c2b29d started on tetris
Tobias Leich authored
197 }
198 });
199
200 # renders game objects on the screen
201 $app->add_show_handler(
202 sub {
203 # first, we clear the screen
204 $app->draw_rect( [ 0, 0, $app->w, $app->h ], 0x000000 );
e5c81e3 code cleanup and a few comments
Tobias Leich authored
205 # and draw the background image
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
206 $back->blit( $app );
9c2b29d started on tetris
Tobias Leich authored
207
208 my $x = 0;
209 my $y = 0;
e5c81e3 code cleanup and a few comments
Tobias Leich authored
210 # draw the not moving tiles
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
211 foreach(@{$store}) {
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
212 $piece[$_]->blit( $app, undef, [ 28 + $x%10 * 20, 28 + $y * 20 ] ) if $_;
213 $x++;
214 $y++ unless $x % 10;
215 }
216 $x = 0;
217 $y = 0;
e5c81e3 code cleanup and a few comments
Tobias Leich authored
218 # draw the moving tile
a4aa96c @kthakore Cleaned up tetris_pl from server client architecture. Need to clean u…
kthakore authored
219 foreach(@{$grid}) {
3bf506e added gfx for tetris, tile rotation works now
Tobias Leich authored
220 $piece[$_]->blit( $app, undef, [ 28 + $x%10 * 20, 28 + $y * 20 ] ) if $_;
9c2b29d started on tetris
Tobias Leich authored
221 $x++;
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
222 $y++ unless $x % 10;
223 }
e5c81e3 code cleanup and a few comments
Tobias Leich authored
224 # the next tile will be...
9234ab6 collisions done, lines get deleted, preview of next tile
Tobias Leich authored
225 my $next_tile_index = max(@{$pieces{$next_tile}});
226 for $y (0..3) {
227 for $x (0..3) {
228 if($pieces{$next_tile}->[$x + 4 * $y]) {
229 $piece[$next_tile_index]->blit( $app, undef, [ 264 + $x * 20, 48 + $y * 20 ] );
230 }
231 }
9c2b29d started on tetris
Tobias Leich authored
232 }
e647a53 @kthakore Added score text to tetris
kthakore authored
233
e5c81e3 code cleanup and a few comments
Tobias Leich authored
234 $score_text->write_xy( $app, 248, 20, "Next Piece" );
235 $score_text->write_xy( $app, 248, 240, "Score: $score" );
9c2b29d started on tetris
Tobias Leich authored
236 # finally, we update the screen
237 $app->update;
238 }
239 );
240
241 # all is set, run the app!
242 $app->run();
Something went wrong with that request. Please try again.