Joguinho Tetris
Publicado por Kelyane (última atualização em 30/09/2009)
[ Hits: 21.089 ]
Homepage: http://blog.kelyane.com
Joguinho de Tetris colorido.
Código-fonte tirado dos exemplos do programa PascalZim -http://www.ziggi.com.br/downloads/pascal-zim
Program tetris;
Const
HEIGHT = 20; // Altura do grid (área interna, sem contar as bordas)
HeightPlusOne = 21; // Altura do grid + 1
WIDTH = 11; // Largura do grid (área interna, sem contar as bordas)
WidthPlusOne = 12; // Largura do grid + 1
LEFT = -1; // Identificação dos movimentos horizontais
RIGHT = 1; // (utilizado na chamada ao procedure move)
Type
T_coordinate = record // Coordenada cartesiana (x,y)
x : integer;
y : integer;
end;
T_objgrid = array[1..4, 1..4] of boolean; // Forma de peças. Constituida por uma array bidimensional
// de 4x4 do tipo boolean. Por exemplo, a forma da peça "L"
// é representada da seguinte maneira: 0 0 1 0
// 1 1 1 0
// (0 = FALSE, 1 = TRUE) 0 0 0 0
// 0 0 0 0
T_grid = record // Informações sobre um ponto do grid, se ele está
status : boolean; // preenchido ou não (status) e de que cor ele está
color : integer; // preenchido, se for o caso.
end;
T_object = record // Peças.
pos : T_coordinate; // posição
cell : T_objgrid; // formato
size : integer; // tamanho (ver comentário abaixo)
color : integer; // cor
end;
{ Quanto ao tamanho das peças, existem peças de 4x4 (size=4) e de 3x3 (size=3). No
caso das de 4x4, o eixo de rotação é bem no meio da array. Exemplo (retângulo):
| | | | |
0 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 0 0 0 0 -> 0 1 0 0
_ 0 1 0 0 _ -> _ 1 1 1 1 _ -> _ 0 0 1 0 _ -> _ 0 0 0 0 _ -> _ 0 1 0 0 _
0 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 1 1 1 1 -> 0 1 0 0
0 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 0 0 0 0 -> 0 1 0 0
| | | | |
Já nas peças de 3x3, o eixo de rotação é na célula (2,2). Exemplo ("L"):
| | | | |
0 0 0 0 -> 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 0
- 0 0 1 0 - -> - 1 0 0 0 - -> - 1 0 0 0 - -> - 0 0 1 0 - -> - 0 0 1 0 -
1 1 1 0 -> 1 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 1 1 1 0
0 0 0 0 -> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
| | | | |
Repare que a estrutura utilizada para representar as formas de 4x4 e de 3x3 é a
mesma, uma array bidimensional de 4x4. Contudo, nas peças de 3x3, existem 7
células (as da última coluna e as da úllima linha) que são inutilizadas. }
Var
grid : array[0..WidthPlusOne, 0..HeightPlusOne] of T_grid; // Grid (incluindo bordas)
obj : T_object; // Peça caindo no grid
next : T_object; // Próxima peça (fixa)
level : integer; // Nível em que se encontra o jogador
score : integer; // Pontuação
cycle : record
freq : integer; // Intervalo entre decaimentos da peça.
status : integer; // Tempo decorrido desde último decaimento.
step : integer; // Tempo entre ciclos de execução. É a cada ciclo o programa
// checa se o usuário pressionou alguma tecla.
end; // (medidas em milisegundos)
orig : T_coordinate; // Origem - posição do canto superior esquerdo do grid na tela.
gameover : boolean; // O jogo acabou?
quit : boolean; // O usuário deseja sair do jogo?
i, j : integer; // Contadores
c : char; // Variavel auxiliar (recebe input)
{ ------------------------------------------------------------------
Procedure Xclrscr: Fornecidos 4 pontos x1, y1, x2, y2, limpa uma
área na tela equivalente ao retângulo de vértices superior
direito = (x1, y1) e inferior esquerdo = (x2, y2).
Equivale a: window( x1, y1, x2, y2 );
clrscr;
------------------------------------------------------------------ }
Procedure Xclrscr( x1, y1, x2, y2 : integer );
Var x, y : integer;
Begin
for y := y1 to y2 do
begin
gotoxy(x1, y);
for x := x1 to x2 do
write(' ');
end;
End;
{ ------------------------------------------------------------------
Function shock: Verifica se a peça está livre para mover-se
horizontalmente xmov unidades e verticalmente ymov unidades.
------------------------------------------------------------------ }
Function shock( xmov, ymov : integer ): boolean;
Var i, j : integer;
return : boolean;
Begin
gotoxy(1,1);
return := FALSE;
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j])
and (obj.pos.x + i + xmov >= 0)
and (obj.pos.x + i + xmov <= WIDTH+1)
and (grid[obj.pos.x+i+xmov, obj.pos.y+j+ymov].status) // esta condição precisa aparecer por último!
then return := TRUE;
shock := return;
End;
{ ------------------------------------------------------------------
Procedure rotate: Roda a peça no sentido horário, se possível.
------------------------------------------------------------------ }
Procedure rotate;
Var i, j : integer;
old : T_objgrid;
Begin
for i := 1 to 4 do
for j := 1 to 4 do
old[i,j] := obj.cell[i,j];
for i := 1 to obj.size do
for j := 1 to obj.size do
obj.cell[i,j] := old[j,obj.size+1-i];
if (shock(0,0)) then
for i := 1 to 4 do
for j := 1 to 4 do
obj.cell[i,j] := old[i,j];
End;
{ ------------------------------------------------------------------
Procedure move: Move a peça para a direita ou para a esquerda,
se possível.
------------------------------------------------------------------ }
Procedure move( xmov : integer );
Begin
if (not shock(xmov, 0))
then obj.pos.x := obj.pos.x + xmov;
End;
{ ------------------------------------------------------------------
Procedure consolidate: Prende a peça ao local onde ela se
encontra. Após isso, a peça perde seu status de peça e passa a
ser apenas parte do grid. Este procedimento é chamado quando a
peça chega ao fundo do grid, ou encontra com outra abaixo dela.
------------------------------------------------------------------ }
Procedure consolidate;
Var i, j : integer;
Begin
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j]) then
begin
grid[obj.pos.x+i, obj.pos.y+j].status := TRUE;
grid[obj.pos.x+i, obj.pos.y+j].color := obj.color;
end;
End;
{ ------------------------------------------------------------------
Procedure checklines: Checa se alguma linha do grid foi
completada. Se sim, apaga o conteudo dela, trazendo todas as
linhas acima para baixo (as linhas que estão acima da que foi
completada 'caem'). Também recalcula o score, o level e o
cycle.freq.
------------------------------------------------------------------ }
Procedure checklines;
Var i, j, down : integer;
LineCleared : boolean;
Begin
down := 0;
for j := HEIGHT downto 1 do
begin
LineCleared := TRUE;
for i := 1 to WIDTH do
if not (grid[i,j].status)
then LineCleared := FALSE;
if (LineCleared)
then
begin
down := down + 1;
score := score + 10;
end
else
for i := 1 to WIDTH do
begin
grid[i,j+down].status := grid[i,j].status;
grid[i,j+down].color := grid[i,j].color;
end;
end;
level := score div 200;
cycle.freq := trunc( 500 * exp(level*ln(0.85)) );
textcolor(YELLOW);
gotoxy( orig.x + (WIDTH+2)*2 + 18, orig.y + 15 );
write(level);
gotoxy( orig.x + (WIDTH+2)*2 + 30, orig.y + 15 );
write(score);
End;
{ ------------------------------------------------------------------
Procedure hideobj: esconde a peça da tela.
------------------------------------------------------------------ }
Procedure hideobj( obj : T_object );
Var i, j : integer;
Begin
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j]) then
begin
gotoxy( orig.x + (obj.pos.x + i) * 2, orig.y + obj.pos.y+j );
write(' ');
end;
gotoxy( orig.x, orig.y );
End;
{ ------------------------------------------------------------------
Procedure drawobj: desenha a peça na tela.
------------------------------------------------------------------ }
Procedure drawobj( obj : T_object );
Var i, j : integer;
Begin
textcolor(obj.color);
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j]) then
begin
gotoxy( orig.x + (obj.pos.x + i) * 2, orig.y + obj.pos.y + j );
write(#219, #219);
end;
gotoxy( orig.x, orig.y );
End;
{ ------------------------------------------------------------------
Procedure refresh: redesenha todo o grid na tela.
------------------------------------------------------------------ }
Procedure refresh;
Var i, j : integer;
Begin
for i := 0 to WIDTH+1 do
for j := 0 to HEIGHT+1 do
begin
gotoxy( orig.x + 2*i, orig.y + j );
if (grid[i,j].status)
then
begin
textcolor(grid[i,j].color);
write(#219, #219);
end
else
write(' ');
end;
gotoxy( orig.x, orig.y );
End;
{ ------------------------------------------------------------------
Procedure createtgt: pega a peça já gerada anteriormente que está
na caixa "next" (variável next) e a transforma na peça atual.
Depois, gera nova peça randomicamente, posicionando-a na caixa
"next".
------------------------------------------------------------------ }
Procedure createtgt;
Var i, j : integer;
Begin
hideobj(next);
obj := next;
obj.pos.x := WIDTH div 2 - 2;
obj.pos.y := 0;
next.pos.x := WIDTH + 4;
next.pos.y := 6;
for i := 1 to 4 do
for j := 1 to 4 do
next.cell[i,j] := FALSE;
case random(7) of
0: begin // Quadrado
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,2] := TRUE;
next.cell[3,3] := TRUE;
next.size := 4;
next.color := WHITE;
end;
1: begin // Retangulo
next.cell[2,1] := TRUE;
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[2,4] := TRUE;
next.size := 4;
next.color := LIGHTRED;
end;
2: begin // "L"
next.cell[3,2] := TRUE;
next.cell[1,3] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,3] := TRUE;
next.size := 3;
next.color := LIGHTGREEN;
end;
3: begin // "L" invertido
next.cell[1,2] := TRUE;
next.cell[1,3] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,3] := TRUE;
next.size := 3;
next.color := LIGHTBLUE;
end;
4: begin // "S"
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,1] := TRUE;
next.cell[3,2] := TRUE;
next.size := 4;
next.color := LIGHTCYAN;
end;
5: begin // "Z"
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,3] := TRUE;
next.cell[3,4] := TRUE;
next.size := 4;
next.color := LIGHTMAGENTA;
end;
6: begin // "T"
next.cell[1,2] := TRUE;
next.cell[2,1] := TRUE;
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.size := 3;
next.color := LIGHTGRAY;
end;
end;
drawobj(next);
End;
{ ------------------------------------------------------------------
Procedure prninfo: imprime as informações presentes ao lado
do grid (contorno da caixa "next" e comandos do jogo).
------------------------------------------------------------------ }
Procedure prninfo( xpos, ypos : integer );
Begin
// window( xpos, ypos, 80, 40 );
Xclrscr( xpos, ypos, 80, 24 );
textcolor(WHITE);
gotoxy( xpos, ypos+0 );
write(#218, #196, #196, ' Next ', #196, #196, #191);
gotoxy( xpos, ypos+1 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+2 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+3 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+4 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+5 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+6 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+7 );
write(#192, #196, #196, #196, #196, #196, #196, #196, #196, #196, #196, #217);
textcolor(YELLOW);
gotoxy( xpos, ypos+10 );
write(' Level: 0 Score: 0');
// window( xpos+17, ypos+1, 80, 40 );
gotoxy( xpos+17, ypos+1 );
write('Controles:');
gotoxy( xpos+17, ypos+2 );
write(' Mover : [setas]');
gotoxy( xpos+17, ypos+3 );
write(' Girar : [space]');
gotoxy( xpos+17, ypos+4 );
write(' Cair : [enter]');
gotoxy( xpos+17, ypos+5 );
write(' Pausa : "P"');
gotoxy( xpos+17, ypos+6 );
write(' Sair : [esc]');
// window(1,1,80,40);
End;
{ ------------------------------------------------------------------
Procedure prnGameover: imprime mensagem de "game over" ao lado
do grid.
------------------------------------------------------------------ }
Procedure prnGameover( xpos, ypos : integer );
Begin
// window( xpos, ypos, 80, 40 );
Xclrscr( xpos, ypos, 80, 24 );
textcolor(WHITE);
gotoxy( xpos, ypos+2 );
writeln(' * * * FIM DE JOGO * * *');
gotoxy( xpos, ypos+6 );
write('Deseja iniciar um ');
textcolor(LIGHTRED);
write('N');
textcolor(WHITE);
write('ovo jogo ou ');
textcolor(LIGHTRED);
write('S');
textcolor(WHITE);
write('air?');
// window( 1, 1, 80, 40 );
End;
{ ------------------------------------------------------------------
PROGRAMA PRINCIPAL
------------------------------------------------------------------ }
Begin
randomize;
orig.x := 2;
orig.y := 2;
clrscr;
gotoxy( orig.x + (WIDTH+2)*2 + 5, orig.y + 1 );
textcolor(WHITE);
write('> > > Tetris < < <');
repeat
prninfo( orig.x + (WIDTH+2)*2 + 4, orig.y + 5 );
for i := 0 to WIDTH+1 do // Preenche todo o grid (inclusive bordas)
for j := 0 to HEIGHT+1 do
begin
grid[i,j].status := TRUE;
grid[i,j].color := DARKGRAY;
end;
for i := 1 to WIDTH do // Esvazia área interna do grid (deixando apenas
for j := 1 to HEIGHT do // as bordas preenchidas)
grid[i,j].status := FALSE;
refresh;
gameover := FALSE;
quit := FALSE;
cycle.freq := 500;
cycle.step := 50;
cycle.status := 0;
score := 0;
createtgt;
createtgt;
refresh;
while not (gameover or quit) do
begin
if (keypressed) then // Se o usuário pressionou uma tecla (keypressed = TRUE),
begin // é preciso agir de acordo com o comando correspondente.
case upcase(readkey) of
#0: case (readkey) of
#75: begin // seta para esquerda
hideobj(obj);
move(left);
drawobj(obj);
end;
#77: begin // seta para direita
hideobj(obj);
move(right);
drawobj(obj);
end;
#80: cycle.status := 0; // seta para baixo
end;
#13: begin // [enter]
while (not shock(0,1)) do
obj.pos.y := obj.pos.y + 1;
cycle.status := 0;
end;
#27: quit := TRUE; // [esc]
#32: begin // espaço
hideobj(obj);
rotate;
drawobj(obj);
end;
'P': begin
textbackground(LIGHTGRAY);
for i := 1 to WIDTH do
for j := 1 to HEIGHT do
begin
gotoxy( orig.x + 2*i, orig.y + j );
write(' ');
end;
textbackground(BLACK);
textcolor(LIGHTGRAY);
gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 - 1 );
write(' ');
gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 );
write(' PAUSE ');
gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 + 1 );
write(' ');
gotoxy( orig.x, orig.y );
repeat
c := upcase(readkey);
until (c = 'P') or (c = #27);
if (c = #27) then quit := TRUE;
refresh;
drawobj(obj);
end;
end;
end;
if (cycle.status < cycle.step) then // Já está na hora de fazer um decaimento?
begin // Se sim...
hideobj(obj); // esconde peça
if (shock(0,1))
then
begin // Se a peça não pode mover-se para baixo:
consolidate; // ancora a peça
checklines; // checa por linhas completadas
refresh; // redesenha todo o grid
createtgt; // cria nova peça
if shock(0, 0) then gameover := TRUE; // caso já não haja espaço no grid para essa nova peça,
end // o jogo está acabado
else // Se a peça pode mover-se para baixo:
obj.pos.y := obj.pos.y + 1; // move a peça para baixo
drawobj(obj); // desenha peça
end;
cycle.status := (cycle.status + cycle.step) mod cycle.freq;
delay(cycle.step);
end;
if (quit) then break;
prnGameover( orig.x + (WIDTH+2)*2 + 4, orig.y + 5 );
repeat
c := upcase(readkey);
until (c = 'N') or (c = 'S');
until (c = 'S');
clrscr;
gotoxy( 25, 12 );
textcolor(WHITE);
write('Pressione [ENTER] para sair . . .');
End.
Scripts recomendados
Horas por extenso: convertendo as horas em um TDateTime para texto corrido.
Comentários
[1] Comentário enviado por doradu em 26/02/2010 - 17:31h
o nome do cara é Leonardo Pignataro
excelente jogo
o nome do cara é Leonardo Pignataro
excelente jogo
Patrocínio
Site hospedado pelo provedor RedeHost.
Destaques
Artigos
Compartilhando a tela do Computador no Celular via Deskreen
Como Configurar um Túnel SSH Reverso para Acessar Sua Máquina Local a Partir de uma Máquina Remota
Configuração para desligamento automatizado de Computadores em um Ambiente Comercial
Dicas
Como renomear arquivos de letras maiúsculas para minúsculas
Imprimindo no formato livreto no Linux
Vim - incrementando números em substituição
Efeito "livro" em arquivos PDF
Como resolver o erro no CUPS: Unable to get list of printer drivers
Tópicos
Não to conseguindo resolver este problemas ao instalar o playonelinux (1)
Excluir banco de dados no xampp (1)
Top 10 do mês
-
Xerxes
1° lugar - 65.234 pts -
Fábio Berbert de Paula
2° lugar - 50.743 pts -
Buckminster
3° lugar - 17.505 pts -
Mauricio Ferrari
4° lugar - 15.272 pts -
Alberto Federman Neto.
5° lugar - 13.873 pts -
Diego Mendes Rodrigues
6° lugar - 13.595 pts -
Daniel Lara Souza
7° lugar - 12.967 pts -
Andre (pinduvoz)
8° lugar - 10.330 pts -
edps
9° lugar - 10.441 pts -
Alessandro de Oliveira Faria (A.K.A. CABELO)
10° lugar - 10.320 pts
Scripts
[Python] Automação de scan de vulnerabilidades
[Python] Script para analise de superficie de ataque
[Shell Script] Novo script para redimensionar, rotacionar, converter e espelhar arquivos de imagem
[Shell Script] Iniciador de DOOM (DSDA-DOOM, Doom Retro ou Woof!)
[Shell Script] Script para adicionar bordas às imagens de uma pasta
A maior comunidade GNU/Linux da América Latina! Artigos, dicas, tutoriais, fórum, scripts e muito mais. Ideal para quem busca auto-ajuda.
Site hospedado por:
